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

 # Module type   : Makefile system
 # Compiler(s)   : Perl
 # Environment(s): jats
+#
 # Description   : This script is used to create a dpkg_archive.
-#                 Based on create_dpkg with following changes
+#                 Features:
 #                   * No user interaction
 #                   * Generates files list for ReleaseNote integration
+#                   * Can generate package fragemts as a tarball for build system
+#
 # Usage:        : See POD
+#
 #......................................................................#
 use JatsError;
 use JatsEnv;
 use DescPkg;
 use FileUtils;
+use JatsSystem;
+#
 #   Under Windows we need the Win32::FileSecurity module
 #   It only exists under windows
+#
 my $opt_pversion;
 my $opt_test;
 my $opt_md5 = 1;
 my $opt_outfile;
 my $opt_info;
+my $opt_tarmode;
+my $opt_testArchive;
+#
 #   Structure to translate -archive=xxx option to archive variable
 #   These are the various dpkg_archives known to JATS
 #       This sub-routine is used to generate a consistent informational log
 #------------------------------------------------------------------------------
+{
     my ($opr, $file) = @_;
     $file =~ s/$DPKG_ROOT/DPKG/;
+    $file =~ s/$SRC_ROOT/PKG/;
     Information (sprintf( "%-15s [%s]", $opr, $file));
+}
 #-------------------------------------------------------------------------------
 # Function        : writeFileInfo
+#
 # Description     : Write out an XML file that contains this processes
 #                   contribution to the output package
+#
-# Inputs          :
+# Inputs          : $targetDir          - Base directory for the file
+#
 # Returns         :
+#
 sub writeFileInfo
