#!/usr/bin/perl
# Debian GNU/Linux install-sgmlcatalog Version (see $version below).
# Copyright (C) 1997 Christian Schwarz <schwarz@debian.org>.
# This is free software; see the GNU General Public Licence version 2
# or later for copying conditions.  There is NO warranty.

$version= '0.5';

$catalog='/etc/sgml.catalog';
$backup='/etc/sgml.catalog.old';

$top_marker='-- START SGML CATALOG ENTRY FOR PACKAGE';
$bottom_marker='-- END SGML CATALOG ENTRY FOR PACKAGE';
$eol_marker='--';

# ---end-of-configuration-part---

$0 =~ m|[^/]+$|; $name= $&;

while ($ARGV[0] =~ m/^--/) {
    $_= shift(@ARGV);
    last if $_ eq '--';
    if ($_ eq '--version') {
        &version; exit 0;
    } elsif ($_ eq '--quiet') {
        $quiet=1;
    } elsif ($_ eq '--test') {
        $debug=1;
    } elsif ($_ eq '--remove') {
        $remove=1;
    } elsif ($_ eq '--install') {
        $install=1;
    } elsif ($_ eq '--help') {
        &usage; exit 0;
    } else {
        print STDERR "$name: unknown option \`$_'\n"; &usage; exit 1;
    }
}

if (!@ARGV) { &version; print STDERR "\n"; &usage; exit 1; }

if ($install) { $source_file=shift(@ARGV); }

if (!@ARGV) { &version; print STDERR "\n"; &usage; exit 1; }

$package=shift(@ARGV);

if (@ARGV) { print STDERR "$name: too many arguments\n"; exit 1; }

if ($install == $remove) {
print "Huh? You have to use --install or --remove (not both).\n"; exit 1; }

print STDERR "$name: test mode - catalog file will not be updated\n"
    if $debug && !$quiet;

if ($install) {
    print "Updating SGML catalog entry for package $package...\n"
        unless $quiet;

    &read_catalog_without_packages_entry;
    &append_catalog_entry;
    &write_catalog;
} elsif ($remove) {
    print "Removing SGML catalog entry for package $package...\n"
        unless $quiet;

    &read_catalog_without_packages_entry;
    &write_catalog;
}

exit 0;

# ----------------------------------------------

sub version {
        print STDERR <<END;
Debian GNU/Linux install-sgmlcatalog version $version.
Copyright (C) 1997 Christian Schwarz <schwarz\@debian.org>.
This is free software; see the GNU General Public Licence version 2
or later for copying conditions.  There is NO warranty.
END
}

sub usage {
    print STDERR <<END;
Usage:
    install-sgmlcatalog <options> --install filename package
  or
    install-sgmlcatalog <options> --remove package

Options:
    --version       displays version number
    --help          displays this help text (usage)
    --quiet         be quite
    --test          do not modify any files, enables debugging mode
END
}

#  ----------------------------------------------
 
sub read_catalog_without_packages_entry {
  print "Reading catalog $catalog and removing entry for package $package...\n"
    if $debug;
  
  # check if $catalog exists
  unless (-f $catalog) {
    return;
  }
  
  open(CATALOG, $catalog)
    or die "cannot open SGML catalog $catalog for reading: $!";
  while (<CATALOG>) {
    chop;
    if (/$top_marker $package $eol_marker/o) {
      # Found top marker for this package!
      
      # Was there a leading empty line?
      if ($data[$#data] =~ /^\s*/o) {
	# yes, so remove it.
	pop(@data);
      }
      
      # Scan until bottom marker is found
      while (!/$bottom_marker $package $eol_marker/o) {
	if ( not ($_ = <CATALOG>) ) {
	  print STDERR "error: cannot find bottom marker for package $package:\n";
	  print STDERR "   $bottom_marker $package $eol_marker\n";
	  print STDERR "Please remove the entry for $package yourself.\n";
	  exit 1;
	}
      }
    } else {
      push(@data,$_);
    }
  }
  close(CATALOG);
}

sub append_catalog_entry {
  print "Appending entry for package $package from file $source_file...\n"
    if $debug;
  
  push(@data,'');
  push(@data,"$top_marker $package $eol_marker");
  
  open(SOURCE,$source_file)
    or die "cannot open source file $source_file for reading: $!";
  while (<SOURCE>) {
    chop;
    push(@data,$_);
  }
  close(SOURCE);
  
  push(@data,"$bottom_marker $package $eol_marker");
}

sub write_catalog {
  if (not $debug) {
    # check if $catalog exists
    if (-f $catalog) {
      # remove old backup file
      if (-f $backup) {
	unlink($backup)
	  or die "cannot remove backup copy of catalog $backup: $!";
      }
      # create backup copy.
      rename($catalog,$backup)
	or die "cannot rename $catalog to $backup: $!";
    }
    
    # write new catalog
    open(CATALOG, ">$catalog")
      or die "cannot open SGML catalog $catalog for writing: $!";
    for (@data) {
      print CATALOG "$_\n";
    }
    close(CATALOG);
  } else {
    print "Writing new catalog to $catalog...\n";
    
    for (@data) {
      print "$_\n";
    }
  }
}

__END__
