local-lib5/lib/perl5/File/Copy/Recursive.pm

   1 package File::Copy::Recursive;
   2
   3 use strict;
   4 BEGIN {
   5     # Keep older versions of Perl from trying to use lexical warnings
   6     $INC{'warnings.pm'} = "fake warnings entry for < 5.6 perl ($])" if $] < 5.006;
   7 }
   8 use warnings;
   9
  10 use Carp;
  11 use File::Copy;
  12 use File::Spec; #not really needed because File::Copy already gets it, but for good measure :)
  13
  14 use vars qw(
  15     @ISA      @EXPORT_OK $VERSION  $MaxDepth $KeepMode $CPRFComp $CopyLink
  16     $PFSCheck $RemvBase $NoFtlPth  $ForcePth $CopyLoop $RMTrgFil $RMTrgDir
  17     $CondCopy $BdTrgWrn $SkipFlop  $DirPerms
  18 );
  19
  20 require Exporter;
  21 @ISA = qw(Exporter);
  22 @EXPORT_OK = qw(fcopy rcopy dircopy fmove rmove dirmove pathmk pathrm pathempty pathrmdir);
  23 $VERSION = '0.38';
  24
  25 $MaxDepth = 0;
  26 $KeepMode = 1;
  27 $CPRFComp = 0;
  28 $CopyLink = eval { local $SIG{'__DIE__'};symlink '',''; 1 } || 0;
  29 $PFSCheck = 1;
  30 $RemvBase = 0;
  31 $NoFtlPth = 0;
  32 $ForcePth = 0;
  33 $CopyLoop = 0;
  34 $RMTrgFil = 0;
  35 $RMTrgDir = 0;
  36 $CondCopy = {};
  37 $BdTrgWrn = 0;
  38 $SkipFlop = 0;
  39 $DirPerms = 0777;
  40
  41 my $samecheck = sub {
  42    return 1 if $^O eq 'MSWin32'; # need better way to check for this on winders...
  43    return if @_ != 2 || !defined $_[0] || !defined $_[1];
  44    return if $_[0] eq $_[1];
  45
  46    my $one = '';
  47    if($PFSCheck) {
  48       $one    = join( '-', ( stat $_[0] )[0,1] ) || '';
  49       my $two = join( '-', ( stat $_[1] )[0,1] ) || '';
  50       if ( $one eq $two && $one ) {
  51           carp "$_[0] and $_[1] are identical";
  52           return;
  53       }
  54    }
  55
  56    if(-d $_[0] && !$CopyLoop) {
  57       $one    = join( '-', ( stat $_[0] )[0,1] ) if !$one;
  58       my $abs = File::Spec->rel2abs($_[1]);
  59       my @pth = File::Spec->splitdir( $abs );
  60       while(@pth) {
  61          my $cur = File::Spec->catdir(@pth);
  62          last if !$cur; # probably not necessary, but nice to have just in case :)
  63          my $two = join( '-', ( stat $cur )[0,1] ) || '';
  64          if ( $one eq $two && $one ) {
  65              # $! = 62; # Too many levels of symbolic links
  66              carp "Caught Deep Recursion Condition: $_[0] contains $_[1]";
  67              return;
  68          }
  69
  70          pop @pth;
  71       }
  72    }
  73
  74    return 1;
  75 };
  76
  77 my $glob = sub {
  78     my ($do, $src_glob, @args) = @_;
  79
  80     local $CPRFComp = 1;
  81
  82     my @rt;
  83     for my $path ( glob($src_glob) ) {
  84         my @call = [$do->($path, @args)] or return;
  85         push @rt, \@call;
  86     }
  87
  88     return @rt;
  89 };
  90
  91 my $move = sub {
  92    my $fl = shift;
  93    my @x;
  94    if($fl) {
  95       @x = fcopy(@_) or return;
  96    } else {
  97       @x = dircopy(@_) or return;
  98    }
  99    if(@x) {
 100       if($fl) {
 101          unlink $_[0] or return;
 102       } else {
 103          pathrmdir($_[0]) or return;
 104       }
 105       if($RemvBase) {
 106          my ($volm, $path) = File::Spec->splitpath($_[0]);
 107          pathrm(File::Spec->catpath($volm,$path,''), $ForcePth, $NoFtlPth) or return;
 108       }
 109    }
 110   return wantarray ? @x : $x[0];
 111 };
 112
 113 my $ok_todo_asper_condcopy = sub {
 114     my $org = shift;
 115     my $copy = 1;
 116     if(exists $CondCopy->{$org}) {
 117         if($CondCopy->{$org}{'md5'}) {
 118
 119         }
 120         if($copy) {
 121
 122         }
 123     }
 124     return $copy;
 125 };
 126
 127 sub fcopy {
 128    $samecheck->(@_) or return;
 129    if($RMTrgFil && (-d $_[1] || -e $_[1]) ) {
 130       my $trg = $_[1];
 131       if( -d $trg ) {
 132         my @trgx = File::Spec->splitpath( $_[0] );
 133         $trg = File::Spec->catfile( $_[1], $trgx[ $#trgx ] );
 134       }
 135       $samecheck->($_[0], $trg) or return;
 136       if(-e $trg) {
 137          if($RMTrgFil == 1) {
 138             unlink $trg or carp "\$RMTrgFil failed: $!";
 139          } else {
 140             unlink $trg or return;
 141          }
 142       }
 143    }
 144    my ($volm, $path) = File::Spec->splitpath($_[1]);
 145    if($path && !-d $path) {
 146       pathmk(File::Spec->catpath($volm,$path,''), $NoFtlPth);
 147    }
 148    if( -l $_[0] && $CopyLink ) {
 149       carp "Copying a symlink ($_[0]) whose target does not exist"
 150           if !-e readlink($_[0]) && $BdTrgWrn;
 151       symlink readlink(shift()), shift() or return;
 152    } else {
 153       copy(@_) or return;
 154
 155       my @base_file = File::Spec->splitpath($_[0]);
 156       my $mode_trg = -d $_[1] ? File::Spec->catfile($_[1], $base_file[ $#base_file ]) : $_[1];
 157
 158       chmod scalar((stat($_[0]))[2]), $mode_trg if $KeepMode;
 159    }
 160    return wantarray ? (1,0,0) : 1; # use 0's incase they do math on them and in case rcopy() is called in list context = no uninit val warnings
 161 }
 162
 163 sub rcopy {
 164     if (-l $_[0] && $CopyLink) {
 165         goto &fcopy;
 166     }
 167
 168     goto &dircopy if -d $_[0] || substr( $_[0], ( 1 * -1), 1) eq '*';
 169     goto &fcopy;
 170 }
 171
 172 sub rcopy_glob {
 173     $glob->(\&rcopy, @_);
 174 }
 175
 176 sub dircopy {
 177    if($RMTrgDir && -d $_[1]) {
 178       if($RMTrgDir == 1) {
 179          pathrmdir($_[1]) or carp "\$RMTrgDir failed: $!";
 180       } else {
 181          pathrmdir($_[1]) or return;
 182       }
 183    }
 184    my $globstar = 0;
 185    my $_zero = $_[0];
 186    my $_one = $_[1];
 187    if ( substr( $_zero, ( 1 * -1 ), 1 ) eq '*') {
 188        $globstar = 1;
 189        $_zero = substr( $_zero, 0, ( length( $_zero ) - 1 ) );
 190    }
 191
 192    $samecheck->(  $_zero, $_[1] ) or return;
 193    if ( !-d $_zero || ( -e $_[1] && !-d $_[1] ) ) {
 194        $! = 20;
 195        return;
 196    }
 197
 198    if(!-d $_[1]) {
 199       pathmk($_[1], $NoFtlPth) or return;
 200    } else {
 201       if($CPRFComp && !$globstar) {
 202          my @parts = File::Spec->splitdir($_zero);
 203          while($parts[ $#parts ] eq '') { pop @parts; }
 204          $_one = File::Spec->catdir($_[1], $parts[$#parts]);
 205       }
 206    }
 207    my $baseend = $_one;
 208    my $level   = 0;
 209    my $filen   = 0;
 210    my $dirn    = 0;
 211
 212    my $recurs; #must be my()ed before sub {} since it calls itself
 213    $recurs =  sub {
 214       my ($str,$end,$buf) = @_;
 215       $filen++ if $end eq $baseend;
 216       $dirn++ if $end eq $baseend;
 217
 218       $DirPerms = oct($DirPerms) if substr($DirPerms,0,1) eq '0';
 219       mkdir($end,$DirPerms) or return if !-d $end;
 220       chmod scalar((stat($str))[2]), $end if $KeepMode;
 221       if($MaxDepth && $MaxDepth =~ m/^\d+$/ && $level >= $MaxDepth) {
 222          return ($filen,$dirn,$level) if wantarray;
 223          return $filen;
 224       }
 225       $level++;
 226
 227
 228       my @files;
 229       if ( $] < 5.006 ) {
 230           opendir(STR_DH, $str) or return;
 231           @files = grep( $_ ne '.' && $_ ne '..', readdir(STR_DH));
 232           closedir STR_DH;
 233       }
 234       else {
 235           opendir(my $str_dh, $str) or return;
 236           @files = grep( $_ ne '.' && $_ ne '..', readdir($str_dh));
 237           closedir $str_dh;
 238       }
 239
 240       for my $file (@files) {
 241           my ($file_ut) = $file =~ m{ (.*) }xms;
 242           my $org = File::Spec->catfile($str, $file_ut);
 243           my $new = File::Spec->catfile($end, $file_ut);
 244           if( -l $org && $CopyLink ) {
 245               carp "Copying a symlink ($org) whose target does not exist"
 246                   if !-e readlink($org) && $BdTrgWrn;
 247               symlink readlink($org), $new or return;
 248           }
 249           elsif(-d $org) {
 250               $recurs->($org,$new,$buf) if defined $buf;
 251               $recurs->($org,$new) if !defined $buf;
 252               $filen++;
 253               $dirn++;
 254           }
 255           else {
 256               if($ok_todo_asper_condcopy->($org)) {
 257                   if($SkipFlop) {
 258                       fcopy($org,$new,$buf) or next if defined $buf;
 259                       fcopy($org,$new) or next if !defined $buf;
 260                   }
 261                   else {
 262                       fcopy($org,$new,$buf) or return if defined $buf;
 263                       fcopy($org,$new) or return if !defined $buf;
 264                   }
 265                   chmod scalar((stat($org))[2]), $new if $KeepMode;
 266                   $filen++;
 267               }
 268           }
 269       }
 270       1;
 271    };
 272
 273    $recurs->($_zero, $_one, $_[2]) or return;
 274    return wantarray ? ($filen,$dirn,$level) : $filen;
 275 }
 276
 277 sub fmove { $move->(1, @_) }
 278
 279 sub rmove {
 280     if (-l $_[0] && $CopyLink) {
 281         goto &fmove;
 282     }
 283
 284     goto &dirmove if -d $_[0] || substr( $_[0], ( 1 * -1), 1) eq '*';
 285     goto &fmove;
 286 }
 287
 288 sub rmove_glob {
 289     $glob->(\&rmove, @_);
 290 }
 291
 292 sub dirmove { $move->(0, @_) }
 293
 294 sub pathmk {
 295    my @parts = File::Spec->splitdir( shift() );
 296    my $nofatal = shift;
 297    my $pth = $parts[0];
 298    my $zer = 0;
 299    if(!$pth) {
 300       $pth = File::Spec->catdir($parts[0],$parts[1]);
 301       $zer = 1;
 302    }
 303    for($zer..$#parts) {
 304       $DirPerms = oct($DirPerms) if substr($DirPerms,0,1) eq '0';
 305       mkdir($pth,$DirPerms) or return if !-d $pth && !$nofatal;
 306       mkdir($pth,$DirPerms) if !-d $pth && $nofatal;
 307       $pth = File::Spec->catdir($pth, $parts[$_ + 1]) unless $_ == $#parts;
 308    }
 309    1;
 310 }
 311
 312 sub pathempty {
 313    my $pth = shift;
 314
 315    return 2 if !-d $pth;
 316
 317    my @names;
 318    my $pth_dh;
 319    if ( $] < 5.006 ) {
 320        opendir(PTH_DH, $pth) or return;
 321        @names = grep !/^\.+$/, readdir(PTH_DH);
 322    }
 323    else {
 324        opendir($pth_dh, $pth) or return;
 325        @names = grep !/^\.+$/, readdir($pth_dh);
 326    }
 327
 328    for my $name (@names) {
 329       my ($name_ut) = $name =~ m{ (.*) }xms;
 330       my $flpth     = File::Spec->catdir($pth, $name_ut);
 331
 332       if( -l $flpth ) {
 333               unlink $flpth or return;
 334       }
 335       elsif(-d $flpth) {
 336           pathrmdir($flpth) or return;
 337       }
 338       else {
 339           unlink $flpth or return;
 340       }
 341    }
 342
 343    if ( $] < 5.006 ) {
 344        closedir PTH_DH;
 345    }
 346    else {
 347        closedir $pth_dh;
 348    }
 349
 350    1;
 351 }
 352
 353 sub pathrm {
 354    my $path = shift;
 355    return 2 if !-d $path;
 356    my @pth = File::Spec->splitdir( $path );
 357    my $force = shift;
 358
 359    while(@pth) {
 360       my $cur = File::Spec->catdir(@pth);
 361       last if !$cur; # necessary ???
 362       if(!shift()) {
 363          pathempty($cur) or return if $force;
 364          rmdir $cur or return;
 365       }
 366       else {
 367          pathempty($cur) if $force;
 368          rmdir $cur;
 369       }
 370       pop @pth;
 371    }
 372    1;
 373 }
 374
 375 sub pathrmdir {
 376     my $dir = shift;
 377     if( -e $dir ) {
 378         return if !-d $dir;
 379     }
 380     else {
 381         return 2;
 382     }
 383
 384     pathempty($dir) or return;
 385
 386     rmdir $dir or return;
 387 }
 388
 389 1;
 390
 391 __END__
 392
 393 =head1 NAME
 394
 395 File::Copy::Recursive - Perl extension for recursively copying files and directories
 396
 397 =head1 SYNOPSIS
 398
 399   use File::Copy::Recursive qw(fcopy rcopy dircopy fmove rmove dirmove);
 400
 401   fcopy($orig,$new[,$buf]) or die $!;
 402   rcopy($orig,$new[,$buf]) or die $!;
 403   dircopy($orig,$new[,$buf]) or die $!;
 404
 405   fmove($orig,$new[,$buf]) or die $!;
 406   rmove($orig,$new[,$buf]) or die $!;
 407   dirmove($orig,$new[,$buf]) or die $!;
 408
 409   rcopy_glob("orig/stuff-*", $trg [, $buf]) or die $!;
 410   rmove_glob("orig/stuff-*", $trg [,$buf]) or die $!;
 411
 412 =head1 DESCRIPTION
 413
 414 This module copies and moves directories recursively (or single files, well... singley) to an optional depth and attempts to preserve each file or directory's mode.
 415
 416 =head1 EXPORT
 417
 418 None by default. But you can export all the functions as in the example above and the path* functions if you wish.
 419
 420 =head2 fcopy()
 421
 422 This function uses File::Copy's copy() function to copy a file but not a directory. Any directories are recursively created if need be.
 423 One difference to File::Copy::copy() is that fcopy attempts to preserve the mode (see Preserving Mode below)
 424 The optional $buf in the synopsis if the same as File::Copy::copy()'s 3rd argument
 425 returns the same as File::Copy::copy() in scalar context and 1,0,0 in list context to accomidate rcopy()'s list context on regular files. (See below for more info)
 426
 427 =head2 dircopy()
 428
 429 This function recursively traverses the $orig directory's structure and recursively copies it to the $new directory.
 430 $new is created if necessary (multiple non existant directories is ok (IE foo/bar/baz). The script logically and portably creates all of them if necessary).
 431 It attempts to preserve the mode (see Preserving Mode below) and
 432 by default it copies all the way down into the directory, (see Managing Depth) below.
 433 If a directory is not specified it croaks just like fcopy croaks if its not a file that is specified.
 434
 435 returns true or false, for true in scalar context it returns the number of files and directories copied,
 436 In list context it returns the number of files and directories, number of directories only, depth level traversed.
 437
 438   my $num_of_files_and_dirs = dircopy($orig,$new);
 439   my($num_of_files_and_dirs,$num_of_dirs,$depth_traversed) = dircopy($orig,$new);
 440
 441 Normally it stops and return's if a copy fails, to continue on regardless set $File::Copy::Recursive::SkipFlop to true.
 442
 443     local $File::Copy::Recursive::SkipFlop = 1;
 444
 445 That way it will copy everythgingit can ina directory and won't stop because of permissions, etc...
 446
 447 =head2 rcopy()
 448
 449 This function will allow you to specify a file *or* directory. It calls fcopy() if its a file and dircopy() if its a directory.
 450 If you call rcopy() (or fcopy() for that matter) on a file in list context, the values will be 1,0,0 since no directories and no depth are used.
 451 This is important becasue if its a directory in list context and there is only the initial directory the return value is 1,1,1.
 452
 453 =head2 rcopy_glob()
 454
 455 This function lets you specify a pattern suitable for perl's glob() as the first argument. Subsequently each path returned by perl's glob() gets rcopy()ied.
 456
 457 It returns and array whose items are array refs that contain the return value of each rcopy() call.
 458
 459 It forces behavior as if $File::Copy::Recursive::CPRFComp is true.
 460
 461 =head2 fmove()
 462
 463 Copies the file then removes the original. You can manage the path the original file is in according to $RemvBase.
 464
 465 =head2 dirmove()
 466
 467 Uses dircopy() to copy the directory then removes the original. You can manage the path the original directory is in according to $RemvBase.
 468
 469 =head2 rmove()
 470
 471 Like rcopy() but calls fmove() or dirmove() instead.
 472
 473 =head2 rmove_glob()
 474
 475 Like rcopy_glob() but calls rmove() instead of rcopy()
 476
 477 =head3 $RemvBase
 478
 479 Default is false. When set to true the *move() functions will not only attempt to remove the original file or directory but will remove the given path it is in.
 480
 481 So if you:
 482
 483    rmove('foo/bar/baz', '/etc/');
 484    # "baz" is removed from foo/bar after it is successfully copied to /etc/
 485
 486    local $File::Copy::Recursive::Remvbase = 1;
 487    rmove('foo/bar/baz','/etc/');
 488    # if baz is successfully copied to /etc/ :
 489    # first "baz" is removed from foo/bar
 490    # then "foo/bar is removed via pathrm()
 491
 492 =head4 $ForcePth
 493
 494 Default is false. When set to true it calls pathempty() before any directories are removed to empty the directory so it can be rmdir()'ed when $RemvBase is in effect.
 495
 496 =head2 Creating and Removing Paths
 497
 498 =head3 $NoFtlPth
 499
 500 Default is false. If set to true  rmdir(), mkdir(), and pathempty() calls in pathrm() and pathmk() do not return() on failure.
 501
 502 If its set to true they just silently go about their business regardless. This isn't a good idea but its there if you want it.
 503
 504 =head3 $DirPerms
 505
 506 Mode to pass to any mkdir() calls. Defaults to 0777 as per umask()'s POD. Explicitly having this allows older perls to be able to use FCR and might add a bit of flexibility for you.
 507
 508 Any value you set it to should be suitable for oct()
 509
 510 =head3 Path functions
 511
 512 These functions exist soley because they were necessary for the move and copy functions to have the features they do and not because they are of themselves the purpose of this module. That being said, here is how they work so you can understand how the copy and move funtions work and use them by themselves if you wish.
 513
 514 =head4 pathrm()
 515
 516 Removes a given path recursively. It removes the *entire* path so be carefull!!!
 517
 518 Returns 2 if the given path is not a directory.
 519
 520   File::Copy::Recursive::pathrm('foo/bar/baz') or die $!;
 521   # foo no longer exists
 522
 523 Same as:
 524
 525   rmdir 'foo/bar/baz' or die $!;
 526   rmdir 'foo/bar' or die $!;
 527   rmdir 'foo' or die $!;
 528
 529 An optional second argument makes it call pathempty() before any rmdir()'s when set to true.
 530
 531   File::Copy::Recursive::pathrm('foo/bar/baz', 1) or die $!;
 532   # foo no longer exists
 533
 534 Same as:PFSCheck
 535
 536   File::Copy::Recursive::pathempty('foo/bar/baz') or die $!;
 537   rmdir 'foo/bar/baz' or die $!;
 538   File::Copy::Recursive::pathempty('foo/bar/') or die $!;
 539   rmdir 'foo/bar' or die $!;
 540   File::Copy::Recursive::pathempty('foo/') or die $!;
 541   rmdir 'foo' or die $!;
 542
 543 An optional third argument acts like $File::Copy::Recursive::NoFtlPth, again probably not a good idea.
 544
 545 =head4 pathempty()
 546
 547 Recursively removes the given directory's contents so it is empty. returns 2 if argument is not a directory, 1 on successfully emptying the directory.
 548
 549    File::Copy::Recursive::pathempty($pth) or die $!;
 550    # $pth is now an empty directory
 551
 552 =head4 pathmk()
 553
 554 Creates a given path recursively. Creates foo/bar/baz even if foo does not exist.
 555
 556    File::Copy::Recursive::pathmk('foo/bar/baz') or die $!;
 557
 558 An optional second argument if true acts just like $File::Copy::Recursive::NoFtlPth, which means you'd never get your die() if something went wrong. Again, probably a *bad* idea.
 559
 560 =head4 pathrmdir()
 561
 562 Same as rmdir() but it calls pathempty() first to recursively empty it first since rmdir can not remove a directory with contents.
 563 Just removes the top directory the path given instead of the entire path like pathrm(). Return 2 if given argument does not exist (IE its already gone). Return false if it exists but is not a directory.
 564
 565 =head2 Preserving Mode
 566
 567 By default a quiet attempt is made to change the new file or directory to the mode of the old one.
 568 To turn this behavior off set
 569   $File::Copy::Recursive::KeepMode
 570 to false;
 571
 572 =head2 Managing Depth
 573
 574 You can set the maximum depth a directory structure is recursed by setting:
 575   $File::Copy::Recursive::MaxDepth
 576 to a whole number greater than 0.
 577
 578 =head2 SymLinks
 579
 580 If your system supports symlinks then symlinks will be copied as symlinks instead of as the target file.
 581 Perl's symlink() is used instead of File::Copy's copy()
 582 You can customize this behavior by setting $File::Copy::Recursive::CopyLink to a true or false value.
 583 It is already set to true or false dending on your system's support of symlinks so you can check it with an if statement to see how it will behave:
 584
 585     if($File::Copy::Recursive::CopyLink) {
 586         print "Symlinks will be preserved\n";
 587     } else {
 588         print "Symlinks will not be preserved because your system does not support it\n";
 589     }
 590
 591 If symlinks are being copied you can set $File::Copy::Recursive::BdTrgWrn to true to make it carp when it copies a link whose target does not exist. Its false by default.
 592
 593     local $File::Copy::Recursive::BdTrgWrn  = 1;
 594
 595 =head2 Removing existing target file or directory before copying.
 596
 597 This can be done by setting $File::Copy::Recursive::RMTrgFil or $File::Copy::Recursive::RMTrgDir for file or directory behavior respectively.
 598
 599 0 = off (This is the default)
 600
 601 1 = carp() $! if removal fails
 602
 603 2 = return if removal fails
 604
 605     local $File::Copy::Recursive::RMTrgFil = 1;
 606     fcopy($orig, $target) or die $!;
 607     # if it fails it does warn() and keeps going
 608
 609     local $File::Copy::Recursive::RMTrgDir = 2;
 610     dircopy($orig, $target) or die $!;
 611     # if it fails it does your "or die"
 612
 613 This should be unnecessary most of the time but its there if you need it :)
 614
 615 =head2 Turning off stat() check
 616
 617 By default the files or directories are checked to see if they are the same (IE linked, or two paths (absolute/relative or different relative paths) to the same file) by comparing the file's stat() info.
 618 It's a very efficient check that croaks if they are and shouldn't be turned off but if you must for some weird reason just set $File::Copy::Recursive::PFSCheck to a false value. ("PFS" stands for "Physical File System")
 619
 620 =head2 Emulating cp -rf dir1/ dir2/
 621
 622 By default dircopy($dir1,$dir2) will put $dir1's contents right into $dir2 whether $dir2 exists or not.
 623
 624 You can make dircopy() emulate cp -rf by setting $File::Copy::Recursive::CPRFComp to true.
 625
 626 NOTE: This only emulates -f in the sense that it does not prompt. It does not remove the target file or directory if it exists.
 627 If you need to do that then use the variables $RMTrgFil and $RMTrgDir described in "Removing existing target file or directory before copying" above.
 628
 629 That means that if $dir2 exists it puts the contents into $dir2/$dir1 instead of $dir2 just like cp -rf.
 630 If $dir2 does not exist then the contents go into $dir2 like normal (also like cp -rf)
 631
 632 So assuming 'foo/file':
 633
 634     dircopy('foo', 'bar') or die $!;
 635     # if bar does not exist the result is bar/file
 636     # if bar does exist the result is bar/file
 637
 638     $File::Copy::Recursive::CPRFComp = 1;
 639     dircopy('foo', 'bar') or die $!;
 640     # if bar does not exist the result is bar/file
 641     # if bar does exist the result is bar/foo/file
 642
 643 You can also specify a star for cp -rf glob type behavior:
 644
 645     dircopy('foo/*', 'bar') or die $!;
 646     # if bar does not exist the result is bar/file
 647     # if bar does exist the result is bar/file
 648
 649     $File::Copy::Recursive::CPRFComp = 1;
 650     dircopy('foo/*', 'bar') or die $!;
 651     # if bar does not exist the result is bar/file
 652     # if bar does exist the result is bar/file
 653
 654 NOTE: The '*' is only like cp -rf foo/* and *DOES NOT EXPAND PARTIAL DIRECTORY NAMES LIKE YOUR SHELL DOES* (IE not like cp -rf fo* to copy foo/*)
 655
 656 =head2 Allowing Copy Loops
 657
 658 If you want to allow:
 659
 660   cp -rf . foo/
 661
 662 type behavior set $File::Copy::Recursive::CopyLoop to true.
 663
 664 This is false by default so that a check is done to see if the source directory will contain the target directory and croaks to avoid this problem.
 665
 666 If you ever find a situation where $CopyLoop = 1 is desirable let me know (IE its a bad bad idea but is there if you want it)
 667
 668 (Note: On Windows this was necessary since it uses stat() to detemine samedness and stat() is essencially useless for this on Windows.
 669 The test is now simply skipped on Windows but I'd rather have an actual reliable check if anyone in Microsoft land would care to share)
 670
 671 =head1 SEE ALSO
 672
 673 L<File::Copy> L<File::Spec>
 674
 675 =head1 TO DO
 676
 677 I am currently working on and reviewing some other modules to use in the new interface so we can lose the horrid globals as well as some other undesirable traits and also more easily make available some long standing requests.
 678
 679 Tests will be easier to do with the new interface and hence the testing focus will shift to the new interface and aim to be comprehensive.
 680
 681 The old interface will work, it just won't be brought in until it is used, so it will add no overhead for users of the new interface.
 682
 683 I'll add this after the latest verision has been out for a while with no new features or issues found :)
 684
 685 =head1 AUTHOR
 686
 687 Daniel Muey, L<http://drmuey.com/cpan_contact.pl>
 688
 689 =head1 COPYRIGHT AND LICENSE
 690
 691 Copyright 2004 by Daniel Muey
 692
 693 This library is free software; you can redistribute it and/or modify
 694 it under the same terms as Perl itself.
 695
 696 =cut