^^&&^^

Edit File: update-xmlcatalog

#!/usr/bin/perl
## ----------------------------------------------------------------------
## Debian update-xmlcatalog
## ----------------------------------------------------------------------
## Copyright (c) 2003-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.
## ----------------------------------------------------------------------

=head1 NAME

update-xmlcatalog - maintain XML catalog files

=head1 SYNOPSIS

B<update-xmlcatalog> B<--add> B<--root> S<B<--package> I<package>>
S<B<--type> I<type>> S<B<--id> I<id>>

B<update-xmlcatalog> B<--del> B<--root> S<B<--package> I<package>>
S<B<--type> I<type>> S<B<--id> I<id>>

B<update-xmlcatalog> B<--add> S<B<--package> I<package>> S<B<--local>
I<local>> S<B<--type> I<type>> S<B<--id> I<id>>

B<update-xmlcatalog> B<--del> S<B<--package> I<package>> S<B<--local>
I<local>> S<B<--type> I<type>> S<B<--id> I<id>>

B<update-xmlcatalog> B<--add> S<B<--local> I<local>> S<B<--file>
I<file>> S<B<--type> I<type>> S<B<--id> I<id>>

B<update-xmlcatalog> B<--del> S<B<--local> I<local>> S<B<--file>
I<file>> S<B<--type> I<type>> S<B<--id> I<id>>

B<update-xmlcatalog> B<--help>

=head1 DESCRIPTION

B<update-xmlcatalog> add entries to and removes entries from the root
XML catalog file, a package XML catalog file or a local XML catalog
file.

=head1 OPTIONS

=over 4

=item B<--add>

Adds the entry to the root XML catalog file, a package XML catalog
file or a local XML catalog file.  If the XML catalog file does not
exist yet, it is automatically created.

=item B<--del>

Deletes the entry from the root XML catalog file, the package XML
catalog file or the local XML catalog file.  A resulting empty XML
catalog is not automatically deleted from the filesystem.

=item B<--file> I<file>

Indicates a local filename.

=item B<--id> I<id>

Indicates the XML catalog file entry identifier.

=item B<--local> I<local>

Indicates a local XML catalog file.

=item B<--package> I<package>

Indicates a package XML catalog file.

=item B<--root>

Indicates the root XML catalog file.

=item B<--type> I<type>

Indicates the XML catalog file entry type (public, system, uri).

=item B<--help>

Displays the usage information.

=item B<--verbose>

Optional switch to make a verbose output.

=item B<--sort>

Optional switch to sort the manipulated catalog content.

Tip: To sort a catalog without adding or removing an item,
just add an already existing item to the catalog.

=back

=head1 NOTES

B<update-xmlcatalog> is the de-facto standard tool to be used to
maintain XML catalog files on a Debian system, similar to that
L<update-catalog(8)> is the standard tool to be used to main SGML
catalog files on a Debian system.  A Debian XML Policy document to
this effect is currently under development.

B<update-xmlcatalog> and L<xmlcatalog(1)> are incompatible.  The
former has an internal database of all the entries in all the XML
catalog files it maintains and regenerates the indicated XML catalog
file completely from scratch upon an update.  The latter updates the
indicated XML catalog file directly.  This means that any change made
to an XML catalog file using L<xmlcatalog(1)> is overwritten the next
time that XML catalog file is updated using B<update-xmlcatalog>.

=head1 SEE ALSO

F</usr/share/doc/xml-core/README.Debian>

=head1 AUTHOR

B<Ardo van Rangelrooij> E<lt>ardo@debian.orgE<gt>

=cut

## ----------------------------------------------------------------------
use strict;

## ----------------------------------------------------------------------
use File::Spec;
use Getopt::Long;

## ----------------------------------------------------------------------
$0  =~ m|[^/]+$|;

## ----------------------------------------------------------------------
my $name = $&;

## ----------------------------------------------------------------------
use vars qw( $catalog_data $catalog_data_dir );
use vars qw( $catalog $catalog_dir );
use vars qw( %catalog $key $entry );

## ----------------------------------------------------------------------
$catalog_data_dir = '/var/lib/xml-core';
$catalog_dir      = '/etc/xml';

## ----------------------------------------------------------------------
use vars qw( $add );
use vars qw( $del );
use vars qw( $file );
use vars qw( $help );
use vars qw( $local );
use vars qw( $package );
use vars qw( $root );
use vars qw( $type $id );
use vars qw( $verbose );
use vars qw( $sort );

