158 lines
4.4 KiB
Perl
Executable File
158 lines
4.4 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
## ----------------------------------------------------------------------
|
|
## install-sgmlcatalog : Debian SGML catalog management tool
|
|
## ----------------------------------------------------------------------
|
|
## Copyright (c) 1997 Christian Schwarz
|
|
## Copyright (c) 2001-2004 Ardo van Rangelrooij
|
|
##
|
|
## This is free software; see the GNU General Public Licence version 2
|
|
## or later for copying conditions. There is NO warranty.
|
|
## ----------------------------------------------------------------------
|
|
|
|
## ----------------------------------------------------------------------
|
|
use strict;
|
|
use warnings;
|
|
|
|
## ----------------------------------------------------------------------
|
|
use Getopt::Long qw( &GetOptions );
|
|
|
|
## ----------------------------------------------------------------------
|
|
$0 =~ m|[^/]+$|;
|
|
|
|
## ----------------------------------------------------------------------
|
|
my $name = $&;
|
|
|
|
## ----------------------------------------------------------------------
|
|
use vars qw( $package );
|
|
use vars qw( $quiet );
|
|
|
|
## ----------------------------------------------------------------------
|
|
Getopt::Long::Configure( 'no_ignore_case' );
|
|
if ( ! GetOptions(
|
|
'quiet' => \$quiet,
|
|
'remove=s' => \$package,
|
|
)
|
|
)
|
|
{
|
|
&usage();
|
|
exit 1;
|
|
}
|
|
|
|
## ----------------------------------------------------------------------
|
|
if ( ! defined( $package ) )
|
|
{
|
|
&usage();
|
|
exit -1;
|
|
}
|
|
|
|
## ----------------------------------------------------------------------
|
|
&remove( $package );
|
|
|
|
## ----------------------------------------------------------------------
|
|
exit 0;
|
|
|
|
## ----------------------------------------------------------------------
|
|
sub remove
|
|
{
|
|
|
|
## ------------------------------------------------------------------
|
|
my $package = $_[0];
|
|
|
|
## ----------------------------------------------------------------------
|
|
my $catalog = '/etc/sgml/transitional.cat';
|
|
my $backup = '/etc/sgml/transitional.cat.old';
|
|
|
|
## ------------------------------------------------------------------
|
|
return if ( ! -f $catalog );
|
|
|
|
## ----------------------------------------------------------------------
|
|
my $top_marker = '-- START SGML CATALOG ENTRY FOR PACKAGE';
|
|
my $bottom_marker = '-- END SGML CATALOG ENTRY FOR PACKAGE';
|
|
my $eol_marker = '--';
|
|
|
|
## ------------------------------------------------------------------
|
|
my @data;
|
|
|
|
## -------------------------------------------------------------------
|
|
open( CATALOG, '<', $catalog )
|
|
or &error( "cannot open SGML catalog $catalog for reading: $!" );
|
|
|
|
## -------------------------------------------------------------------
|
|
while ( <CATALOG> )
|
|
{
|
|
chop;
|
|
if ( /$top_marker $package $eol_marker/o )
|
|
{
|
|
if ( $data[ $#data ] =~ /^\s*/o )
|
|
{
|
|
pop( @data );
|
|
}
|
|
while ( !/$bottom_marker $package $eol_marker/o )
|
|
{
|
|
if ( not ($_ = <CATALOG>) )
|
|
{
|
|
&error( "cannot find bottom marker for package $package:\n $bottom_marker $package $eol_marker\nplease remove the entry for $package manually" );
|
|
}
|
|
}
|
|
}
|
|
else
|
|
{
|
|
push( @data, $_ );
|
|
}
|
|
}
|
|
|
|
## ------------------------------------------------------------------
|
|
close( CATALOG )
|
|
or &error( "cannot close SGML catalog $catalog: $!" );
|
|
|
|
## ------------------------------------------------------------------
|
|
if ( -f $catalog )
|
|
{
|
|
if ( -f $backup )
|
|
{
|
|
unlink( $backup )
|
|
or &error( "cannot remove backup of catalog $backup: $!" );
|
|
}
|
|
rename( $catalog, $backup )
|
|
or &error( "cannot rename $catalog to $backup: $!" );
|
|
}
|
|
|
|
## ------------------------------------------------------------------
|
|
open( CATALOG, '>', $catalog )
|
|
or &error( "cannot open SGML catalog $catalog for writing: $!" );
|
|
|
|
## ------------------------------------------------------------------
|
|
for ( @data )
|
|
{
|
|
print CATALOG "$_\n";
|
|
}
|
|
|
|
## ------------------------------------------------------------------
|
|
close( CATALOG )
|
|
or &error( "cannot close SGML catalog $catalog: $!" );
|
|
|
|
} ## remove
|
|
|
|
## ----------------------------------------------------------------------
|
|
sub usage
|
|
{
|
|
|
|
## ------------------------------------------------------------------
|
|
print STDERR <<END;
|
|
Usage:
|
|
$name --remove package
|
|
END
|
|
|
|
} ## usage
|
|
|
|
## ----------------------------------------------------------------------
|
|
sub error
|
|
{
|
|
|
|
## ------------------------------------------------------------------
|
|
die "$name: error: $_[0]\n";
|
|
|
|
} ## error
|
|
|
|
## ----------------------------------------------------------------------
|