Subversion Repositories DevTools

              copyDir

              unCopyDir

use JatsLocateFiles;

use JatsSystem;

    $opts{'Verbose'} = $opts{'verbose'} if defined $opts{'verbose'}; 

# Function        : copyDir 

#

# Description     : Copy a directory tree

#                   Used by PackageDir to perform run-time packaging

#

# Inputs          : @ARGV   - Options

#                       -mode=text

#                       -src=path

#                       -dst=path

#                       -execute        - Mark ALL as executable

#                       -noSymlink        

#                       -noRecurse

#                       -stripBase      - Strip first dir from the source

#                       -exclude+=filter

#                       -include+=filter

#

# Returns         : 

#

sub copyDir

{

    my $copts = processCopyDirArgs('copyDir');

    return unless $copts;

    #

    #   Create the target directory if required

    #

    unless (-d  $copts->{dst}) {

            Verbose("Create target directory: $copts->{dst}");

          File::Path::mkpath([$copts->{dst}],0,0777);

    }

    #

    #   Configure the use of the System function

    #   Don't exit on error - assume used in unpackaging

    #

    SystemConfig ( UseShell => 0, ExitOnError => 0);

    #

    #   Calc mode

    #

    my $fmode = '';

    $fmode .= '+x' if defined $copts->{execute}; 

    $fmode .= '+l' unless defined $copts->{noSymlink}; 

    #

    #   Configure the use of the System function

    #

    SystemConfig ( UseShell => 0, ExitOnError => 1);

    #

    #   Travserse the source directory and copy files

    #

    my @elements = $copts->{search}->search ( $copts->{src} );

    #

    #   Transfer each file

    #   Use the JatsFileUtil as it solves lots of problems

    #   Its args are strange - Historic (long Story). Args:

    #       'c0'        - Operation is Copy and debug level

    #       'Text'      - Text message to display

    #       DestPath

    #       SrcPath

    #       Modes       - wxl

    #

    #   Do not get the shell involved in invoking the command

    #   Quote args in '' not "" as "" will trigger shell usage

    #       

    #

    foreach my $file ( @elements)

    {

        my $dst = $file;

        #

        #   Calc target path name

        #

        if ($copts->{stripBase}) {

            $dst = substr($dst, $copts->{stripBase} );

        }

        $dst = $copts->{dst} . '/' . $dst;

        #

        #   If the file exists, then only copy it if the src is newer

        #

        if (-f $dst) {

            my ($file1, $file2) = @_;

            my $f1_timestamp = (stat($file))[9] || 0;

            my $f2_timestamp = (stat($dst))[9] || 0;

            next unless ($f1_timestamp > $f2_timestamp );

        }

        System('JatsFileUtil', 'c0', $copts->{mode} , $dst, $file, $fmode);

    }

}

#-------------------------------------------------------------------------------

# Function        : unCopyDir 

#

# Description     : Delete files copies with a copy dir command

#                   Delete directories if they are empty

#                   Used by PackageDir to perform run-time packaging

#

# Inputs          : @ARGV   - Options

#                       -mode=text

#                       -src=path

#                       -dst=path

#                       -execute        - Ignored

#                       -noSymlink      - Ignored

#                       -noRecurse

#                       -stripBase      - Strip first dir from the source

#                       -exclude+=filter

#                       -include+=filter

#                       -excludeRe+=filter

#                       -includeRe+=filter

#                       

#

# Returns         : 

#

sub unCopyDir