+{
+    my ($targetDir) = @_;
     my $data;
     $data->{file} = \@fileList;
+    #
     #   Write out sections of XML
     #       Want control over the output order
     #       Use lots of attributes and only elements for arrays
     #       Save as one attribute per line - for readability
+    #
-    $opt_outfile = $opt_generic ? "$DPKG_DIR/built.files.generic.xml" : "$DPKG_DIR/built.files.$GBE_HOSTNAME.xml";
+    $opt_outfile = $opt_generic ? "built.files.generic.xml" : "built.files.$GBE_HOSTNAME.xml";
+    $opt_outfile = catfile( $targetDir, $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", $!);
+#
 #------------------------------------------------------------------------------
+{
     # Process any command line arguements...
     my $result = GetOptions (
-                "help:+"        => \$opt_help,              # flag, multiple use allowed
+                'help:+'        => \$opt_help,              # flag, multiple use allowed
-                "manual:3"      => \$opt_help,              # flag
+                'manual:3'      => \$opt_help,              # flag
-                "verbose:+"     => \$opt_verbose,           # flag, multiple use allowed
+                'verbose:+'     => \$opt_verbose,           # flag, multiple use allowed
-                "override!"     => \$opt_override,          # [no]flag (No longer used. Backward compat with build tool)
+                'override!'     => \$opt_override,          # [no]flag (No longer used. Backward compat with build tool)
-                "delete!"       => \$opt_delete,            # [no]flag
+                'delete!'       => \$opt_delete,            # [no]flag
-                "merge|m!"      => \$opt_merge,             # [no]flag.
+                'merge|m!'      => \$opt_merge,             # [no]flag.
-                "archive=s"     => \$opt_archive,           # string
+                'archive=s'     => \$opt_archive,           # string
-                "quiet+"        => \$opt_quiet,             # Flag
+                'quiet+'        => \$opt_quiet,             # Flag
-                "generic!"      => \$opt_generic,           # [no]Flag
+                'generic!'      => \$opt_generic,           # [no]Flag
-                "pname=s"       => \$opt_pname,             # string
+                'pname=s'       => \$opt_pname,             # string
-                "pversion=s"    => \$opt_pversion,          # string
+                'pversion=s'    => \$opt_pversion,          # string
-                "test!"         => \$opt_test,              # [no]flag
+                'test!'         => \$opt_test,              # [no]flag
-                "md5!"          => \$opt_md5,               # [no]flag
+                'md5!'          => \$opt_md5,               # [no]flag
-                "info!"         => \$opt_info,              # [no]flag
+                'info!'         => \$opt_info,              # [no]flag
+                'tarmode!'      => \$opt_tarmode,           # [no]flag
+                'testArchive'   => \$opt_testArchive,       # [no]flag
                 );
+    #
     #   Process help and manual options
     $DPKG_ROOT = $ENV{$archive_tag} || '';
     Verbose ("Archive Variable: $archive_tag" );
     Verbose2 ("Archive Path: $DPKG_ROOT" );
+    #
+    #   Append testArchive path
+    #
+    $DPKG_ROOT = catdir ($DPKG_ROOT, '.dpkg_archive', 'test_dpkg') if $opt_testArchive;
+    #
     #   Detect NoBuild marker
     #   This will bypass most of the operation of this package
+    #
     if ( -f 'noBuild.gbe' )
+    {
+{
+    #
     #   Set up the target directory path and name
     #   It will be created later
+    #
+    if ($opt_tarmode)
+    {
+        $DPKG_DIR = catdir($DPKG_ROOT, '.dpkg_archive', 'fragments');
+    }
+    else
+    {
-    $DPKG_DIR = "$DPKG_ROOT/$DPKG_NAME/$DPKG_VERSION";
+        $DPKG_DIR = catdir($DPKG_ROOT, $DPKG_NAME, $DPKG_VERSION );
+    }
+    #
     #   Information for the user
+    #
     Information ("---------------------------------------------------------------");
     Information1("DPKG_VERSION  = [$DPKG_VERSION]");
     Information1("GBE_MACHTYPE  = [$GBE_MACHTYPE]");
     Information1("GBE_HOSTNAME  = [$GBE_HOSTNAME]");
     Information1("GBE_ABT       = [$GBE_ABT]");
     Information1("USER          = [$USER]");
-    Information ("")                                if ( $opt_merge || $opt_delete || $opt_info);
+    Information ("")                                if ( $opt_merge || $opt_delete || $opt_info || $opt_tarmode || $opt_testArchive);
+    Information ("Opt:TarMode       = Enabled")     if ( $opt_tarmode );
-    Information ("Opt:Delete    = Enabled")         if ( $opt_delete );
+    Information ("Opt:Delete        = Enabled")     if ( $opt_delete );
-    Information ("Opt:Merge     = Enabled")         if ( $opt_merge );
+    Information ("Opt:Merge         = Enabled")     if ( $opt_merge );
+    Information ("Opt:testArchive   = Enabled")     if ( $opt_testArchive );
-    Information ("Opt:TestMode  = Enabled. No Package Transferred") if ( $opt_test );
+    Information ("Opt:TestMode      = Enabled. No Package Transferred") if ( $opt_test );
-    Information ("Opt:Info      = Enabled. No Package Transferred") if ( $opt_info );
+    Information ("Opt:Info          = Enabled. No Package Transferred") if ( $opt_info );
-    Warning     ("Sandbox Build = Yes") if ($ENV{GBE_DPKG_SBOX}) ;
+    Warning     ("Sandbox Build     = Yes") if ($ENV{GBE_DPKG_SBOX}) ;
     Information ("---------------------------------------------------------------");
+    #
     #   If the environment variable GBE_DPKG_SBOX is defined then the package
     #   is being built within a development sandbox. In such a sandbox the
+        }
+    }
     Information("");
+    #
-    #   Create a file handle based in the Repository Root to allow
-    #   locking while we create the package directory
-    #   Note: Windows can't do a flock on a directory handle
-    #         so we must create a file
-    #
-    my $dirLockfile = "$DPKG_ROOT/lockfile";
-    my $pkgLockfile = "$DPKG_DIR/lockfile";
-    if ($GBE_ABT)
-    {
-        Verbose ("Acquiring archive lock");
-        open (ARCHIVE_LOCK, '>', $dirLockfile) || Error ("Cannot open archive root for locking: $!", $dirLockfile );
-        flock ARCHIVE_LOCK, 2;
-    }
-    #
     #   Create the top level directory
+    #
     mkpath($DPKG_DIR, 0, 0775);
+    #
-    #   Release the lock that we have in the target file system
-    #   Create a lock on the package version directory
-    #   This allows others to create new package versions
-    #
-    if ($GBE_ABT)
-    {
-        Verbose ("Releasing archive lock");
-        close ARCHIVE_LOCK;
-        unlink $dirLockfile;
-    }
-    Verbose ("Acquiring packageVersion lock");
-    open (ARCHIVE_LOCK, '>', $pkgLockfile) || Error ("Cannot open package directory for locking: $!", $pkgLockfile );
-    flock ARCHIVE_LOCK, 2;
-    #
     #   Transfer source directory, unless this is a noBuild
+    #
     if ( $SRC_ROOT ne '' )
+    {
         # Process the files
+    #
     #   Transfer of data is complete
     #       Mark the archive with the build machine to indicate which parts of
     #       a multi-machine build have been performed
+    #
-    my $touchfile = $opt_generic ? "$DPKG_DIR/built.generic" : "$DPKG_DIR/built.$GBE_HOSTNAME";
-    #
-    #   Create a string to be appended to the 'built' file
-    #   Comma seperated list of (possibly) useful info
-    #       Date-Time ( Local and GMT)
-    #       machine type, machine name and the user
-    #       GBE_ABT value
-    #
-    #   flock the file in an attempt to flush it out across the network
-    #   Having build issues where the file is not seen for a very long time
-    #
-    my $built_info = localtime() ."," . gmtime() . " GMT,$GBE_MACHTYPE,$GBE_HOSTNAME,$USER,$GBE_ABT";
-    LogFileOp("Mark File",$touchfile);
-    FileAppend ( $touchfile, $built_info );
+    my $touchfile = createBuiltFile($DPKG_DIR);
-    open (TOUCH_LOCK, '>', $touchfile) || Error ("Cannot build marker for locking: $!", $touchfile );
-    flock TOUCH_LOCK, 2;
-    close TOUCH_LOCK;
     addFile('file', $touchfile, $touchfile);
+    #
     #   If there is a .lnk file in the archive then remove it now that the
     #   archive has been transferred. The .lnk files are created in 'local'
         LogFileOp("Removing Link",$link_file);
         unlink $link_file;
+    }
+    #
-    #   Release the file lock
+    #   Create the MD5 info file
     #
-    Verbose ("Releasing packageVersion lock");
-    close ARCHIVE_LOCK;
+    writeFileInfo($DPKG_DIR);
-    unlink $pkgLockfile;
     return 1;
+}
 #------------------------------------------------------------------------------
 sub pkgFind2
+#
 # Description:
 #   This subroutine is used to locate all associated pkg files in
+        }
+    }
+}
 #-------------------------------------------------------------------------------
