WebSVN – DevTools – Diff – /core_devl/trunk/TOOLS/create_dpkg.pl

 my $PKG_BASE;
 my $bad_merge_count = 0;
 my @bad_symlinks;
 my @fileList;
 my $descPkgCount = 0;
+my @tmpFiles;
+#
 #   Option variables
+#
 my $opt_help = 0;
 my $opt_outfile;
 my $opt_info;
 my $opt_tarmode;
 my $opt_testArchive;
 my $opt_noBuild;
+my $opt_keepTemp;
+#
 #   Structure to translate -archive=xxx option to archive variable
 #   These are the various dpkg_archives known to JATS
 #------------------------------------------------------------------------------
+{
     my ($opr, $file) = @_;
     $file =~ s/\Q$DPKG_ROOT\E/DPKG/;
     $file =~ s/\Q$SRC_ROOT\E/PKG/;
+    $file =~ s/\Q$CWD_DIR\E/CWD/;
     Information (sprintf( "%-15s [%s]", $opr, $file));
+}
 #-------------------------------------------------------------------------------
     #       Use lots of attributes and only elements for arrays
     #       Save as one attribute per line - for readability
+    #
     $opt_outfile = $opt_generic ? "built.files.generic.xml" : "built.files.$GBE_HOSTNAME.xml";
     $opt_outfile = catfile( $targetDir, $opt_outfile);
+    push @tmpFiles, $opt_outfile;
     LogFileOp ('Meta File', $opt_outfile);
     my $xs = XML::Simple->new( NoAttr =>0, AttrIndent => 1 );
     open (my $XML, '>', $opt_outfile) || Error ("Cannot create output file: $opt_outfile", $!);
                 'md5!'          => \$opt_md5,               # [no]flag
                 'info!'         => \$opt_info,              # [no]flag
                 'tarmode!'      => \$opt_tarmode,           # [no]flag
                 'testArchive'   => \$opt_testArchive,       # [no]flag
                 'nobuild'       => \$opt_noBuild,           # flag
+                'keepTemp'      => \$opt_keepTemp,          # flag
                 );
+    #
     #   Process help and manual options
+    #
     EnvImport ('GBE_MACHTYPE');
     EnvImport ('GBE_HOSTNAME');
     EnvImport ('USER' );
     EnvImportOptional ('GBE_ABT', "");
+    $CWD_DIR = catdir($CWD_DIR);
+    #
     #   Determine the target archive
     #   The default archive is GBE_DPKG, but this may be changed
+    #
     #   from such an environment is certainly not reproducible - so don't allow
     #   it to happen
+    #
     #   Allow versions of 99.99.99 as these are known to be test versions
