1     # This  script  will copy the whole  source directory  tree
     2     # to the  destination. Be carefull  that if the root target
     3     # ( destination ) directory does not exists then it will be
     4     # created. This script will work only on Windows platforms,
     5     # but with some  small changes  will work on unix  as well.
     6     # The destination files will be over  writen if they exist.
     7     # Xxxxxx Xxxxxx
     8     # xxxx@xxxxxxxx.xxxxx.xxx
     9     
    10     my $source_directory = 'f:/temp' ;
    11     my $target_directory = 'c:/temp' ;
    12     
    13     &xcopy($source_directory,$target_directory);
    14     
    15     ############# xcopy subroutine #############
    16     
    17     sub xcopy {
    18       my ($pwd,$i)=($_[0],$i++);
    19       die "You have not defined the \$target_directory variable, sorry...\n" 
    20         unless -e $target_directory ;
    21       die "You have not defined the \$source_directory variable, sorry...\n" 
    22         unless -d $source_directory;
    23       if (! -d $target_directory && -e $target_directory) {
    24         die "Can't continue because a file has target's dir name\n";
    25       } elsif ( ! -e $target_directory ) {
    26         mkdir $target_directory || die "Couldn't create dir : $target_node\n";
    27       }
    28       opendir ($i,$pwd) || die "Can't list $pwd\n";
    29       while (my $source_node=readdir $i) {
    30         next if $source_node=~/^\.*$/;
    31         $source_node       = $pwd.'/'.$source_node;
    32         ( my $relative_node ) = $source_node =~/$source_directory(.*)/;
    33         $target_node       = $target_directory.$relative_node;
    34         if (-d $source_node) {
    35           if (! -d $target_node && -e $target_node ) {
    36             die "Can't mkdir $target_node because a same name file exist\n";
    37           } elsif ( ! -e $target_node ) {
    38             print "mkdir  $target_node\n";
    39             mkdir $target_node || die "Couldn't create dir : $target_node\n";
    40           }
    41         } else {
    42           if ( -d $target_node && -e $target_node) {
    43             warn "Can't copy $target_node because a same name dir exist\n";
    44           } else {
    45             print "coping $source_node to $target_node\n" unless -e $target_node;
    46             (my $copy_target_node) = $target_node; $copy_target_node=~s/\//\\/g  ;
    47             (my $copy_source_node) = $source_node; $copy_source_node=~s/\//\\/g  ;
    48             `$ENV{ComSpec} /c copy /b $copy_source_node $copy_target_node`;
    49           }
    50         }
    51         &xcopy($source_node) if -d $source_node;
    52       }
    53       closedir $i;
    54     }
    55     
    56