## ----------------------------------------------------------------------
if ( ! GetOptions(
		  'add'       => \$add,
		  'del'       => \$del,
		  'file=s'    => \$file,
		  'help'      => \$help,
		  'id=s'      => \$id,
		  'local=s'   => \$local,
		  'package=s' => \$package,
		  'root'      => \$root,
		  'type=s'    => \$type,
		  'verbose'   => \$verbose,
		  'sort'      => \$sort,
		  )
     )
{
    &help;
    exit 1;
}

## ----------------------------------------------------------------------
if ( defined( $help ) )
{
    &help;
    exit -1;
}

## ----------------------------------------------------------------------
if  ( ! ( defined( $add ) || defined( $del ) ) )
{
    print STDERR "$name: error: either 'add' or 'del' must be given\n";
    exit 1;
}
elsif  ( ( defined( $add ) && defined( $del ) ) )
{
    print STDERR "$name: error: only one of 'add' and 'del' can be given\n";
    exit 1;
}

## ----------------------------------------------------------------------
if ( defined( $add ) )
{
    if ( defined( $root ) )
    {
	if ( defined( $package ) )
	{
	    my $catalog = File::Spec->catfile( $catalog_dir, "$package.xml" );
	    if ( ! -f $catalog )
	    {
		print STDERR "$name: error: package catalog $catalog not found\n";
		exit 1;
	    }
	}
	else
	{
	    print STDERR "$name: error: package catalog not given\n";
	    exit 1;
	}
	if ( defined( $local) || defined( $file ) )
	{
	    print STDERR "$name: error: local catalog and file not for adding to root catalog file\n";
	    exit 1;
	}
    }
    elsif ( defined( $package ) )
    {
	if ( defined( $local ) )
	{
	    if ( ! -f $local )
	    {
		print STDERR "$name: error: local catalog $local not found\n";
		exit 1;
	    }
	}
	else
	{
	    print STDERR "$name: error: local catalog not given\n";
	    exit 1;
	}
	if ( defined( $file ) )
	{
	    print STDERR "$name: error: file not for adding to package catalog file\n";
	    exit 1;
	}
    }
    elsif ( defined( $local ) )
    {
	if ( defined( $file ) )
	{
	    if ( ! -f $file )
	    {
		print STDERR "$name: error: file $file not found\n";
		exit 1;
	    }
	}
	else
	{
	    print STDERR "$name: error: file not given\n";
	    exit 1;
	}
    }
    else
    {
	print STDERR "$name: error: catalog not given\n";
	exit 1;
    }
}
elsif ( defined( $del ) )
{
    if ( defined( $root ) )
    {
	my $catalog = File::Spec->catfile( $catalog_dir, 'catalog' );
	if ( ! -f $catalog )
	{
	    print STDERR "$name: error: root catalog $catalog not found\n";
	    exit 1;
	}
	if ( defined( $package) || defined( $local ) || defined( $file ) )
	{
	    print STDERR "$name: error: package catalog, local catalog or file not for deleting from root catalog file\n";
	    exit 1;
	}
    }
    elsif ( defined( $package ) )
    {
	my $catalog = File::Spec->catfile( $catalog_dir, "$package.xml" );
	if ( ! -f $catalog )
	{
	    print STDERR "$name: error: package catalog $catalog not found\n";
	    exit 1;
	}
	if ( defined( $local ) || defined( $file ) )
	{
	    print STDERR "$name: error: local catalog or file not for deleting from package catalog file\n";
	    exit 1;
	}
    }
    elsif ( defined( $local ) )
    {
	if ( ! -f $local )
	{
	    print STDERR "$name: error: local catalog $local not found\n";
	    exit 1;
	}
	if ( defined( $file ) )
	{
	    print STDERR "$name: error: file not for deleting from local catalog file\n";
	    exit 1;
	}
    }
    else
    {
	print STDERR "$name: error: catalog not given\n";
	exit 1;
    }
}

## ----------------------------------------------------------------------
if ( defined( $type ) )
{
    if ( $type !~ /^(public|system|uri)$/ )
    {
        print STDERR "$name: error: wrong type\n";
        exit 1;
    }
}
else
{
    print STDERR "$name: error: type not given\n";
    exit 1;
}

