WebSVN – DevTools – Diff – /core_devl/trunk/TOOLS/LIB/JatsCopy.pm

 # Compiler(s)   : Perl
 # Environment(s): jats
+#
 #                 Utility functions to
 #                   CopyDir                 - Copy Dir Tree
-#                   CopyFile                - Copy one file
+#                   CopyFile                - Copy one or more files
 #                   CreateDir               - Create one directory
 #                   DeleteDir               - Delete Dir Tree
 #                   DeleteFile              - Delete a file
 #                   SetCopyDirDefaults      - Set application wide defaults
+#
 #               Notify me if an existing file is present
 #               Do not copy files called a2 and build.pl
 #               Do not copy the .svn subdir
 #               Do not copy files ending in 2
+#
-# Issues:
-#               MatchDirs and MatchDirsRE don't work
-#               Need to define what is wanted first
-#               IgnoreDirs - appears to be useful
-#
 #......................................................................#
 use strict;
 use warnings;
 #                       IgnoreRE        - An array of files to ignore (RE)
 #                       IgnoreDirs      - An array of subdirs to ignore
 #                       IgnoreDirsRE    - An array of subdirs to ignore (RE)
 #                       Match           - An array of files to match
 #                       MatchRE         - An array of file to match (RE)
-#                       MatchDirs       - An array of dirs to match
+#                       MatchDirs       - An array of top level dirs to match
-#                       MatchDirsRE     - An array of dirs to match (RE)
+#                       MatchDirsRE     - An array of top level dirs to match (RE)
+#                       SkipTLF         - Skip Files in the specified dir -
+#                                         only consider subdirs
 #                     Misc
 #                       Stats           - A ref to a hash of stats
 #                       FileList        - Ref to array of target files
 #                       UserData        - Item passed through to call backs
 #                                         for the users own purposes.
+#
 # Description     : Utility function to copy a single file
 #                   Uses the same options and loging infrastructure
 #                   as CopyDir
+#
-# Inputs          : $src_file               - Src directory
+# Inputs          : $src_file               - Src file spec
+#                                             May be a file or a reference to an
+#                                             array of files.
 #                   $dst_file               - Dest file (or dir)
 #                   $opt                    - A Hash of options
 #                                             Refer to CopyDir
+#
 # Returns         : Path to the target file
+#                   If multiple files are being copied then it is the
+#                   path to the last one copied.
+#
 sub CopyFile
+{
-    my $src_file = shift;
+    my $src_spec = shift;
-    my $dst_file = shift;
+    my $dst_spec = shift;
     my $opt = JatsCopyInternal::DefaultOpts( 'CopyFile', @_);
+    #
     #   Do not Validate source dir
     #   Do it within the copy operation and get the same error
     #   handling as the CopyDir processing
+    #
+    #
-    #   If the target is a directory, then copy by name
+    #   Handle a scalar and and array in the same manner
+    #
+    if ( ref $src_spec ne 'ARRAY' ) {
-    my $file = StripDir ($src_file);
+        my @slist = ($src_spec );
-    $dst_file .= '/' . $file if ( -d $dst_file );
+        $src_spec = \@slist;
+    }
-    #
-    #   Insert additional options to provide the same interface to
-    #   the internal functions used to do the copy
-    #
-    #       item            - Source Path
+    my $rv = undef;
-    #       tgt             - Dest subdir below dst_dir
-    #       file            - Filename
-    #       target          - Dest Path
+    foreach my $src_file ( @{$src_spec} )
-    #
+    {
-    $opt->{'item'}     = $src_file;
+        next unless ( $src_file );
-    $opt->{'file'}     = $file;
-    $opt->{'target'}   = $dst_file;
-    $opt->{'type'}     = 'f';
+        #
+        #   If the target is a directory, then copy by name
-    #
+        #
+        my $file = StripDir ($src_file);
+        my $dst_file = $dst_spec;
+        $dst_file .= '/' . $file if ( -d $dst_file );
+        #
+        #   Insert additional options to provide the same interface to
+        #   the internal functions used to do the copy
+        #
+        #       item            - Source Path
+        #       tgt             - Dest subdir below dst_dir
+        #       file            - Filename
+        #       target          - Dest Path
+        #
+        $opt->{'item'}     = $src_file;
+        $opt->{'file'}     = $file;
+        $opt->{'target'}   = $dst_file;
+        $opt->{'type'}     = 'f';
+        #
-    #   Invoke the common file copy routine
+        #   Invoke the common file copy routine
-    #
+        #
-    return JatsCopyInternal::CopyFile ( $src_file, $dst_file, $opt );
+        $rv = JatsCopyInternal::CopyFile ( $src_file, $dst_file, $opt );
+    }
+    return $rv;
+}
 #-------------------------------------------------------------------------------
 # Function        : CreateDir
+#
+            #
             stat ( $filename );
             if ( -f _ )
+            {
                 $opt->{'Stats'}{'examinedFiles'}++;
+                next if ( $opt->{'SkipTLF'} );
                 next unless doMatch ( $file, $opt, 'MatchRE', 'IgnoreRE' );
                 $opt->{'type'} = 'f';
+            }
             elsif ( -d _ )
+            {
             #   Always invoke the 'Expert' function
             #   A dummy one will be provided unless the user gave one
+            #
             $opt->{'Expert'} ( $opt );
+        }
+        #
+        #   Have processed the entire directory
+        #   Kill the 'MatchDirsRE' data so that the Directory match
+        #   only occurs on the Root directory
+        #
+        delete $opt->{'MatchDirsRE'};
+        delete $opt->{'SkipTLF'};
+    }
+}
 #-------------------------------------------------------------------------------
 # Function        : Body
     'UserData'        => 0,
     'SymlinkFiles'    => Scalar,
     'ReadOnlyFiles'   => Scalar,
     'KeepSrcTail'     => Scalar,
     'FileList'        => ArrayRef,
+    'SkipTLF'         => Scalar,
 );
 #-------------------------------------------------------------------------------
 # Function        : ValidateArg

Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/LIB/JatsCopy.pm – Rev 273 → 275