X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FNet%2FPOP3.pm;h=8381c81815e7cd0af764a6d2172dc5d09eb02f0f;hb=89b2b9f7f6c8f99f7999c5b3fe437be2abac4340;hp=6a0514765f3c1d2dead9dd41ee3c2cc70c2ebd16;hpb=406c51eefa6c9c4f403ef7f86adb46a627701935;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Net/POP3.pm b/lib/Net/POP3.pm index 6a05147..8381c81 100644 --- a/lib/Net/POP3.pm +++ b/lib/Net/POP3.pm @@ -1,6 +1,6 @@ # Net::POP3.pm # -# Copyright (c) 1995-1997 Graham Barr . All rights reserved. +# Copyright (c) 1995-2004 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. @@ -13,50 +13,63 @@ use Net::Cmd; use Carp; use Net::Config; -$VERSION = "2.21"; # $Id$ +$VERSION = "2.29"; @ISA = qw(Net::Cmd IO::Socket::INET); -sub new -{ - my $self = shift; - my $type = ref($self) || $self; - my $host = shift if @_ % 2; - my %arg = @_; - my $hosts = defined $host ? [ $host ] : $NetConfig{pop3_hosts}; - my $obj; - my @localport = exists $arg{ResvPort} ? ( LocalPort => $arg{ResvPort} ): (); - - my $h; - foreach $h (@{$hosts}) - { - $obj = $type->SUPER::new(PeerAddr => ($host = $h), - PeerPort => $arg{Port} || 'pop3(110)', - Proto => 'tcp', - @localport, - Timeout => defined $arg{Timeout} - ? $arg{Timeout} - : 120 - ) and last; + +sub new { + my $self = shift; + my $type = ref($self) || $self; + my ($host, %arg); + if (@_ % 2) { + $host = shift; + %arg = @_; + } + else { + %arg = @_; + $host = delete $arg{Host}; + } + my $hosts = defined $host ? [$host] : $NetConfig{pop3_hosts}; + my $obj; + my @localport = exists $arg{ResvPort} ? (LocalPort => $arg{ResvPort}) : (); + + my $h; + foreach $h (@{$hosts}) { + $obj = $type->SUPER::new( + PeerAddr => ($host = $h), + PeerPort => $arg{Port} || 'pop3(110)', + Proto => 'tcp', + @localport, + Timeout => defined $arg{Timeout} + ? $arg{Timeout} + : 120 + ) + and last; } - return undef - unless defined $obj; + return undef + unless defined $obj; - ${*$obj}{'net_pop3_host'} = $host; + ${*$obj}{'net_pop3_host'} = $host; - $obj->autoflush(1); - $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef); + $obj->autoflush(1); + $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef); - unless ($obj->response() == CMD_OK) - { - $obj->close(); - return undef; + unless ($obj->response() == CMD_OK) { + $obj->close(); + return undef; } - ${*$obj}{'net_pop3_banner'} = $obj->message; + ${*$obj}{'net_pop3_banner'} = $obj->message; + + $obj; +} + - $obj; +sub host { + my $me = shift; + ${*$me}{'net_pop3_host'}; } ## @@ -64,253 +77,272 @@ sub new ## now do we :-) ## -sub debug_text { $_[2] =~ /^(pass|rpop)/i ? "$1 ....\n" : $_[2]; } - -sub login -{ - @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )'; - my($me,$user,$pass) = @_; - if(@_ <= 2) - { - require Net::Netrc; - - $user ||= eval { (getpwuid($>))[0] } || $ENV{NAME}; +sub debug_text { $_[2] =~ /^(pass|rpop)/i ? "$1 ....\n" : $_[2]; } - my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user); - $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'}); +sub login { + @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )'; + my ($me, $user, $pass) = @_; - $pass = $m ? $m->password || "" - : ""; + if (@_ <= 2) { + ($user, $pass) = $me->_lookup_credentials($user); } - $me->user($user) and - $me->pass($pass); + $me->user($user) + and $me->pass($pass); } -sub apop -{ - @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )'; - my($me,$user,$pass) = @_; - my $banner; - unless(eval { require MD5 }) - { - carp "You need to install MD5 to use the APOP command"; - return undef; +sub apop { + @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )'; + my ($me, $user, $pass) = @_; + my $banner; + my $md; + + if (eval { local $SIG{__DIE__}; require Digest::MD5 }) { + $md = Digest::MD5->new(); + } + elsif (eval { local $SIG{__DIE__}; require MD5 }) { + $md = MD5->new(); + } + else { + carp "You need to install Digest::MD5 or MD5 to use the APOP command"; + return undef; } - return undef - unless ( $banner = (${*$me}{'net_pop3_banner'} =~ /(<.*>)/)[0] ); + return undef + unless ($banner = (${*$me}{'net_pop3_banner'} =~ /(<.*>)/)[0]); - if(@_ <= 2) - { - require Net::Netrc; + if (@_ <= 2) { + ($user, $pass) = $me->_lookup_credentials($user); + } - $user ||= eval { (getpwuid($>))[0] } || $ENV{NAME}; + $md->add($banner, $pass); - my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user); + return undef + unless ($me->_APOP($user, $md->hexdigest)); - $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'}); + $me->_get_mailbox_count(); +} - $pass = $m ? $m->password || "" - : ""; - } - my $md = new MD5; - $md->add($banner,$pass); +sub user { + @_ == 2 or croak 'usage: $pop3->user( USER )'; + $_[0]->_USER($_[1]) ? 1 : undef; +} - return undef - unless($me->_APOP($user,$md->hexdigest)); - my $ret = ${*$me}{'net_pop3_count'} = ($me->message =~ /(\d+)\s+message/io) - ? $1 : ($me->popstat)[0]; +sub pass { + @_ == 2 or croak 'usage: $pop3->pass( PASS )'; - $ret ? $ret : "0E0"; -} + my ($me, $pass) = @_; -sub user -{ - @_ == 2 or croak 'usage: $pop3->user( USER )'; - $_[0]->_USER($_[1]) ? 1 : undef; -} + return undef + unless ($me->_PASS($pass)); -sub pass -{ - @_ == 2 or croak 'usage: $pop3->pass( PASS )'; + $me->_get_mailbox_count(); +} - my($me,$pass) = @_; - return undef - unless($me->_PASS($pass)); +sub reset { + @_ == 1 or croak 'usage: $obj->reset()'; - my $ret = ${*$me}{'net_pop3_count'} = ($me->message =~ /(\d+)\s+message/io) - ? $1 : ($me->popstat)[0]; + my $me = shift; - $ret ? $ret : "0E0"; -} + return 0 + unless ($me->_RSET); -sub reset -{ - @_ == 1 or croak 'usage: $obj->reset()'; - - my $me = shift; - - return 0 - unless($me->_RSET); - - if(defined ${*$me}{'net_pop3_mail'}) - { - local $_; - foreach (@{${*$me}{'net_pop3_mail'}}) - { - delete $_->{'net_pop3_deleted'}; + if (defined ${*$me}{'net_pop3_mail'}) { + local $_; + foreach (@{${*$me}{'net_pop3_mail'}}) { + delete $_->{'net_pop3_deleted'}; } } } -sub last -{ - @_ == 1 or croak 'usage: $obj->last()'; - return undef +sub last { + @_ == 1 or croak 'usage: $obj->last()'; + + return undef unless $_[0]->_LAST && $_[0]->message =~ /(\d+)/; - return $1; + return $1; } -sub top -{ - @_ == 2 || @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])'; - my $me = shift; - return undef +sub top { + @_ == 2 || @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])'; + my $me = shift; + + return undef unless $me->_TOP($_[0], $_[1] || 0); - $me->read_until_dot; + $me->read_until_dot; } -sub popstat -{ - @_ == 1 or croak 'usage: $pop3->popstat()'; - my $me = shift; - return () +sub popstat { + @_ == 1 or croak 'usage: $pop3->popstat()'; + my $me = shift; + + return () unless $me->_STAT && $me->message =~ /(\d+)\D+(\d+)/; - ($1 || 0, $2 || 0); + ($1 || 0, $2 || 0); } -sub list -{ - @_ == 1 || @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )'; - my $me = shift; - return undef +sub list { + @_ == 1 || @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )'; + my $me = shift; + + return undef unless $me->_LIST(@_); - if(@_) - { - $me->message =~ /\d+\D+(\d+)/; - return $1 || undef; + if (@_) { + $me->message =~ /\d+\D+(\d+)/; + return $1 || undef; } - - my $info = $me->read_until_dot - or return undef; - my %hash = map { (/(\d+)\D+(\d+)/) } @$info; + my $info = $me->read_until_dot + or return undef; - return \%hash; + my %hash = map { (/(\d+)\D+(\d+)/) } @$info; + + return \%hash; } -sub get -{ - @_ == 2 or @_ == 3 or croak 'usage: $pop3->get( MSGNUM [, FH ])'; - my $me = shift; - return undef +sub get { + @_ == 2 or @_ == 3 or croak 'usage: $pop3->get( MSGNUM [, FH ])'; + my $me = shift; + + return undef unless $me->_RETR(shift); - $me->read_until_dot(@_); + $me->read_until_dot(@_); } -sub delete -{ - @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )'; - $_[0]->_DELE($_[1]); + +sub getfh { + @_ == 2 or croak 'usage: $pop3->getfh( MSGNUM )'; + my $me = shift; + + return unless $me->_RETR(shift); + return $me->tied_fh; } -sub uidl -{ - @_ == 1 || @_ == 2 or croak 'usage: $pop3->uidl( [ MSGNUM ] )'; - my $me = shift; - my $uidl; - $me->_UIDL(@_) or - return undef; - if(@_) - { - $uidl = ($me->message =~ /\d+\s+([\041-\176]+)/)[0]; +sub delete { + @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )'; + my $me = shift; + return 0 unless $me->_DELE(@_); + ${*$me}{'net_pop3_deleted'} = 1; +} + + +sub uidl { + @_ == 1 || @_ == 2 or croak 'usage: $pop3->uidl( [ MSGNUM ] )'; + my $me = shift; + my $uidl; + + $me->_UIDL(@_) + or return undef; + if (@_) { + $uidl = ($me->message =~ /\d+\s+([\041-\176]+)/)[0]; } - else - { - my $ref = $me->read_until_dot - or return undef; - my $ln; - $uidl = {}; - foreach $ln (@$ref) { - my($msg,$uid) = $ln =~ /^\s*(\d+)\s+([\041-\176]+)/; - $uidl->{$msg} = $uid; - } + else { + my $ref = $me->read_until_dot + or return undef; + my $ln; + $uidl = {}; + foreach $ln (@$ref) { + my ($msg, $uid) = $ln =~ /^\s*(\d+)\s+([\041-\176]+)/; + $uidl->{$msg} = $uid; + } } - return $uidl; + return $uidl; +} + + +sub ping { + @_ == 2 or croak 'usage: $pop3->ping( USER )'; + my $me = shift; + + return () unless $me->_PING(@_) && $me->message =~ /(\d+)\D+(\d+)/; + + ($1 || 0, $2 || 0); } -sub ping -{ - @_ == 2 or croak 'usage: $pop3->ping( USER )'; - my $me = shift; - return () unless $me->_PING(@_) && $me->message =~ /(\d+)\D+(\d+)/; +sub _lookup_credentials { + my ($me, $user) = @_; + + require Net::Netrc; + + $user ||= eval { local $SIG{__DIE__}; (getpwuid($>))[0] } + || $ENV{NAME} + || $ENV{USER} + || $ENV{LOGNAME}; - ($1 || 0, $2 || 0); + my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'}, $user); + $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'}); + + my $pass = $m + ? $m->password || "" + : ""; + + ($user, $pass); } - + +sub _get_mailbox_count { + my ($me) = @_; + my $ret = ${*$me}{'net_pop3_count'} = + ($me->message =~ /(\d+)\s+message/io) ? $1 : ($me->popstat)[0]; + + $ret ? $ret : "0E0"; +} + + sub _STAT { shift->command('STAT')->response() == CMD_OK } -sub _LIST { shift->command('LIST',@_)->response() == CMD_OK } -sub _RETR { shift->command('RETR',$_[0])->response() == CMD_OK } -sub _DELE { shift->command('DELE',$_[0])->response() == CMD_OK } +sub _LIST { shift->command('LIST', @_)->response() == CMD_OK } +sub _RETR { shift->command('RETR', $_[0])->response() == CMD_OK } +sub _DELE { shift->command('DELE', $_[0])->response() == CMD_OK } sub _NOOP { shift->command('NOOP')->response() == CMD_OK } sub _RSET { shift->command('RSET')->response() == CMD_OK } sub _QUIT { shift->command('QUIT')->response() == CMD_OK } sub _TOP { shift->command('TOP', @_)->response() == CMD_OK } -sub _UIDL { shift->command('UIDL',@_)->response() == CMD_OK } -sub _USER { shift->command('USER',$_[0])->response() == CMD_OK } -sub _PASS { shift->command('PASS',$_[0])->response() == CMD_OK } -sub _APOP { shift->command('APOP',@_)->response() == CMD_OK } -sub _PING { shift->command('PING',$_[0])->response() == CMD_OK } +sub _UIDL { shift->command('UIDL', @_)->response() == CMD_OK } +sub _USER { shift->command('USER', $_[0])->response() == CMD_OK } +sub _PASS { shift->command('PASS', $_[0])->response() == CMD_OK } +sub _APOP { shift->command('APOP', @_)->response() == CMD_OK } +sub _PING { shift->command('PING', $_[0])->response() == CMD_OK } + -sub _RPOP { shift->command('RPOP',$_[0])->response() == CMD_OK } +sub _RPOP { shift->command('RPOP', $_[0])->response() == CMD_OK } sub _LAST { shift->command('LAST')->response() == CMD_OK } -sub quit -{ - my $me = shift; - $me->_QUIT; - $me->close; +sub _CAPA { shift->command('CAPA')->response() == CMD_OK } + + +sub quit { + my $me = shift; + + $me->_QUIT; + $me->close; } -sub DESTROY -{ - my $me = shift; - if(defined fileno($me)) - { - $me->reset; - $me->quit; +sub DESTROY { + my $me = shift; + + if (defined fileno($me) and ${*$me}{'net_pop3_deleted'}) { + $me->reset; + $me->quit; } } @@ -318,28 +350,178 @@ sub DESTROY ## POP3 has weird responses, so we emulate them to look the same :-) ## -sub response -{ - my $cmd = shift; - my $str = $cmd->getline() || return undef; - my $code = "500"; - $cmd->debug_print(0,$str) - if ($cmd->debug); +sub response { + my $cmd = shift; + my $str = $cmd->getline() or return undef; + my $code = "500"; + + $cmd->debug_print(0, $str) + if ($cmd->debug); + + if ($str =~ s/^\+OK\s*//io) { + $code = "200"; + } + elsif ($str =~ s/^\+\s*//io) { + $code = "300"; + } + else { + $str =~ s/^-ERR\s*//io; + } + + ${*$cmd}{'net_cmd_resp'} = [$str]; + ${*$cmd}{'net_cmd_code'} = $code; + + substr($code, 0, 1); +} + + +sub capa { + my $this = shift; + my ($capa, %capabilities); + + # Fake a capability here + $capabilities{APOP} = '' if ($this->banner() =~ /<.*>/); + + if ($this->_CAPA()) { + $capabilities{CAPA} = 1; + $capa = $this->read_until_dot(); + %capabilities = (%capabilities, map {/^\s*(\S+)\s*(.*)/} @$capa); + } + else { + + # Check AUTH for SASL capabilities + if ($this->command('AUTH')->response() == CMD_OK) { + my $mechanism = $this->read_until_dot(); + $capabilities{SASL} = join " ", map {m/([A-Z0-9_-]+)/} @{$mechanism}; + } + } + + return ${*$this}{'net_pop3e_capabilities'} = \%capabilities; +} + + +sub capabilities { + my $this = shift; + + ${*$this}{'net_pop3e_capabilities'} || $this->capa; +} + + +sub auth { + my ($self, $username, $password) = @_; + + eval { + require MIME::Base64; + require Authen::SASL; + } or $self->set_status(500, ["Need MIME::Base64 and Authen::SASL todo auth"]), return 0; + + my $capa = $self->capa; + my $mechanisms = $capa->{SASL} || 'CRAM-MD5'; + + my $sasl; + + if (ref($username) and UNIVERSAL::isa($username, 'Authen::SASL')) { + $sasl = $username; + my $user_mech = $sasl->mechanism || ''; + my @user_mech = split(/\s+/, $user_mech); + my %user_mech; + @user_mech{@user_mech} = (); + + my @server_mech = split(/\s+/, $mechanisms); + my @mech = @user_mech + ? grep { exists $user_mech{$_} } @server_mech + : @server_mech; + unless (@mech) { + $self->set_status( + 500, + [ 'Client SASL mechanisms (', + join(', ', @user_mech), + ') do not match the SASL mechnism the server announces (', + join(', ', @server_mech), ')', + ] + ); + return 0; + } - if($str =~ s/^\+OK\s+//io) - { - $code = "200" + $sasl->mechanism(join(" ", @mech)); } - else - { - $str =~ s/^-ERR\s+//io; + else { + die "auth(username, password)" if not length $username; + $sasl = Authen::SASL->new( + mechanism => $mechanisms, + callback => { + user => $username, + pass => $password, + authname => $username, + } + ); } - ${*$cmd}{'net_cmd_resp'} = [ $str ]; - ${*$cmd}{'net_cmd_code'} = $code; + # We should probably allow the user to pass the host, but I don't + # currently know and SASL mechanisms that are used by smtp that need it + my ($hostname) = split /:/, ${*$self}{'net_pop3_host'}; + my $client = eval { $sasl->client_new('pop', $hostname, 0) }; + + unless ($client) { + my $mech = $sasl->mechanism; + $self->set_status( + 500, + [ " Authen::SASL failure: $@", + '(please check if your local Authen::SASL installation', + "supports mechanism '$mech'" + ] + ); + return 0; + } - substr($code,0,1); + my ($token) = $client->client_start + or do { + my $mech = $client->mechanism; + $self->set_status( + 500, + [ ' Authen::SASL failure: $client->client_start ', + "mechanism '$mech' hostname #$hostname#", + $client->error + ] + ); + return 0; + }; + + # We dont support sasl mechanisms that encrypt the socket traffic. + # todo that we would really need to change the ISA hierarchy + # so we dont inherit from IO::Socket, but instead hold it in an attribute + + my @cmd = ("AUTH", $client->mechanism); + my $code; + + push @cmd, MIME::Base64::encode_base64($token, '') + if defined $token and length $token; + + while (($code = $self->command(@cmd)->response()) == CMD_MORE) { + + my ($token) = $client->client_step(MIME::Base64::decode_base64(($self->message)[0])) or do { + $self->set_status( + 500, + [ ' Authen::SASL failure: $client->client_step ', + "mechanism '", $client->mechanism, " hostname #$hostname#, ", + $client->error + ] + ); + return 0; + }; + + @cmd = (MIME::Base64::encode_base64(defined $token ? $token : '', '')); + } + + $code == CMD_OK; +} + + +sub banner { + my $this = shift; + + return ${*$this}{'net_pop3_banner'}; } 1; @@ -348,45 +530,58 @@ __END__ =head1 NAME -Net::POP3 - Post Office Protocol 3 Client class (RFC1081) +Net::POP3 - Post Office Protocol 3 Client class (RFC1939) =head1 SYNOPSIS use Net::POP3; - + # Constructors $pop = Net::POP3->new('pop3host'); $pop = Net::POP3->new('pop3host', Timeout => 60); + if ($pop->login($username, $password) > 0) { + my $msgnums = $pop->list; # hashref of msgnum => size + foreach my $msgnum (keys %$msgnums) { + my $msg = $pop->get($msgnum); + print @$msg; + $pop->delete($msgnum); + } + } + + $pop->quit; + =head1 DESCRIPTION This module implements a client interface to the POP3 protocol, enabling a perl5 application to talk to POP3 servers. This documentation assumes -that you are familiar with the POP3 protocol described in RFC1081. +that you are familiar with the POP3 protocol described in RFC1939. A new Net::POP3 object must be created with the I method. Once this has been done, all POP3 commands are accessed via method calls on the object. -=head1 EXAMPLES - - Need some small examples in here :-) - =head1 CONSTRUCTOR =over 4 -=item new ( [ HOST, ] [ OPTIONS ] ) +=item new ( [ HOST ] [, OPTIONS ] 0 This is the constructor for a new Net::POP3 object. C is the -name of the remote host to which a POP3 connection is required. +name of the remote host to which an POP3 connection is required. -If C is not given, then the C specified in C -will be used. +C is optional. If C is not given then it may instead be +passed as the C option described below. If neither is given then +the C specified in C will be used. C are passed in a hash like fashion, using key and value pairs. Possible options are: +B - POP3 host to connect to. It may be a single scalar, as defined for +the C option in L, or a reference to +an array with hosts to try in turn. The L method will return the value +which was used to connect to the host. + B - If given then the socket for the C object will be bound to the local port given using C when the socket is created. @@ -407,6 +602,10 @@ empty list. =over 4 +=item auth ( USERNAME, PASSWORD ) + +Attempt SASL authentication. + =item user ( USER ) Send the USER command. @@ -417,7 +616,7 @@ Send the PASS command. Returns the number of messages in the mailbox. =item login ( [ USER [, PASS ]] ) -Send both the the USER and PASS commands. If C is not given the +Send both the USER and PASS commands. If C is not given the C uses C to lookup the password using the host and username. If the username is not specified then the current user name will be used. @@ -428,14 +627,30 @@ will give a true value in a boolean context, but zero in a numeric context. If there was an error authenticating the user then I will be returned. -=item apop ( USER, PASS ) +=item apop ( [ USER [, PASS ]] ) Authenticate with the server identifying as C with password C. -Similar ti L, but the password is not sent in clear text. +Similar to L, but the password is not sent in clear text. + +To use this method you must have the Digest::MD5 or the MD5 module installed, +otherwise this method will return I. -To use this method you must have the MD5 package installed, if you do not -this method will return I +=item banner () +Return the sever's connection banner + +=item capa () + +Return a reference to a hash of the capabilities of the server. APOP +is added as a pseudo capability. Note that I've been unable to +find a list of the standard capability values, and some appear to +be multi-word and some are not. We make an attempt at intelligently +parsing them, but it may not be correct. + +=item capabilities () + +Just like capa, but only uses a cache from the last time we asked +the server, so as to avoid asking more than once. =item top ( MSGNUM [, NUMLINES ] ) @@ -459,6 +674,12 @@ then get returns a reference to an array which contains the lines of text read from the server. If C is given then the lines returned from the server are printed to the filehandle C. +=item getfh ( MSGNUM ) + +As per get(), but returns a tied filehandle. Reading from this +filehandle returns the requested message. The filehandle will return +EOF at the end of the message and should not be reused. + =item last () Returns the highest C of all the messages accessed. @@ -487,7 +708,7 @@ when the server connection closed. =item reset () -Reset the status of the remote POP3 server. This includes reseting the +Reset the status of the remote POP3 server. This includes resetting the status of all messages to not be deleted. =item quit () @@ -505,7 +726,7 @@ means that any messages marked to be deleted will not be. =head1 SEE ALSO -L +L, L =head1 AUTHOR @@ -514,7 +735,7 @@ Graham Barr =head1 COPYRIGHT -Copyright (c) 1995-1997 Graham Barr. All rights reserved. +Copyright (c) 1995-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.