init III

Perl OTRS/Kernel/cpan-lib/CPAN/Audit.pm

@@ -0,0 +1,306 @@
+package CPAN::Audit;
+use 5.008001;
+use strict;
+use warnings;
+use version;
+use CPAN::Audit::Installed;
+use CPAN::Audit::Discover;
+use CPAN::Audit::Version;
+use CPAN::Audit::Query;
+use CPAN::Audit::DB;
+use Module::CoreList;
+
+our $VERSION = "0.15";
+
+sub new {
+    my $class = shift;
+    my (%params) = @_;
+
+    my $self = {};
+    bless $self, $class;
+
+    $self->{ascii}       = $params{ascii};
+    $self->{verbose}     = $params{verbose};
+    $self->{quiet}       = $params{quiet};
+    $self->{no_color}    = $params{no_color};
+    $self->{no_corelist} = $params{no_corelist};
+    $self->{interactive} = $params{interactive};
+
+    if ( !$self->{interactive} ) {
+        $self->{ascii}    = 1;
+        $self->{no_color} = 1;
+    }
+
+    $self->{db}       = CPAN::Audit::DB->db;
+    $self->{query}    = CPAN::Audit::Query->new( db => $self->{db} );
+    $self->{discover} = CPAN::Audit::Discover->new( db => $self->{db} );
+
+    return $self;
+}
+
+sub command {
+    my $self = shift;
+    my ( $command, @args ) = @_;
+
+    my %dists;
+
+    if (!$self->{no_corelist}
+        && (   $command eq 'dependencies'
+            || $command eq 'deps'
+            || $command eq 'installed' )
+        )
+    {
+        # Find core modules for this perl version first.
+        # This way explictly installed versions will overwrite.
+        if ( my $core = $Module::CoreList::version{$]} ) {
+            while ( my ( $mod, $ver ) = each %$core ) {
+                my $dist = $self->{db}{module2dist}{$mod} or next;
+
+                $dists{$dist} = $ver if version->parse($ver) > $dists{$dist};
+            }
+        }
+    }
+
+    if ( $command eq 'module' ) {
+        my ( $module, $version_range ) = @args;
+        $self->fatal("Usage: module <module> [version-range]") unless $module;
+
+        my $distname = $self->{db}->{module2dist}->{$module};
+
+        if ( !$distname ) {
+            $self->message("__GREEN__Module '$module' is not in database");
+            return 0;
+        }
+
+        $dists{$distname} = $version_range || '';
+    }
+    elsif ( $command eq 'release' || $command eq 'dist' ) {
+        my ( $distname, $version_range ) = @args;
+        $self->fatal("Usage: dist|release <module> [version-range]")
+          unless $distname;
+
+        if ( !$self->{db}->{dists}->{$distname} ) {
+            $self->message("__GREEN__Distribution '$distname' is not in database");
+            return 0;
+        }
+
+        $dists{$distname} = $version_range || '';
+    }
+    elsif ( $command eq 'show' ) {
+        my ($advisory_id) = @args;
+        $self->fatal("Usage: show <advisory-id>") unless $advisory_id;
+
+        my ($release) = $advisory_id =~ m/^CPANSA-(.*?)-(\d+)-(\d+)$/;
+        $self->fatal("Invalid advisory id") unless $release;
+
+        my $dist = $self->{db}->{dists}->{$release};
+        $self->fatal("Unknown advisory id") unless $dist;
+
+        my ($advisory) =
+          grep { $_->{id} eq $advisory_id } @{ $dist->{advisories} };
+        $self->fatal("Unknown advisory id") unless $advisory;
+
+        $self->print_advisory($advisory);
+
+        return 0;
+    }
+    elsif ( $command eq 'dependencies' || $command eq 'deps' ) {
+        my ($path) = @args;
+        $path = '.' unless defined $path;
+
+        $self->fatal("Usage: deps <path>") unless -d $path;
+
+        my @deps = $self->{discover}->discover($path);
+
+        $self->message( 'Discovered %d dependencies', scalar(@deps) );
+
+        foreach my $dep (@deps) {
+            my $dist = $dep->{dist}
+              || $self->{db}->{module2dist}->{ $dep->{module} };
+            next unless $dist;
+
+            $dists{$dist} = $dep->{version};
+        }
+    }
+    elsif ( $command eq 'installed' ) {
+        $self->message_info('Collecting all installed modules. This can take a while...');
+
+        my @deps = CPAN::Audit::Installed->new(
+            db => $self->{db},
+            $self->{verbose}
+            ? (
+                cb => sub {
+                    my ($info) = @_;
+
+                    $self->message( '%s: %s-%s', $info->{path}, $info->{distname}, $info->{version} );
+                }
+              )
+            : ()
+        )->find(@ARGV);
+
+        foreach my $dep (@deps) {
+            my $dist = $dep->{dist}
+              || $self->{db}->{module2dist}->{ $dep->{module} };
+            next unless $dist;
+
+            $dists{ $dep->{dist} } = $dep->{version};
+        }
+    }
+    else {
+        $self->fatal("Error: unknown command: $command. See -h");
+    }
+
+    my $total_advisories = 0;
+
+    if (%dists) {
+        my $query = $self->{query};
+
+        foreach my $distname ( sort keys %dists ) {
+            my $version_range = $dists{$distname};
+
+            my @advisories = $query->advisories_for( $distname, $version_range );
+
+            $version_range = 'Any'
+              if $version_range eq '' || $version_range eq '0';
+
+            if (@advisories) {
+                $self->message( '__RED__%s (requires %s) has %d advisories__RESET__',
+                    $distname, $version_range, scalar(@advisories) );
+
+                foreach my $advisory (@advisories) {
+                    $self->print_advisory($advisory);
+                }
+            }
+
+            $total_advisories += @advisories;
+        }
+    }
+
+    if ($total_advisories) {
+        $self->message( '__RED__Total advisories found: %d__RESET__', $total_advisories );
+
+        return $total_advisories;
+    }
+    else {
+        $self->message_info('__GREEN__No advisories found__RESET__');
+
+        return 0;
+    }
+}
+
+sub message_info {
+    my $self = shift;
+
+    return if $self->{quiet};
+
+    $self->message(@_);
+}
+
+sub message {
+    my $self = shift;
+
+    $self->_print( *STDOUT, @_ );
+}
+
+sub fatal {
+    my $self = shift;
+    my ( $msg, @args ) = @_;
+
+    $self->_print( *STDERR, "Error: $msg", @args );
+    exit 255;
+}
+
+sub print_advisory {
+    my $self = shift;
+    my ($advisory) = @_;
+
+    $self->message("  __BOLD__* $advisory->{id}");
+
+    print "    $advisory->{description}\n";
+
+    if ( $advisory->{affected_versions} ) {
+        print "    Affected range: $advisory->{affected_versions}\n";
+    }
+
+    if ( $advisory->{fixed_versions} ) {
+        print "    Fixed range: $advisory->{fixed_versions}\n";
+    }
+
+    if ( $advisory->{cves} ) {
+        print "\n    CVEs: ";
+        print join ', ', @{ $advisory->{cves} };
+        print "\n";
+    }
+
+    if ( $advisory->{references} ) {
+        print "\n    References:\n";
+        foreach my $reference ( @{ $advisory->{references} || [] } ) {
+            print "    $reference\n";
+        }
+    }
+
+    print "\n";
+}
+
+sub _print {
+    my $self = shift;
+    my ( $fh, $format, @params ) = @_;
+
+    my $msg = @params ? ( sprintf( $format, @params ) ) : ($format);
+
+    if ( $self->{no_color} ) {
+        $msg =~ s{__BOLD__}{}g;
+        $msg =~ s{__GREEN__}{}g;
+        $msg =~ s{__RED__}{}g;
+        $msg =~ s{__RESET__}{}g;
+    }
+    else {
+        $msg =~ s{__BOLD__}{\e[39;1m}g;
+        $msg =~ s{__GREEN__}{\e[32m}g;
+        $msg =~ s{__RED__}{\e[31m}g;
+        $msg =~ s{__RESET__}{\e[0m}g;
+
+        $msg .= "\e[0m";
+    }
+
+    print $fh "$msg\n";
+}
+
+1;
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+CPAN::Audit - Audit CPAN distributions for known vulnerabilities
+
+=head1 SYNOPSIS
+
+    use CPAN::Audit;
+
+=head1 DESCRIPTION
+
+CPAN::Audit is a module and a database at the same time. It is used by L<cpan-audit> command line application to query
+for vulnerabilities.
+
+=head1 LICENSE
+
+Copyright (C) Viacheslav Tykhanovskyi.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Viacheslav Tykhanovskyi E<lt>viacheslav.t@gmail.comE<gt>
+
+=head1 CREDITS
+
+Takumi Akiyama (github.com/akiym)
+
+James Raspass (github.com/JRaspass)
+
+MCRayRay (github.com/MCRayRay)
+
+=cut

Perl OTRS/Kernel/cpan-lib/CPAN/Audit/Discover.pm

@@ -0,0 +1,32 @@
+package CPAN::Audit::Discover;
+use strict;
+use warnings;
+use CPAN::Audit::Discover::Cpanfile;
+use CPAN::Audit::Discover::CpanfileSnapshot;
+
+sub new {
+    my $class = shift;
+
+    my $self = {};
+    bless $self, $class;
+
+    return $self;
+}
+
+sub discover {
+    my $self = shift;
+    my ($path) = @_;
+
+    if ( -f "$path/cpanfile.snapshot" ) {
+        return CPAN::Audit::Discover::CpanfileSnapshot->new->discover("$path/cpanfile.snapshot");
+    }
+    elsif ( -f "$path/cpanfile" ) {
+        return CPAN::Audit::Discover::Cpanfile->new->discover("$path/cpanfile");
+    }
+    else {
+    }
+
+    return;
+}
+
+1;

Perl OTRS/Kernel/cpan-lib/CPAN/Audit/Discover/Cpanfile.pm

@@ -0,0 +1,43 @@
+package CPAN::Audit::Discover::Cpanfile;
+use strict;
+use warnings;
+use Module::CPANfile;
+
+sub new {
+    my $class = shift;
+
+    my $self = {};
+    bless $self, $class;
+
+    return $self;
+}
+
+sub discover {
+    my $self = shift;
+    my ($cpanfile_path) = @_;
+
+    my $cpanfile = Module::CPANfile->load($cpanfile_path);
+
+    my $prereqs = $cpanfile->prereqs->as_string_hash;
+
+    my @deps;
+    foreach my $phase ( keys %$prereqs ) {
+        foreach my $type ( keys %{ $prereqs->{$phase} } ) {
+            foreach my $module ( keys %{ $prereqs->{$phase}->{$type} } ) {
+                my $version = $prereqs->{$phase}->{$type}->{$module};
+
+                next if $module eq 'perl';
+
+                push @deps,
+                  {
+                    module  => $module,
+                    version => $version,
+                  };
+            }
+        }
+    }
+
+    return @deps;
+}
+
+1;

Perl OTRS/Kernel/cpan-lib/CPAN/Audit/Discover/CpanfileSnapshot.pm

@@ -0,0 +1,41 @@
+package CPAN::Audit::Discover::CpanfileSnapshot;
+use strict;
+use warnings;
+use CPAN::DistnameInfo;
+
+sub new {
+    my $class = shift;
+
+    my $self = {};
+    bless $self, $class;
+
+    return $self;
+}
+
+sub discover {
+    my $self = shift;
+    my ($cpanfile_snapshot_path) = @_;
+
+    open my $fh, '<', $cpanfile_snapshot_path or die $!;
+
+    my @deps;
+    while ( defined( my $line = <$fh> ) ) {
+        if ( $line =~ m/pathname: ([^\s]+)/ ) {
+            next unless my $d = CPAN::DistnameInfo->new($1);
+
+            next unless $d->dist && $d->version;
+
+            push @deps,
+              {
+                dist    => $d->dist,
+                version => $d->version,
+              };
+        }
+    }
+
+    close $fh;
+
+    return @deps;
+}
+
+1;

Perl OTRS/Kernel/cpan-lib/CPAN/Audit/Installed.pm

@@ -0,0 +1,120 @@
+package CPAN::Audit::Installed;
+use strict;
+use warnings;
+use File::Find ();
+use Cwd        ();
+
+sub new {
+    my $class = shift;
+    my (%params) = @_;
+
+    my $self = {};
+    bless $self, $class;
+
+    $self->{db} = $params{db};
+    $self->{cb} = $params{cb};
+
+    return $self;
+}
+
+sub find {
+    my $self = shift;
+    my (@inc) = @_;
+
+    @inc = @INC unless @inc;
+    @inc = grep { defined && -d $_ } map { Cwd::realpath($_) } @inc;
+
+    my %seen;
+    my @deps;
+
+    File::Find::find(
+        {
+            wanted => sub {
+                my $path = $File::Find::name;
+
+                if ( $path && -f $path && m/\.pm$/ ) {
+                    return unless my $module = module_from_file($path);
+
+                    return unless my $distname = $self->{db}->{module2dist}->{$module};
+
+                    my $dist = $self->{db}->{dists}->{$distname};
+                    if ( $dist->{main_module} eq $module ) {
+                        return if $seen{$module}++;
+
+                        return unless my $version = module_version($path);
+
+                        push @deps, { dist => $distname, version => $version };
+
+                        if ( $self->{cb} ) {
+                            $self->{cb}->(
+                                {
+                                    path     => $path,
+                                    distname => $distname,
+                                    version  => $version
+                                }
+                            );
+                        }
+                    }
+                }
+            },
+            follow      => 1,
+            follow_skip => 2,
+        },
+        @inc
+    );
+
+    return @deps;
+}
+
+# https://metacpan.org/source/ABELTJE/V-0.13/V.pm
+sub module_version {
+    my ($parsefile) = @_;
+
+    open my $mod, '<', $parsefile or die $!;
+
+    my $inpod = 0;
+    my $result;
+    local $_;
+    while (<$mod>) {
+        $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
+        next if $inpod || /^\s*#/;
+
+        chomp;
+        next unless m/([\$*])(([\w\:\']*)\bVERSION)\b.*\=/;
+        my $eval = qq{
+            package CPAN::Audit::_version;
+            no strict;
+
+            local $1$2;
+            \$$2=undef; do {
+                $_
+            }; \$$2
+        };
+        local $^W = 0;
+        $result = eval($eval);
+        warn "Could not eval '$eval' in $parsefile: $@" if $@;
+        $result = "undef" unless defined $result;
+        last;
+    }
+    close $mod;
+    return $result;
+}
+
+sub module_from_file {
+    my ($path) = @_;
+
+    my $module;
+
+    open my $fh, '<', $path or return;
+    while ( my $line = <$fh> ) {
+        if ( $line =~ m/package\s+(.*?)\s*;/ms ) {
+            $module = $1;
+            last;
+        }
+    }
+    close $fh;
+
+    return unless $module;
+}
+
+1;

Perl OTRS/Kernel/cpan-lib/CPAN/Audit/Query.pm

@@ -0,0 +1,67 @@
+package CPAN::Audit::Query;
+use strict;
+use warnings;
+use CPAN::Audit::Version;
+
+sub new {
+    my $class = shift;
+    my (%params) = @_;
+
+    my $self = {};
+    bless $self, $class;
+
+    $self->{db} = $params{db} || {};
+
+    return $self;
+}
+
+sub advisories_for {
+    my $self = shift;
+    my ( $distname, $version_range ) = @_;
+
+    my $dist = $self->{db}->{dists}->{$distname};
+    return unless $dist;
+
+    my @advisories = @{ $dist->{advisories} };
+    my @versions   = @{ $dist->{versions} };
+
+    if ( !$version_range ) {
+        return @advisories;
+    }
+
+    my $version_checker = CPAN::Audit::Version->new;
+
+    my @all_versions = map { $_->{version} } @versions;
+    my @selected_versions;
+
+    foreach my $version (@all_versions) {
+        if ( $version_checker->in_range( $version, $version_range ) ) {
+            push @selected_versions, $version;
+        }
+    }
+
+    if ( !@selected_versions ) {
+        return;
+    }
+
+    my @matched_advisories;
+    foreach my $advisory (@advisories) {
+        my @affected_versions = $version_checker->affected_versions( \@all_versions, $advisory->{affected_versions} );
+        next unless @affected_versions;
+
+        foreach my $affected_version ( reverse @affected_versions ) {
+            if ( $version_checker->in_range( $affected_version, $version_range ) ) {
+                push @matched_advisories, $advisory;
+                last;
+            }
+        }
+    }
+
+    if ( !@matched_advisories ) {
+        return;
+    }
+
+    return @matched_advisories;
+}
+
+1;

Perl OTRS/Kernel/cpan-lib/CPAN/Audit/Version.pm

@@ -0,0 +1,73 @@
+package CPAN::Audit::Version;
+use strict;
+use warnings;
+use version;
+
+sub new {
+    my $class = shift;
+
+    my $self = {};
+    bless $self, $class;
+
+    return $self;
+}
+
+sub in_range {
+    my $self = shift;
+    my ( $version, $range ) = @_;
+
+    return unless defined $version && defined $range;
+
+    my @ands = split /\s*,\s*/, $range;
+
+    return unless defined( $version = eval { version->parse($version) } );
+
+    foreach my $and (@ands) {
+        my ( $op, $range_version ) = $and =~ m/^(<=|<|>=|>|==|!=)?\s*([^\s]+)$/;
+
+        return
+          unless defined( $range_version = eval { version->parse($range_version) } );
+
+        $op = '>=' unless defined $op;
+
+        if ( $op eq '<' ) {
+            return unless $version < $range_version;
+        }
+        elsif ( $op eq '<=' ) {
+            return unless $version <= $range_version;
+        }
+        elsif ( $op eq '>' ) {
+            return unless $version > $range_version;
+        }
+        elsif ( $op eq '>=' ) {
+            return unless $version >= $range_version;
+        }
+        elsif ( $op eq '==' ) {
+            return unless $version == $range_version;
+        }
+        elsif ( $op eq '!=' ) {
+            return unless $version != $range_version;
+        }
+        else {
+            return 0;
+        }
+    }
+
+    return 1;
+}
+
+sub affected_versions {
+    my $self = shift;
+    my ( $available_versions, $range ) = @_;
+
+    my @affected_versions;
+    foreach my $version (@$available_versions) {
+        if ( $self->in_range( $version, $range ) ) {
+            push @affected_versions, $version;
+        }
+    }
+
+    return @affected_versions;
+}
+
+1;

Perl OTRS/Kernel/cpan-lib/CPAN/DistnameInfo.pm

@@ -0,0 +1,205 @@
+
+package CPAN::DistnameInfo;
+
+$VERSION = "0.12";
+use strict;
+
+sub distname_info {
+  my $file = shift or return;
+
+  my ($dist, $version) = $file =~ /^
+    ((?:[-+.]*(?:[A-Za-z0-9]+|(?<=\D)_|_(?=\D))*
+     (?:
+	[A-Za-z](?=[^A-Za-z]|$)
+	|
+	\d(?=-)
+     )(?<![._-][vV])
+    )+)(.*)
+  $/xs or return ($file,undef,undef);
+
+  if ($dist =~ /-undef\z/ and ! length $version) {
+    $dist =~ s/-undef\z//;
+  }
+
+  # Remove potential -withoutworldwriteables suffix
+  $version =~ s/-withoutworldwriteables$//;
+
+  if ($version =~ /^(-[Vv].*)-(\d.*)/) {
+   
+    # Catch names like Unicode-Collate-Standard-V3_1_1-0.1
+    # where the V3_1_1 is part of the distname
+    $dist .= $1;
+    $version = $2;
+  }
+
+  if ($version =~ /(.+_.*)-(\d.*)/) {
+      # Catch names like Task-Deprecations5_14-1.00.tar.gz where the 5_14 is
+      # part of the distname. However, names like libao-perl_0.03-1.tar.gz
+      # should still have 0.03-1 as their version.
+      $dist .= $1;
+      $version = $2;
+  }
+
+  # Normalize the Dist.pm-1.23 convention which CGI.pm and
+  # a few others use.
+  $dist =~ s{\.pm$}{};
+
+  $version = $1
+    if !length $version and $dist =~ s/-(\d+\w)$//;
+
+  $version = $1 . $version
+    if $version =~ /^\d+$/ and $dist =~ s/-(\w+)$//;
+
+  if ($version =~ /\d\.\d/) {
+    $version =~ s/^[-_.]+//;
+  }
+  else {
+    $version =~ s/^[-_]+//;
+  }
+
+  my $dev;
+  if (length $version) {
+    if ($file =~ /^perl-?\d+\.(\d+)(?:\D(\d+))?(-(?:TRIAL|RC)\d+)?$/) {
+      $dev = 1 if (($1 > 6 and $1 & 1) or ($2 and $2 >= 50)) or $3;
+    }
+    elsif ($version =~ /\d\D\d+_\d/ or $version =~ /-TRIAL/) {
+      $dev = 1;
+    }
+  }
+  else {
+    $version = undef;
+  }
+
+  ($dist, $version, $dev);
+}
+
+sub new {
+  my $class = shift;
+  my $distfile = shift;
+
+  $distfile =~ s,//+,/,g;
+
+  my %info = ( pathname => $distfile );
+
+  ($info{filename} = $distfile) =~ s,^(((.*?/)?authors/)?id/)?([A-Z])/(\4[A-Z])/(\5[-A-Z0-9]*)/,,
+    and $info{cpanid} = $6;
+
+  if ($distfile =~ m,([^/]+)\.(tar\.(?:g?z|bz2)|zip|tgz)$,i) { # support more ?
+    $info{distvname} = $1;
+    $info{extension} = $2;
+  }
+
+  @info{qw(dist version beta)} = distname_info($info{distvname});
+  $info{maturity} = delete $info{beta} ? 'developer' : 'released';
+
+  return bless \%info, $class;
+}
+
+sub dist      { shift->{dist} }
+sub version   { shift->{version} }
+sub maturity  { shift->{maturity} }
+sub filename  { shift->{filename} }
+sub cpanid    { shift->{cpanid} }
+sub distvname { shift->{distvname} }
+sub extension { shift->{extension} }
+sub pathname  { shift->{pathname} }
+
+sub properties { %{ $_[0] } }
+
+1;
+
+__END__
+
+=head1 NAME
+
+CPAN::DistnameInfo - Extract distribution name and version from a distribution filename
+
+=head1 SYNOPSIS
+
+  my $pathname = "authors/id/G/GB/GBARR/CPAN-DistnameInfo-0.02.tar.gz";
+
+  my $d = CPAN::DistnameInfo->new($pathname);
+
+  my $dist      = $d->dist;      # "CPAN-DistnameInfo"
+  my $version   = $d->version;   # "0.02"
+  my $maturity  = $d->maturity;  # "released"
+  my $filename  = $d->filename;  # "CPAN-DistnameInfo-0.02.tar.gz"
+  my $cpanid    = $d->cpanid;    # "GBARR"
+  my $distvname = $d->distvname; # "CPAN-DistnameInfo-0.02"
+  my $extension = $d->extension; # "tar.gz"
+  my $pathname  = $d->pathname;  # "authors/id/G/GB/GBARR/..."
+
+  my %prop = $d->properties;
+
+=head1 DESCRIPTION
+
+Many online services that are centered around CPAN attempt to
+associate multiple uploads by extracting a distribution name from
+the filename of the upload. For most distributions this is easy as
+they have used ExtUtils::MakeMaker or Module::Build to create the
+distribution, which results in a uniform name. But sadly not all
+uploads are created in this way.
+
+C<CPAN::DistnameInfo> uses heuristics that have been learnt by
+L<http://search.cpan.org/> to extract the distribution name and
+version from filenames and also report if the version is to be
+treated as a developer release
+
+The constructor takes a single pathname, returning an object with the following methods
+
+=over
+
+=item cpanid
+
+If the path given looked like a CPAN authors directory path, then this will be the
+the CPAN id of the author.
+
+=item dist
+
+The name of the distribution
+
+=item distvname
+
+The file name with any suffix and leading directory names removed
+
+=item filename
+
+If the path given looked like a CPAN authors directory path, then this will be the
+path to the file relative to the detected CPAN author directory. Otherwise it is the path
+that was passed in.
+
+=item maturity
+
+The maturity of the distribution. This will be either C<released> or C<developer>
+
+=item extension
+
+The extension of the distribution, often used to denote the archive type (e.g. 'tar.gz')
+
+=item pathname
+
+The pathname that was passed to the constructor when creating the object.
+
+=item properties
+
+This will return a list of key-value pairs, suitable for assigning to a hash,
+for the known properties.
+
+=item version
+
+The extracted version
+
+=back
+
+=head1 AUTHOR
+
+Graham Barr <gbarr@pobox.com>
+
+=head1 COPYRIGHT 
+
+Copyright (c) 2003 Graham Barr. All rights reserved. This program is
+free software; you can redistribute it and/or modify it under the same
+terms as Perl itself.
+
+=cut
+