+# Function        : CreateDpkgArchiveTarBall
+#
+# Description     : Similar to CreateDpkgArchive, but it will create a tar file within the target
+#                   directory.
+#
+#                   This is used by the build system to:
+#                       1) Greatly speedup the transfer of packages with a very large number of files
+#                       2) Remove the need for an multi-filesytem, multi OS atomic lock on the package
+#
+#                   The build system will process the tarball and create the package archive
+#                   In doing so it will handle merge errors
+#
+# Inputs          :
+#
+# Returns         :
+#
+sub CreateDpkgArchiveTarBall
+{
+    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 '' )
+    {
+        $SRC_ROOT = AbsPath('pkg/noBuild');
+        RmDirTree ($SRC_ROOT);
+        mkpath($SRC_ROOT, 0, 0775);
+    }
+    #
+    #   Mark the archive with the build machine to indicate which parts of
+    #   a multi-machine build have been performed
+    #
+    createBuiltFile($SRC_ROOT);
+    #   Process the source directory
+    #   A NoBuild will contain one metafile
+    #
+    if ( -d $SRC_ROOT )
+    {
+        File::Find::find( \&pkgFindTarBall, $SRC_ROOT );
+        if (@bad_symlinks)
+        {
+            my $msg = "Bad Symlinks: " . scalar @bad_symlinks;
+            $opt_test ? ReportError($msg, @bad_symlinks) : Warning($msg, @bad_symlinks);
+        }
+        ErrorDoExit();
+    }
+    else
+    {
+        Error("Failed to find dir [$SRC_ROOT]",
+              "Check JATS config.");
+    }
+    #
+    #   Create the MD5 info file
+    #
+    writeFileInfo($SRC_ROOT);
+    #
+    #   Create the target path in the target archive
+    #
+    LogFileOp ('Creating', $DPKG_DIR);
+    mkpath($DPKG_DIR, 0, 0775);
+    #
+    #   Create the TAR file
+    #   Use gzip compression (tar.gz) as it provides a good compromise bewteen speed and size
+    #
+    my $tarTarget = join('_', $DPKG_NAME, $DPKG_VERSION, $GBE_HOSTNAME) . '.tar.gz';
+    my $tarPath = catfile($DPKG_DIR, $tarTarget);
+    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;
+        unlink $opt_outfile;
+        Error ('Cannot create tarball', "Path:$tarPath");
+    }
+    return 1;
+}
+#-------------------------------------------------------------------------------
+# Function        : pkgFindTarBall
+#
+# Description     : Used by CreateDpkgArchiveTarBall
+#                   File::Find processing function
+#
+#                   This routine is called for each file and directory within the package
+#
+# Inputs          : As per File::Find
+#
+# Returns         : Nothing
+#
+sub pkgFindTarBall
+{
+    my $item = $File::Find::name;
+    my $base = File::Basename::basename($item);
+    my $type;
+    #
+    #   Ignore the top level directory
+    #
+    return
+        if ( $item eq $SRC_ROOT );
+    #
+    #   Determine type of this item
+    #       file
+    #       link, badlink
+    #       dir
+    if ( -l $item)
+    {
+        if (-f $item) {
+            $type = 'link';
+        }
+        else
+        {
+            # Broken symlink
+            #   Remove it from the 'pkg'
+            #   Could try other ways of excluding it from the tar, but this is the simplest
+            LogFileOp("Broken SymLink", $item);
+            push @bad_symlinks, substr ( $item, 1+length ($SRC_ROOT) );
+            $type = 'badlink';
+            unlink $item;
+            return;
+        }
+    } elsif ( -f $item) {
+        $type = 'file';
+    } elsif ( -d $item) {
+        $type = 'dir';
+    } else {
+        Error("Unknown file type. Cannot be packaged");
+    }
+    #
+    #   Calculate the target directory name
+    #
+    my $target = $item;
+    $target = $DPKG_DIR . substr ( $item, length ($SRC_ROOT) );
+    addFile($type, $item, $target);
+    LogFileOp('Process',$item);
+}
+#-------------------------------------------------------------------------------
 # Function        : TestDpkgArchive