+    #
-    unless ( $opt_archive eq 'local' || $opt_archive eq 'sandbox' )
+    unless ( $opt_archive eq 'local' || $opt_archive eq 'sandbox' || $opt_testArchive)
+    {
         if ( $ENV{GBE_DPKG_SBOX} )
+        {
             unless ( $DPKG_VERSION =~ /^99.99.99/ )
+            {
     Information("");
     InitFileUtils();
+    #
-    #   Locate the tar utility
-    #   Use gtar if its available otherwise use tar
-    #
-    my $tarProg = LocateProgInPath('gtar', '--All');
-    $tarProg = LocateProgInPath('tar', '--All') unless $tarProg;
-    Error ("Tar utility not found in path") unless $tarProg;
-    #
     #   If a 'noBuild' then create a dummy package directory simply
     #   to contain the metadata.
     #   Delete any existing dir of the same name to ensure its clean.
+    #
     if ( $SRC_ROOT eq '' )
     #   Create the target path in the target archive
+    #
     LogFileOp ('Creating', $DPKG_DIR);
     mkpath($DPKG_DIR, 0, 0775);
+    #
+    #   Create a tar.gz file an transfer to the final location
+    #
+    #   Have failed to find a nice windows utility to create a tar.gz
-    #   Create the TAR file
+    #       bsdtar - crashed under server 2003
-    #   Use gzip compression (tar.gz) as it provides a good compromise bewteen speed and size
+    #       cygwin - design decision. JATS will not include cygwin
+    #
     my $tarTarget = join('_', $DPKG_NAME, $DPKG_VERSION, $GBE_HOSTNAME) . '.tar.gz';
     my $tarPath = catfile($DPKG_DIR, $tarTarget);
+    $FileUtils::isUnix ? createUnixTar($tarPath) : createWindowsTar($tarPath);
+}
+#-------------------------------------------------------------------------------
+# Function        : createUnixTar
+#
+# Description     : Create a tar.gz file under unix
+#
+# Inputs          : $tarPath    - Place tarfile here
+#                   $SRC_ROOT   - Directory to tar
+#
+# Returns         : Will not return on error
+#
+sub createUnixTar
+{
+    my ($tarPath) = @_;
+    #
+    #   Locate the tar utility
+    #   Use gtar if its available otherwise use tar
+    #
+    my $tarProg = LocateProgInPath('gtar', '--All');
+    $tarProg = LocateProgInPath('tar', '--All') unless $tarProg;
+    Error ("Tar utility not found in path") unless $tarProg;
+    #
+    #   Tar and gzip file directly into the final location
     LogFileOp ('TarZip', $tarPath);
     my @tarArgs;
     push @tarArgs, '-v' if IsVerbose(1);
     my $rv = System ('--NoShell', '--NoExit',$tarProg, @tarArgs, '-czf', $tarPath, '-C', $SRC_ROOT, '.' );
     if ($rv)
+    {
-        unlink $tarPath;
+        push @tmpFiles, $tarPath;
-        unlink $opt_outfile;
         Error ('Cannot create tarball', "Path:$tarPath");
+    }
+}
+#-------------------------------------------------------------------------------
+# Function        : createWindowsTar
+#
+# Description     : Create a tar.gz file under Windows
+#                   Use 7zip (part of JATS)
+#                   7zip cannot do this in one step
+#                       Create tar file
+#                       Create zip file
+#
+# Inputs          : $tarPath    - Place tarfile here
+#                   $SRC_ROOT   - Directory to tar
+#
+# Returns         : Will not return on error
+#
+sub createWindowsTar
+{
+    my ($tarPath) = @_;
+    my @verboseArgs;
+    my $verboseCopyArg = '9';
+    #
+    #   Ensure that the target file does not exist
+    #   7z cannot ovewrite it
+    #
+    LogFileOp ('Delete', $tarPath);
+    RmDirTree($tarPath) && Error ("Target file cannot be deleted", "Target: $tarPath");
+    #
+    #   Setup NON-verbose arguments for 7zip
+    #
+    unless (IsVerbose(1)) {
+        @verboseArgs = qw(-bb0 -bso0 -bsp0);
+        $verboseCopyArg = '0';
+    }
+    #
+    #   Create a tar file of the required output
+    #   Create the tar file into a temp file that will be deleted on exit
+    #
+    my $tmpTarFile = catfile($CWD_DIR, join('_', $DPKG_NAME, $DPKG_VERSION) . '.tar' );
+    Verbose("TempTar: $tmpTarFile");
+    RmDirTree($tmpTarFile) && Error ("Target file cannot be deleted", "Target: $tmpTarFile");
+    push @tmpFiles, $tmpTarFile;
+    LogFileOp ('TempTar', $tmpTarFile);
+    chdir ($SRC_ROOT) || Error ("Cannot change directory: $?", "Dir: $SRC_ROOT");
+    my $rv = System ('--NoShell', '--NoExit','7z.exe', 'a', '-r','-y', @verboseArgs, '-ttar', $tmpTarFile, '.' );
+    if ($rv)
+    {
+        Error ('Cannot create tar file');
+    }
+    chdir ($CWD_DIR) || Error ("Cannot change directory: $?", "Dir: $CWD_DIR");
+    #
+    #   gzip the tar file to a temp (local) location
+    #
+    my $tmpTarGzFile = catfile($CWD_DIR, join('_', $DPKG_NAME, $DPKG_VERSION) . '.tar.gz' );
+    Verbose("TempTarGz: $tmpTarGzFile");
+    RmDirTree($tmpTarGzFile) && Error ("Target file cannot be deleted", "Target: $tmpTarFile");
+    push @tmpFiles, $tmpTarGzFile;
+    LogFileOp ('TempTarGz', $tmpTarGzFile);
+    $rv = System ('--NoShell', '--NoExit','7z.exe', 'a', '-y', @verboseArgs, '-tgzip', $tmpTarGzFile, $tmpTarFile );
+    if ($rv)
+    {
+        Error ('Cannot gzip tar file');
+    }
+    #
+    #   Copy the file to the target
+    #   Note: Jats internal copy
+    #         Args are strange as it was designed to work with makefile stuff
+    #
+    LogFileOp ('CopyTarZip', $tarPath);
+    $rv = System ('--NoShell', '--NoExit','JatsFileUtil.exe', 'c' . $verboseCopyArg, 'copyFile', $tarPath, $tmpTarGzFile, '+w' );
-    return 1;
+    if ($rv)
+    {
+        push @tmpFiles, $tarPath;
+        Error ('Cannot transfer tarball', "Path:$tarPath");
+    }
+}
 #-------------------------------------------------------------------------------
 # Function        : pkgFindTarBall
+#
 # Description     : Used by CreateDpkgArchiveTarBall
 #                   File::Find processing function
     FileAppend ( $touchfile, $built_info );
     return $touchfile;
+}
+#-------------------------------------------------------------------------------
+# Function        : END Block
+#
+# Description     : Post execution cleanup
+#
+# Inputs          :
+#
+# Returns         :
+#
+END
+{
+    #
+    #   Save the programs exit code
+    #   This END block may use the 'system' call and this will clobber the value in $?
+    #   which is the systems exit code
+    #
+    Verbose2("Cleanup processing");
+    local $?;
+    #
+    #   Delete temp files
+    #
+    foreach my $tmpFile ( @tmpFiles)
+    {
+        if ($opt_keepTemp)
+        {
+            Information("Retain Temp file: " . $tmpFile);
+        }
+        else
+        {
+            Verbose ("Delete file: " . $tmpFile);
+            RmDirTree ($tmpFile) && Warning("$tmpFile not deleted");
+        }
+    }
+}
 # ---------------------------------------------------------
 # ---------------------------------------------------------
 # Main
 # ---------------------------------------------------------
   Debug and Testing:
     -[no]test          - Test package. Do not transfer.
     -[no]info          - Display packaging info. Do not transfer.
     -[no]testArchive   - Perform operations within a test archive
+    -keepTemp          - Do not delete temp files
 =head1 OPTIONS
 =over 8
 the currently configured dpkg_archive. The test area is a subdirectory
 called C<.dpkg_archive/test_dpkg>
 This option is intended for testing use only.
+=item B<-keepTemp>
+This option will prevent temp files, created by this utilty, from being deleted when the utilty
+exists.
+This option is intended for testing use only.
 =back
 =head1 DESCRIPTION
 This utility program is used to transfer a package that has been built into

Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/create_dpkg.pl – Rev 5550 → 5578