## ----------------------------------------------------------------------
if ( ! defined( $id ) )
{
    print STDERR "$name: error: id not given\n";
    exit 1;
}

## ----------------------------------------------------------------------
if ( defined( $root ) )
{
    $catalog = 'catalog';
    $catalog_data = File::Spec->catfile( $catalog_data_dir, $catalog );
    $catalog = File::Spec->catfile( $catalog_dir, $catalog );
    my $start = $type;
    $start .= 'Id' unless $type eq 'uri';
    $start .= 'StartString';
    $id = "$start=\"$id\"";
    $type = ( $type eq 'uri' ) ? "\U$type" : "\u$type";
    $type = "delegate$type";
    $package = "catalog=\"file:///etc/xml/$package.xml\"";
    $key = "$type $id";
    $entry = "$package";
}
elsif ( defined( $package ) )
{
    $catalog_data = File::Spec->catfile( $catalog_data_dir, $package );
    $catalog = File::Spec->catfile( $catalog_dir, "$package.xml" );
    my $start = $type;
    $start .= 'Id' unless $type eq 'uri';
    $start .= 'StartString';
    $id = "$start=\"$id\"";
    $type = ( $type eq 'uri' ) ? "\U$type" : "\u$type";
    $type = "delegate$type";
    $local = "catalog=\"file://$local\"";
    $key = "$type $id";
    $entry = "$local";
}
elsif ( defined( $local ) )
{
    $catalog = $local;
    $catalog_data = $local;
    $catalog_data =~ tr|/|_|;
    $catalog_data = File::Spec->catfile( $catalog_data_dir, $catalog_data );
    my $start = ( $type eq 'uri' ) ? 'name' : $type;
    $start .= 'Id' unless $type eq 'uri';
    $id = "$start=\"$id\"";
    $file = "uri=\"$file\"";
    $key = "$type $id";
    $entry = "$file";
}

## ----------------------------------------------------------------------
if ( defined( $add ) )
{
    &read_catalog_data if -f $catalog_data;
    if ( &add_entry )
    {
	&create_backup if -f $catalog;
	&write_catalog_data;
	&write_catalog;
    }
    else
    {
	exit 1;
    }
}
elsif ( defined( $del ) )
{
    &read_catalog_data;
    if ( &del_entry )
    {
	&create_backup;
	&write_catalog_data;
	&write_catalog;
    }
    else
    {
	exit 1;
    }
}

## ----------------------------------------------------------------------
exit 0;

## ----------------------------------------------------------------------
sub add_entry
{

## ------------------------------------------------------------------
    if ( exists( $catalog{ $key } ) )
    {
	if ( $catalog{ $key } ne $entry )
	{
	    print STDERR "$name: error: entity already registered with a different value\n";
	    print STDERR " Entity   : [$key]\n";
	    print STDERR " Old value: [$catalog{$key}]\n";
	    print STDERR " New value: [$entry]\n";
	    return;
	}
	else
	{
	    print STDERR "$name: notice: entity already registered\n"
		if $verbose;
	    return 1;
	}
    }
    else
    {
	print "$name: adding entity to catalog data $catalog_data with the same value\n"
	    if $verbose;
	$catalog{ $key } = $entry;
	return 1;
    }

} ## add_entry

## ----------------------------------------------------------------------
sub del_entry
{

## ------------------------------------------------------------------
    if ( exists( $catalog{ $key } ) )
    {
	print "$name: removing entity from catalog data $catalog_data\n"
	    if $verbose;
	delete( $catalog{ $key } );
	return 1;
    }
    else
    {
	print STDERR "$name: error: entity not registered\n";
	return;
    }

} ## del_entry

## ----------------------------------------------------------------------
sub read_catalog_data
{

## ------------------------------------------------------------------
    print "$name: reading catalog data $catalog_data\n" if $verbose;
    open( CATALOG_DATA, '<', $catalog_data )
	or die "$name: cannot open catalog data $catalog_data for reading: $!";
    while ( <CATALOG_DATA> )
    {
	chop;
	my ( $key, $entry ) = split( />/ );
	$key =~ s/^<//;
	$entry =~ s/^<//;
	$catalog{ $key } = $entry;
    }
    close( CATALOG_DATA )
	or die "$name: cannot close catalog data $catalog_data: $!";

} ## read_catalog_data