{

    my %dirList;

    my $copts = processCopyDirArgs('UnCopyDir');

    return unless $copts;

    #

    #   Configure the use of the System function

    #   Don't exit on error - assume used in unpackaging

    #

    SystemConfig ( UseShell => 0, ExitOnError => 0);

    #

    #   Nothing to do if the target directory does not exist

    #

    unless (-d $copts->{dst}) {

        Verbose("UnCopyDir: No target directory: $copts->{dst}");

        return;

    }

    #

    #   Travserse the source directory and find files that would have been copied

    #

    my @elements = $copts->{search}->search ( $copts->{src} );

    #

    #   Delete each file

    #   Use the JatsFileUtil as it solves lots of problems

    #   Its args are strange - Historic (long Story). Args:

    #       'd0'        - Operation is Copy and debug level

    #       'Text'      - Text message to display

    #       DestPath

    #

    #   Do not get the shell involved in invoking the command

    #   Quote args in '' not "" as "" will trigger shell usage

    #       

    #

    foreach my $file ( @elements)

    {

        my $dst = $file;

        #

        #   Calc target path name

        #

        if ($copts->{stripBase}) {

            $dst = substr($dst, $copts->{stripBase} );

        }

        $dst = $copts->{dst} . '/' . $dst;

        #

        #   Only delete if the file exists

        #

        next unless (-f $dst);

        System('JatsFileUtil', 'd0', $copts->{mode}, $dst);

        #   Save dir name for later cleanup

        if ($dst =~ s~/[^/]+$~~) {

            $dirList{$dst} = 1;

        }

    }

    #

    #   Delete all directories encountred in the tree - if they are empty

    #   Only delete up the base of the target directory

    #       Have a hash of directories - generated by the file deletion process

    #       Extend the hash to include ALL subdirectoroy paths too

    #   

    Verbose("Remove empty directories");

    foreach my $entry ( keys %dirList ) {

        while ($entry =~ s~/[^/]+$~~ ) {

            $dirList{$entry} = 2;

        }

    }

    my @dirList = sort { length $b <=> length $a } keys %dirList; 

    foreach my $tdir ( @dirList ) {

        Verbose("Remove dir: $tdir");

        rmdir $tdir;

    }

}

#-------------------------------------------------------------------------------

# Function        : processCopyDirArgs 

#

# Description     : Process the args for CopyDir and UnCopyDir so that the processing

#                   is identical

#

# Inputs          : $cmdName     - Command name

#                   From ARGV 

#

# Returns         : A hash containing

#                       copts   - Copy Options

#                       search  - For JatsLocateFiles 

#                   Empty if nothind to do    

#

sub processCopyDirArgs

{

    my ($cmdName) = @_;

    process_options();

    #

    #   Put the command line arguments into a hash

    #   Allow:

    #       aaa+=bbb        - An array

    #       aaa=bbb         - Value

    #       aaa             - Set to one

    #

    my %copts;

    foreach (@ARGV) {

        if (m~-(.*)\+=(.*)~) {

            push @{$copts{$1}}, $2;

        } elsif (m~-(.*)?=(.*)~){

            $copts{$1} = $2;

        } elsif (m~-(.*)~) {

            $copts{$1} = 1;

        }

    }

    Message ("$cmdName Dir Tree: $copts{src} -> $copts{dst}") if ($opts{'Progress'} );

    #

    #   Ensure the source exists

    #

    Warning ("$cmdName: Source directory does not exists:" . $copts{src}) unless -d $copts{src};

    #

    #   Calc strip length

    #

    if ($copts{stripBase}) {

        $copts{stripBase} = 1 + length($copts{src});

    }

    #

    #   Set up the search options to traverse the source directory and find files 

    #   to process

    #

    my $search = JatsLocateFiles->new('FullPath' );

    $search->recurse(1) unless $copts{noRecurse};

    $search->filter_in_re ( $_ ) foreach ( @{$copts{includeRe}} );

    $search->filter_out_re( $_ ) foreach ( @{$copts{excludeRe}} );

    $search->filter_in ( $_ ) foreach ( @{$copts{include}} );

    $search->filter_out( $_ ) foreach ( @{$copts{exclude}} );

    $search->filter_out_re( '/\.svn/' );

    $search->filter_out_re( '/\.git/' );

    #

    #   Return a hash

    #

    $copts{search} = $search;

    return \%copts;

}

#-------------------------------------------------------------------------------