lib/File/Copy.pm

   1 # File/Copy.pm. Written in 1994 by Aaron Sherman <ajs@ajs.com>. This
   2 # source code has been placed in the public domain by the author.
   3 # Please be kind and preserve the documentation.
   4 #
   5 # Additions copyright 1996 by Charles Bailey.  Permission is granted
   6 # to distribute the revised code under the same terms as Perl itself.
   7
   8 package File::Copy;
   9
  10 use 5.006;
  11 use strict;
  12 use warnings;
  13 use File::Spec;
  14 use Config;
  15 # During perl build, we need File::Copy but Scalar::Util might not be built yet
  16 # And then we need these games to avoid loading overload, as that will
  17 # confuse miniperl during the bootstrap of perl.
  18 my $Scalar_Util_loaded = eval q{ require Scalar::Util; require overload; 1 };
  19 our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy);
  20 sub copy;
  21 sub syscopy;
  22 sub cp;
  23 sub mv;
  24
  25 $VERSION = '2.15';
  26
  27 require Exporter;
  28 @ISA = qw(Exporter);
  29 @EXPORT = qw(copy move);
  30 @EXPORT_OK = qw(cp mv);
  31
  32 $Too_Big = 1024 * 1024 * 2;
  33
  34 sub croak {
  35     require Carp;
  36     goto &Carp::croak;
  37 }
  38
  39 sub carp {
  40     require Carp;
  41     goto &Carp::carp;
  42 }
  43
  44 my $macfiles;
  45 if ($^O eq 'MacOS') {
  46         $macfiles = eval { require Mac::MoreFiles };
  47         warn 'Mac::MoreFiles could not be loaded; using non-native syscopy'
  48                 if $@ && $^W;
  49 }
  50
  51 # Look up the feature settings on VMS using VMS::Feature when available.
  52
  53 my $use_vms_feature = 0;
  54 BEGIN {
  55     if ($^O eq 'VMS') {
  56         if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
  57             $use_vms_feature = 1;
  58         }
  59     }
  60 }
  61
  62 # Need to look up the UNIX report mode.  This may become a dynamic mode
  63 # in the future.
  64 sub _vms_unix_rpt {
  65     my $unix_rpt;
  66     if ($use_vms_feature) {
  67         $unix_rpt = VMS::Feature::current("filename_unix_report");
  68     } else {
  69         my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
  70         $unix_rpt = $env_unix_rpt =~ /^[ET1]/i;
  71     }
  72     return $unix_rpt;
  73 }
  74
  75 # Need to look up the EFS character set mode.  This may become a dynamic
  76 # mode in the future.
  77 sub _vms_efs {
  78     my $efs;
  79     if ($use_vms_feature) {
  80         $efs = VMS::Feature::current("efs_charset");
  81     } else {
  82         my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
  83         $efs = $env_efs =~ /^[ET1]/i;
  84     }
  85     return $efs;
  86 }
  87
  88
  89 sub _catname {
  90     my($from, $to) = @_;
  91     if (not defined &basename) {
  92         require File::Basename;
  93         import  File::Basename 'basename';
  94     }
  95
  96     if ($^O eq 'MacOS') {
  97         # a partial dir name that's valid only in the cwd (e.g. 'tmp')
  98         $to = ':' . $to if $to !~ /:/;
  99     }
 100
 101     return File::Spec->catfile($to, basename($from));
 102 }
 103
 104 # _eq($from, $to) tells whether $from and $to are identical
 105 sub _eq {
 106     my ($from, $to) = map {
 107         $Scalar_Util_loaded && Scalar::Util::blessed($_)
 108             && overload::Method($_, q{""})
 109             ? "$_"
 110             : $_
 111     } (@_);
 112     return '' if ( (ref $from) xor (ref $to) );
 113     return $from == $to if ref $from;
 114     return $from eq $to;
 115 }
 116
 117 sub copy {
 118     croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ")
 119       unless(@_ == 2 || @_ == 3);
 120
 121     my $from = shift;
 122     my $to = shift;
 123
 124     my $size;
 125     if (@_) {
 126         $size = shift(@_) + 0;
 127         croak("Bad buffer size for copy: $size\n") unless ($size > 0);
 128     }
 129
 130     my $from_a_handle = (ref($from)
 131                          ? (ref($from) eq 'GLOB'
 132                             || UNIVERSAL::isa($from, 'GLOB')
 133                             || UNIVERSAL::isa($from, 'IO::Handle'))
 134                          : (ref(\$from) eq 'GLOB'));
 135     my $to_a_handle =   (ref($to)
 136                          ? (ref($to) eq 'GLOB'
 137                             || UNIVERSAL::isa($to, 'GLOB')
 138                             || UNIVERSAL::isa($to, 'IO::Handle'))
 139                          : (ref(\$to) eq 'GLOB'));
 140
 141     if (_eq($from, $to)) { # works for references, too
 142         carp("'$from' and '$to' are identical (not copied)");
 143         # The "copy" was a success as the source and destination contain
 144         # the same data.
 145         return 1;
 146     }
 147
 148     if ((($Config{d_symlink} && $Config{d_readlink}) || $Config{d_link}) &&
 149         !($^O eq 'MSWin32' || $^O eq 'os2')) {
 150         my @fs = stat($from);
 151         if (@fs) {
 152             my @ts = stat($to);
 153             if (@ts && $fs[0] == $ts[0] && $fs[1] == $ts[1]) {
 154                 carp("'$from' and '$to' are identical (not copied)");
 155                 return 0;
 156             }
 157         }
 158     }
 159
 160     if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) {
 161         $to = _catname($from, $to);
 162     }
 163
 164     if (defined &syscopy && !$Syscopy_is_copy
 165         && !$to_a_handle
 166         && !($from_a_handle && $^O eq 'os2' )   # OS/2 cannot handle handles
 167         && !($from_a_handle && $^O eq 'mpeix')  # and neither can MPE/iX.
 168         && !($from_a_handle && $^O eq 'MSWin32')
 169         && !($from_a_handle && $^O eq 'MacOS')
 170         && !($from_a_handle && $^O eq 'NetWare')
 171        )
 172     {
 173         my $copy_to = $to;
 174
 175         if ($^O eq 'VMS' && -e $from) {
 176
 177             if (! -d $to && ! -d $from) {
 178
 179                 my $vms_efs = _vms_efs();
 180                 my $unix_rpt = _vms_unix_rpt();
 181                 my $unix_mode = 0;
 182                 my $from_unix = 0;
 183                 $from_unix = 1 if ($from =~ /^\.\.?$/);
 184                 my $from_vms = 0;
 185                 $from_vms = 1 if ($from =~ m#[\[<\]]#);
 186
 187                 # Need to know if we are in Unix mode.
 188                 if ($from_vms == $from_unix) {
 189                     $unix_mode = $unix_rpt;
 190                 } else {
 191                     $unix_mode = $from_unix;
 192                 }
 193
 194                 # VMS has sticky defaults on extensions, which means that
 195                 # if there is a null extension on the destination file, it
 196                 # will inherit the extension of the source file
 197                 # So add a '.' for a null extension.
 198
 199                 # In unix_rpt mode, the trailing dot should not be added.
 200
 201                 if ($vms_efs) {
 202                     $copy_to = $to;
 203                 } else {
 204                     $copy_to = VMS::Filespec::vmsify($to);
 205                 }
 206                 my ($vol, $dirs, $file) = File::Spec->splitpath($copy_to);
 207                 $file = $file . '.'
 208                     unless (($file =~ /(?<!\^)\./) || $unix_rpt);
 209                 $copy_to = File::Spec->catpath($vol, $dirs, $file);
 210
 211                 # Get rid of the old versions to be like UNIX
 212                 1 while unlink $copy_to;
 213             }
 214         }
 215
 216         return syscopy($from, $copy_to);
 217     }
 218
 219     my $closefrom = 0;
 220     my $closeto = 0;
 221     my ($status, $r, $buf);
 222     local($\) = '';
 223
 224     my $from_h;
 225     if ($from_a_handle) {
 226        $from_h = $from;
 227     } else {
 228        open $from_h, "<", $from or goto fail_open1;
 229        binmode $from_h or die "($!,$^E)";
 230        $closefrom = 1;
 231     }
 232
 233     # Seems most logical to do this here, in case future changes would want to
 234     # make this croak for some reason.
 235     unless (defined $size) {
 236         $size = tied(*$from_h) ? 0 : -s $from_h || 0;
 237         $size = 1024 if ($size < 512);
 238         $size = $Too_Big if ($size > $Too_Big);
 239     }
 240
 241     my $to_h;
 242     if ($to_a_handle) {
 243        $to_h = $to;
 244     } else {
 245         $to = _protect($to) if $to =~ /^\s/s;
 246         $to_h = \do { local *FH };
 247         open $to_h, ">", $to or goto fail_open2;
 248         binmode $to_h or die "($!,$^E)";
 249         $closeto = 1;
 250     }
 251
 252     $! = 0;
 253     for (;;) {
 254         my ($r, $w, $t);
 255        defined($r = sysread($from_h, $buf, $size))
 256             or goto fail_inner;
 257         last unless $r;
 258         for ($w = 0; $w < $r; $w += $t) {
 259            $t = syswrite($to_h, $buf, $r - $w, $w)
 260                 or goto fail_inner;
 261         }
 262     }
 263
 264     close($to_h) || goto fail_open2 if $closeto;
 265     close($from_h) || goto fail_open1 if $closefrom;
 266
 267     # Use this idiom to avoid uninitialized value warning.
 268     return 1;
 269
 270     # All of these contortions try to preserve error messages...
 271   fail_inner:
 272     if ($closeto) {
 273         $status = $!;
 274         $! = 0;
 275        close $to_h;
 276         $! = $status unless $!;
 277     }
 278   fail_open2:
 279     if ($closefrom) {
 280         $status = $!;
 281         $! = 0;
 282        close $from_h;
 283         $! = $status unless $!;
 284     }
 285   fail_open1:
 286     return 0;
 287 }
 288
 289 sub cp {
 290     my($from,$to) = @_;
 291     my(@fromstat) = stat $from;
 292     my(@tostat) = stat $to;
 293     my $perm;
 294
 295     return 0 unless copy(@_) and @fromstat;
 296
 297     if (@tostat) {
 298         $perm = $tostat[2];
 299     } else {
 300         $perm = $fromstat[2] & ~(umask || 0);
 301         @tostat = stat $to;
 302     }
 303     # Might be more robust to look for S_I* in Fcntl, but we're
 304     # trying to avoid dependence on any XS-containing modules,
 305     # since File::Copy is used during the Perl build.
 306     $perm &= 07777;
 307     if ($perm & 06000) {
 308         croak("Unable to check setuid/setgid permissions for $to: $!")
 309             unless @tostat;
 310
 311         if ($perm & 04000 and                     # setuid
 312             $fromstat[4] != $tostat[4]) {         # owner must match
 313             $perm &= ~06000;
 314         }
 315
 316         if ($perm & 02000) {                      # setgid
 317             my $ok = $fromstat[5] == $tostat[5];  # group must match
 318             if ($ok) {                            # and we must be in group
 319                 my $uname = (getpwuid($>))[0] || '';
 320                 my(@members) = split /\s+/, (getgrgid($fromstat[5]))[3];
 321                 $ok = grep { $_ eq $uname } @members;
 322             }
 323             $perm &= ~06000 unless $ok;
 324         }
 325     }
 326     return 0 unless @tostat;
 327     return 1 if $perm == ($tostat[2] & 07777);
 328     return eval { chmod $perm, $to; } ? 1 : 0;
 329 }
 330
 331 sub _move {
 332     croak("Usage: move(FROM, TO) ") unless @_ == 3;
 333
 334     my($from,$to,$fallback) = @_;
 335
 336     my($fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts);
 337
 338     if (-d $to && ! -d $from) {
 339         $to = _catname($from, $to);
 340     }
 341
 342     ($tosz1,$tomt1) = (stat($to))[7,9];
 343     $fromsz = -s $from;
 344     if ($^O eq 'os2' and defined $tosz1 and defined $fromsz) {
 345       # will not rename with overwrite
 346       unlink $to;
 347     }
 348
 349     my $rename_to = $to;
 350     if (-$^O eq 'VMS' && -e $from) {
 351
 352         if (! -d $to && ! -d $from) {
 353
 354             my $vms_efs = _vms_efs();
 355             my $unix_rpt = _vms_unix_rpt();
 356             my $unix_mode = 0;
 357             my $from_unix = 0;
 358             $from_unix = 1 if ($from =~ /^\.\.?$/);
 359             my $from_vms = 0;
 360             $from_vms = 1 if ($from =~ m#[\[<\]]#);
 361
 362             # Need to know if we are in Unix mode.
 363             if ($from_vms == $from_unix) {
 364                 $unix_mode = $unix_rpt;
 365             } else {
 366                 $unix_mode = $from_unix;
 367             }
 368
 369             # VMS has sticky defaults on extensions, which means that
 370             # if there is a null extension on the destination file, it
 371             # will inherit the extension of the source file
 372             # So add a '.' for a null extension.
 373
 374             # In unix_rpt mode, the trailing dot should not be added.
 375
 376             if ($vms_efs) {
 377                 $rename_to = $to;
 378             } else {
 379                 $rename_to = VMS::Filespec::vmsify($to);
 380             }
 381             my ($vol, $dirs, $file) = File::Spec->splitpath($rename_to);
 382             $file = $file . '.'
 383                 unless (($file =~ /(?<!\^)\./) || $unix_rpt);
 384             $rename_to = File::Spec->catpath($vol, $dirs, $file);
 385
 386             # Get rid of the old versions to be like UNIX
 387             1 while unlink $rename_to;
 388         }
 389     }
 390
 391     return 1 if rename $from, $rename_to;
 392
 393     # Did rename return an error even though it succeeded, because $to
 394     # is on a remote NFS file system, and NFS lost the server's ack?
 395     return 1 if defined($fromsz) && !-e $from &&           # $from disappeared
 396                 (($tosz2,$tomt2) = (stat($to))[7,9]) &&    # $to's there
 397                   ((!defined $tosz1) ||                    #  not before or
 398                    ($tosz1 != $tosz2 or $tomt1 != $tomt2)) &&  #   was changed
 399                 $tosz2 == $fromsz;                         # it's all there
 400
 401     ($tosz1,$tomt1) = (stat($to))[7,9];  # just in case rename did something
 402
 403     {
 404         local $@;
 405         eval {
 406             local $SIG{__DIE__};
 407             $fallback->($from,$to) or die;
 408             my($atime, $mtime) = (stat($from))[8,9];
 409             utime($atime, $mtime, $to);
 410             unlink($from)   or die;
 411         };
 412         return 1 unless $@;
 413     }
 414     ($sts,$ossts) = ($! + 0, $^E + 0);
 415
 416     ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
 417     unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2;
 418     ($!,$^E) = ($sts,$ossts);
 419     return 0;
 420 }
 421
 422 sub move { _move(@_,\&copy); }
 423 sub mv   { _move(@_,\&cp);   }
 424
 425 # &syscopy is an XSUB under OS/2
 426 unless (defined &syscopy) {
 427     if ($^O eq 'VMS') {
 428         *syscopy = \&rmscopy;
 429     } elsif ($^O eq 'mpeix') {
 430         *syscopy = sub {
 431             return 0 unless @_ == 2;
 432             # Use the MPE cp program in order to
 433             # preserve MPE file attributes.
 434             return system('/bin/cp', '-f', $_[0], $_[1]) == 0;
 435         };
 436     } elsif ($^O eq 'MSWin32' && defined &DynaLoader::boot_DynaLoader) {
 437         # Win32::CopyFile() fill only work if we can load Win32.xs
 438         *syscopy = sub {
 439             return 0 unless @_ == 2;
 440             return Win32::CopyFile(@_, 1);
 441         };
 442     } elsif ($macfiles) {
 443         *syscopy = sub {
 444             my($from, $to) = @_;
 445             my($dir, $toname);
 446
 447             return 0 unless -e $from;
 448
 449             if ($to =~ /(.*:)([^:]+):?$/) {
 450                 ($dir, $toname) = ($1, $2);
 451             } else {
 452                 ($dir, $toname) = (":", $to);
 453             }
 454
 455             unlink($to);
 456             Mac::MoreFiles::FSpFileCopy($from, $dir, $toname, 1);
 457         };
 458     } else {
 459         $Syscopy_is_copy = 1;
 460         *syscopy = \&copy;
 461     }
 462 }
 463
 464 1;
 465
 466 __END__
 467
 468 =head1 NAME
 469
 470 File::Copy - Copy files or filehandles
 471
 472 =head1 SYNOPSIS
 473
 474         use File::Copy;
 475
 476         copy("file1","file2") or die "Copy failed: $!";
 477         copy("Copy.pm",\*STDOUT);
 478         move("/dev1/fileA","/dev2/fileB");
 479
 480         use File::Copy "cp";
 481
 482         $n = FileHandle->new("/a/file","r");
 483         cp($n,"x");
 484
 485 =head1 DESCRIPTION
 486
 487 The File::Copy module provides two basic functions, C<copy> and
 488 C<move>, which are useful for getting the contents of a file from
 489 one place to another.
 490
 491 =over 4
 492
 493 =item copy
 494 X<copy> X<cp>
 495
 496 The C<copy> function takes two
 497 parameters: a file to copy from and a file to copy to. Either
 498 argument may be a string, a FileHandle reference or a FileHandle
 499 glob. Obviously, if the first argument is a filehandle of some
 500 sort, it will be read from, and if it is a file I<name> it will
 501 be opened for reading. Likewise, the second argument will be
 502 written to (and created if need be).  Trying to copy a file on top
 503 of itself is a fatal error.
 504
 505 B<Note that passing in
 506 files as handles instead of names may lead to loss of information
 507 on some operating systems; it is recommended that you use file
 508 names whenever possible.>  Files are opened in binary mode where
 509 applicable.  To get a consistent behaviour when copying from a
 510 filehandle to a file, use C<binmode> on the filehandle.
 511
 512 An optional third parameter can be used to specify the buffer
 513 size used for copying. This is the number of bytes from the
 514 first file, that will be held in memory at any given time, before
 515 being written to the second file. The default buffer size depends
 516 upon the file, but will generally be the whole file (up to 2MB), or
 517 1k for filehandles that do not reference files (eg. sockets).
 518
 519 You may use the syntax C<use File::Copy "cp"> to get at the C<cp>
 520 alias for this function. The syntax is I<exactly> the same.  The
 521 behavior is nearly the same as well: as of version 2.14, <cp> will
 522 preserve the source file's permission bits like the shell utility
 523 C<cp(1)> would do, while C<copy> uses the default permissions for the
 524 target file (which may depend on the process' C<umask>, file
 525 ownership, inherited ACLs, etc.).  If an error occurs in setting
 526 permissions, C<cp> will return 0, regardless of whether the file was
 527 successfully copied.
 528
 529 =item move
 530 X<move> X<mv> X<rename>
 531
 532 The C<move> function also takes two parameters: the current name
 533 and the intended name of the file to be moved.  If the destination
 534 already exists and is a directory, and the source is not a
 535 directory, then the source file will be renamed into the directory
 536 specified by the destination.
 537
 538 If possible, move() will simply rename the file.  Otherwise, it copies
 539 the file to the new location and deletes the original.  If an error occurs
 540 during this copy-and-delete process, you may be left with a (possibly partial)
 541 copy of the file under the destination name.
 542
 543 You may use the C<mv> alias for this function in the same way that
 544 you may use the <cp> alias for C<copy>.
 545
 546 =item syscopy
 547 X<syscopy>
 548
 549 File::Copy also provides the C<syscopy> routine, which copies the
 550 file specified in the first parameter to the file specified in the
 551 second parameter, preserving OS-specific attributes and file
 552 structure.  For Unix systems, this is equivalent to the simple
 553 C<copy> routine, which doesn't preserve OS-specific attributes.  For
 554 VMS systems, this calls the C<rmscopy> routine (see below).  For OS/2
 555 systems, this calls the C<syscopy> XSUB directly. For Win32 systems,
 556 this calls C<Win32::CopyFile>.
 557
 558 On Mac OS (Classic), C<syscopy> calls C<Mac::MoreFiles::FSpFileCopy>,
 559 if available.
 560
 561 B<Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)>:
 562
 563 If both arguments to C<copy> are not file handles,
 564 then C<copy> will perform a "system copy" of
 565 the input file to a new output file, in order to preserve file
 566 attributes, indexed file structure, I<etc.>  The buffer size
 567 parameter is ignored.  If either argument to C<copy> is a
 568 handle to an opened file, then data is copied using Perl
 569 operators, and no effort is made to preserve file attributes
 570 or record structure.
 571
 572 The system copy routine may also be called directly under VMS and OS/2
 573 as C<File::Copy::syscopy> (or under VMS as C<File::Copy::rmscopy>, which
 574 is the routine that does the actual work for syscopy).
 575
 576 =item rmscopy($from,$to[,$date_flag])
 577 X<rmscopy>
 578
 579 The first and second arguments may be strings, typeglobs, typeglob
 580 references, or objects inheriting from IO::Handle;
 581 they are used in all cases to obtain the
 582 I<filespec> of the input and output files, respectively.  The
 583 name and type of the input file are used as defaults for the
 584 output file, if necessary.
 585
 586 A new version of the output file is always created, which
 587 inherits the structure and RMS attributes of the input file,
 588 except for owner and protections (and possibly timestamps;
 589 see below).  All data from the input file is copied to the
 590 output file; if either of the first two parameters to C<rmscopy>
 591 is a file handle, its position is unchanged.  (Note that this
 592 means a file handle pointing to the output file will be
 593 associated with an old version of that file after C<rmscopy>
 594 returns, not the newly created version.)
 595
 596 The third parameter is an integer flag, which tells C<rmscopy>
 597 how to handle timestamps.  If it is E<lt> 0, none of the input file's
 598 timestamps are propagated to the output file.  If it is E<gt> 0, then
 599 it is interpreted as a bitmask: if bit 0 (the LSB) is set, then
 600 timestamps other than the revision date are propagated; if bit 1
 601 is set, the revision date is propagated.  If the third parameter
 602 to C<rmscopy> is 0, then it behaves much like the DCL COPY command:
 603 if the name or type of the output file was explicitly specified,
 604 then no timestamps are propagated, but if they were taken implicitly
 605 from the input filespec, then all timestamps other than the
 606 revision date are propagated.  If this parameter is not supplied,
 607 it defaults to 0.
 608
 609 Like C<copy>, C<rmscopy> returns 1 on success.  If an error occurs,
 610 it sets C<$!>, deletes the output file, and returns 0.
 611
 612 =back
 613
 614 =head1 RETURN
 615
 616 All functions return 1 on success, 0 on failure.
 617 $! will be set if an error was encountered.
 618
 619 =head1 NOTES
 620
 621 =over 4
 622
 623 =item *
 624
 625 On Mac OS (Classic), the path separator is ':', not '/', and the
 626 current directory is denoted as ':', not '.'. You should be careful
 627 about specifying relative pathnames. While a full path always begins
 628 with a volume name, a relative pathname should always begin with a
 629 ':'.  If specifying a volume name only, a trailing ':' is required.
 630
 631 E.g.
 632
 633   copy("file1", "tmp");        # creates the file 'tmp' in the current directory
 634   copy("file1", ":tmp:");      # creates :tmp:file1
 635   copy("file1", ":tmp");       # same as above
 636   copy("file1", "tmp");        # same as above, if 'tmp' is a directory (but don't do
 637                                # that, since it may cause confusion, see example #1)
 638   copy("file1", "tmp:file1");  # error, since 'tmp:' is not a volume
 639   copy("file1", ":tmp:file1"); # ok, partial path
 640   copy("file1", "DataHD:");    # creates DataHD:file1
 641
 642   move("MacintoshHD:fileA", "DataHD:fileB"); # moves (doesn't copy) files from one
 643                                              # volume to another
 644
 645 =back
 646
 647 =head1 AUTHOR
 648
 649 File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995,
 650 and updated by Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>> in 1996.
 651
 652 =cut
 653