+#
 # Description     : Test the structure of the source achive
 #                   Ensure that it has some files
 #                   Warn if files are present in the root directory
             push @bad_symlinks, substr ( $File::Find::name, 1+length ($SRC_ROOT) );
+        }
+    }
+}
+#-------------------------------------------------------------------------------
+# Function        : createBuiltFile
+#
+# Description     : Create the packages built.xxxx file
+#                   Used to track which build machines have contributed to the build
+#
+# Inputs          : $targetDir          - Base directory for the file
+#
+# Returns         : Full pathname of the generatde file
+#
+sub createBuiltFile
+{
+    my ($targetDir) = @_;
+    #
+    #   Mark the archive with the build machine to indicate which parts of
+    #   a multi-machine build have been performed
+    #
+    my $touchfile = catfile( $targetDir, $opt_generic ? 'built.generic' : "built.$GBE_HOSTNAME");
+    #
+    #   Create a string to be appended to the 'built' file
+    #   Comma seperated list of (possibly) useful info
+    #       Date-Time ( Local and GMT)
+    #       machine type, machine name and the user
+    #       GBE_ABT value
+    #
+    #   Having build issues where the file is not seen for a very long time
+    #
+    my $built_info = localtime() ."," . gmtime() . " GMT,$GBE_MACHTYPE,$GBE_HOSTNAME,$USER,$GBE_ABT";
+    LogFileOp("Mark File",$touchfile);
+    FileAppend ( $touchfile, $built_info );
+    return $touchfile;
+}
 # ---------------------------------------------------------
 # ---------------------------------------------------------
 # Main
 # ---------------------------------------------------------
 # ---------------------------------------------------------
 ShowInfo();
 unless ($opt_info)