## ----------------------------------------------------------------------
sub write_catalog_data
{

## ------------------------------------------------------------------
    print "$name: writing catalog data $catalog_data\n" if $verbose;
    open( CATALOG_DATA, '>', $catalog_data )
	or die "$name: cannot open catalog data $catalog_data for writing: $!";
    my $counter = 0;
    # Adding the optional sort of the catalog. See #626036.
    my @catalog_keys = ( $sort ? sort keys %catalog : keys %catalog );
    for my $key ( @catalog_keys )
    {
	print( CATALOG_DATA "<$key><$catalog{ $key }>\n" );
	$counter++;
    }
    close( CATALOG_DATA )
	or die "$name: cannot close catalog data $catalog_data: $!";

## ------------------------------------------------------------------
    if ( $counter == 0 )
    {
	print "$name: removing catalog data $catalog_data\n" if $verbose;
	unlink( $catalog_data );
    }

} ## write_catalog_data

## ----------------------------------------------------------------------
sub create_backup
{

## ------------------------------------------------------------------
    my $backup = $catalog . '.old';

## ------------------------------------------------------------------
    if ( -f $backup )
    {
	print "$name: removing backup $backup\n" if $verbose;
	unlink( $backup )
	    or die "$name: cannot remove backup $backup: $!";
    }

## ------------------------------------------------------------------
    print "$name: moving catalog $catalog to backup $backup\n" if $verbose;
    rename( $catalog, $backup )
	or die "$name: cannot move catalog $catalog to backup $backup: $!";

} ## create_backup

## ----------------------------------------------------------------------
sub write_catalog
{

## ------------------------------------------------------------------
    my @catalog = ();

## ------------------------------------------------------------------
    my $header = '/usr/share/xml-core/catalog.header';
    open( HEADER, '<', $header )
	or die "$name: cannot open catalog header $header for reading: $!";
    while ( <HEADER> )
    {
	chop;
	push( @catalog, $_ );
    }
    close( HEADER )
	or die "$name: cannot close catalog header $header: $!";

## ------------------------------------------------------------------
    my $counter = 0;
    # Adding the optional sort of the catalog. See #626036.
    my @catalog_keys = ( $sort ? sort keys %catalog : keys %catalog );
    for my $key ( @catalog_keys )
    {
	push( @catalog, "<$key $catalog{ $key }/>" );
	$counter++;
    }

## ------------------------------------------------------------------
    my $footer = '/usr/share/xml-core/catalog.footer';
    open( FOOTER, '<', $footer )
	or die "$name: cannot open catalog footer $footer for reading: $!";
    while ( <FOOTER> )
    {
	chop;
	push( @catalog, $_ );
    }
    close( FOOTER )
	or die "$name: cannot close catalog footer $footer: $!";

## ------------------------------------------------------------------
    print "$name: writing catalog $catalog\n" if $verbose;
    open( CATALOG, '>', $catalog )
	or die "$name: cannot open catalog $catalog for writing: $!";
    for ( @catalog )
    {
	print( CATALOG $_, "\n" );
    }
    close( CATALOG )
	or die "$name: cannot close catalog $catalog: $!";

## ------------------------------------------------------------------
    if ( $counter == 0 )
    {
	print "$name: removing catalog $catalog\n" if $verbose;
	unlink( $catalog );
    }

} ## write_catalog

## ----------------------------------------------------------------------
sub help
{

## ------------------------------------------------------------------
    print <<END;
Usage:
    $name <options> --add --root --type <type> \\
                                                --id <id> --package <package>
    $name <options> --del --root --type <type> \\
                                                --id <id>

$name <options> --add --package <package> --type <type> \\
                                                --id <id> --local <local>
    $name <options> --del --package <package> --type <type> \\
                                                --id <id>

$name <options> --add --local <local> --type <type> \\
                                                --id <id> --file <file>
    $name <options> --del --local <local> --type <type> \\
                                                --id <id>

$name --help

With:
    --file <file>       = a local filename
    --id <id>           = catalog entry idenitifier
    --local <local>     = a local XML catalog
    --package <package> = a package XML catalog
    --root              = the root XML catalog (= /etc/xml/catalog)
    --type <type>       = catalog entry type (= public, system, uri)

Options:
    --verbose = be verbose
    --sort = sorts the manipulated catalog content

END

} ## help

## ----------------------------------------------------------------------
__END__

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