+{
     unless ( $opt_test )
+    {
+        if ($opt_tarmode)
+        {
-        Information("Creating dpkg_archive package:", $DPKG_DIR);
+            Information("Creating dpkg_archive tarball:", $DPKG_DIR);
-        CreateDpkgArchive();
+            CreateDpkgArchiveTarBall();
+        }
+        else
+        {
+            Information("Creating dpkg_archive package:", $DPKG_DIR);
-        writeFileInfo();
+            CreateDpkgArchive();
+        }
+    }
     else
+    {
         Information("Testing user package.");
         TestDpkgArchive();
     -[no]merge         - merge with existing version of the package
     -archive=name      - Specify archive (cache, local, main, store, sandbox, deploy)
     -pname=name        - Ensure package is named correctly
     -pversion=version  - Ensure package version is correct
     -generic           - Create a built.generic file
+    -[no]tarmode       - Transfer package as tarball
     -[no]md5           - Use MD5 comparison of merged files(enabled)
+  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
 =head1 OPTIONS
 =over 8
 =item B<-generic>
 This option will create a built.generic file, instead of one based on the machine
 that actually built the package. This is used by the AutoBuilder toolchain.
+=item B<-[no]tarmode>
+This option will cause the package to be transferred into the package archive as
+a tar ball. Used in the build system to address two issues:
+=over 4
+=item 1
+Slow speed in copying lots of files from the build machine to the package server.
+=item 2
+Need for cross platform file lock in order to prevent copy collisions.
+=back
 =item B<-[no]md5>
 If package builds are being merged then a validity check is performed using
 an MD5 digest over the current and the existing file.
 This option will cause the program to display information about the packaging
 process and then exit.
 No data will be transferred to the archive.
+=item B<-[no]testArchive>
+If this option is enabled then the assembly operation is performed within a test area within
+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.
 =back
 =head1 DESCRIPTION
 This utility program is used to transfer a package that has been built into
 Detect file conflicts when different builds are merged into a single package. Header files are
 allowed to differ in line ending style, but other files must not conflict. The package will not be
 reproducible if file conflicts exist.
+In 'tarmode' the package merging needs to be done by another utility.
 =item *
 Suppress dead symbolic links. A valid symlink will be preserved, but invalid links will be
 removed from the transferred image.
 =item ./build/pkg
 This format is generated by ANT builds.
+=item ./pkg/noBuild
+This format is used internally by this utilty. It will be generated by the build system
+in cases where there is no build to be performs on the current machine.
 =back
 The program should be run in the same directory as the build control files as
 the package subdirectory will be created in that directory.

Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/create_dpkg.pl – Rev 5499 → 5527