WebSVN – DevTools – Diff – /deployfiles/trunk/src/tools/scripts/deploylib.pm

 #      deliverable package.
+#
 # Description:
+#
+#
+#
+# 2008-08-13 Note on --InstallProdAndDebug option and AlternateBuildType:
+#   This option has been added to several functions to allow for the a build
+#   to contain both debug and production files.
+#   Most of the deploylib is based on the use of $BuildType to determine where
+#   to look for things and what files to include. To allow for both types,
+#   $AlternateBuildType is set up to hold the opposite of $BuildType
+#   (e.g. D vs P). and the DpkgBinDirListAlternate and DpkgLibDirListAlternate
+#   variables are set up to hold 'alternate' sets of directories to search.
+#   In theory, we should support 'any' build type, in which case this option
+#   would be implemented differently, but P/D are hardcoded throughout here,
+#   so this was done as a minimal impact change.
+#
+#
 #......................................................................#
-require 5.6.1;
+require 5.006_001;
 #------------------------------------------------------------------------------
 # Package definition
 #------------------------------------------------------------------------------
 package deploylib;
 use DeployUtils::RmPkgInfo;
 use BuildConfig;
 use Exporter();
 use ArrayHashUtils;
+use JatsEnv;
 use JatsError;
 use JatsSystem;
+#
 #   The LWP is a part of the Active State Perl, but not the solaris perl
                     &updatePrototypeFileItemClass
                     &useReplaceClass
                     &setReplaceClassFiles
                     &createPkginfoFile
                     &updatePrototypeFileItemOwner
+                    &setPermissions
                     &chmod
                     &chmodRecursive
                     &chmodDir
                     &chmodFile
                     &createSymbolicLink
 my ($m_UID)  = "";
 my ($m_GID)  = "";
 my ($m_MASK) = "";
 my ($m_KEEP_MASK) = "";
+my ($m_KEEP_LINKS) = "";
 #------------------------------------------------------------------------------
 # Variables global/local to this package
 #------------------------------------------------------------------------------
 our $InterfaceDir       = "";
 our $DpkgBinDir         = "";
 our %DpkgBinDirList     = ();
+our %DpkgBinDirListAlternate = (); # bin dir list for $AlternateBuildType
 our $DpkgLibDir         = "";
 our %DpkgLibDirList     = ();
+our %DpkgLibDirListAlternate = (); # lib dir list for $AlternateBuildType
 our $DpkgScriptsDir     = "";
 our $DpkgEtcDir         = "";
 our $DpkgJarDir         = "";
 our $DpkgSarDir         = "";
 our $DpkgWarDir         = "";
 our @LibCheckList       = ();
 our $CurrentDir         = "";
 our $RootDir            = "";
 our $BuildType          = "";
+our $AlternateBuildType = ""; # the opposite of $BuildType
 our $MachType           = "";
 our $Platform           = "";
 our $Product            = "";
 our $Target             = "";
 our $SrcDir             = "";
     $Username     = getlogin || getpwuid($<);
     if ( "$BuildType" eq "D" )
+    {
         $PkgBaseDir = "$PkgDir/debug";
+        $AlternateBuildType = "P";
+    }
     else
+    {
         $PkgBaseDir = "$PkgDir/prod";
+        $AlternateBuildType = "D";
+    }
     $PkgInfoFile   = "$PkgBaseDir/$PkgInfoFileName";
     $ProtoTypeFile = "$PkgBaseDir/$ProtoTypeFileName";
+            }
+        }
+    }
+    # Here we are going to build the same lists but for the $AlternateBuildType
+    # (i.e P if $BuildType=D)
+    # We use these when we need to work with both production and debug files.
+    foreach my $part ( $BuildFileInfo->getPlatformParts($Platform), $MachType )
+    {
+        next unless ( $part );
+        foreach my $subdir ( "lib." . "$part",
+                             "lib." . "$part" . "$AlternateBuildType",
+                             "lib/lib." . "$part" . "$AlternateBuildType",
+                             "lib/$part" . "$AlternateBuildType",
+                             "lib/$part" )
+        {
+            if ( -d "$DpkgLibDir/$subdir" )
+            {
+                UniquePush( \@{$DpkgLibDirListAlternate{_ALL_}}, $subdir);
+                UniquePush( \@{$DpkgLibDirListAlternate{$part}}, $subdir);
+            }
+        }
+    }
+    foreach my $part ( $BuildFileInfo->getPlatformParts($Platform), $MachType )
+    {
+        next unless ( $part );
+        foreach my $subdir ( "bin." . "$part" . "$AlternateBuildType",
+                             "bin." . "$part",
+                             "bin/bin." . "$part" . "$AlternateBuildType",
+                             "bin/" . "$part" . "$AlternateBuildType",
+                             "bin/" . uc($part) . "$AlternateBuildType",
+                             "bin/$part",
+                             "bin." . "$part" . "P",
+                             "bin/bin." . "$part" . "P",
+                             "bin/" . "$part" . "P",
+                             "bin/" . uc($part) . "P" )
+        {
+            if ( -d "$DpkgBinDir/$subdir" )
+            {
+                UniquePush( \@{$DpkgBinDirListAlternate{_ALL_}}, $subdir);
+                UniquePush( \@{$DpkgBinDirListAlternate{$part}}, $subdir);
+            }
+        }
+   }
     Information("------------------------------------------------------------");
     # lets generate the patch id if we are building a patch
+    #
     #   Creating a list allows:
     #       Simplified coding
     #       Flattening and testing of the flattening
+    #
     my @elements = $search->search( $src_base_dir);
+    Warning("installAllDpkgArchivePkgFiles2: No files found") unless ( @elements );
+    #
     #   Perform the file copy
     #   This copy will NOT create empty directories, but it will create needed
     #   directories on the fly.
     return 1;
+}
 #------------------------------------------------------------------------------
+sub copyDpkgArchiveBinFile
+#
+# Description:
+#       This sub-routine is used to find a binary file from the
+#       dpkg_archive and copy it into the supplied install dir.
+#
+#       If it fails to find the file it will report an error and terminates
+#       processing.
+#
+# Inputs          :     @srcDirList         - array of subdirectories to search
+#                                             within the $DpkgBinDir
+#                       $srcFilename        - file to find then copy
+#                       $destDir            - destination directory
+#                       $rename             - Optional Rename
+#
+#
+# Returns         :     Nothing of use
+#                       Will not return if the file is not found
+#
+#------------------------------------------------------------------------------
+{
+    my ($srcDirList, $srcFilename, $destDir, $rename ) = @_;
+    if ( "$MachType" eq "win32" )
+    {
+        # if the item does not have an .exe extention
+        # we shall add one for convience.
+        #
+        $srcFilename .= '.exe'
+            if ( $srcFilename !~ m~\.(exe)|(dll)$~i );
+        $rename .= '.exe'
+            if ( $rename && $rename !~ m~\.(exe)|(dll)$~i );
+    }
+    foreach my $i (@$srcDirList)
+    {
+        my $m_DpkgDir = "$DpkgBinDir/$i";
+        if ( ! -d $m_DpkgDir )
+        {
+            Debug("Directory [$m_DpkgDir] not found.");
+            next;
+        }
+        # Define the absolute location of the file
+        #
+        my $m_srcFileLocation = "$m_DpkgDir/$srcFilename";
+        my $m_dstFileLocation = "$destDir/" . ( $rename ? $rename : $srcFilename );
+        # we will check to see if the file exists.
+        #
+        if ( -f $m_srcFileLocation )
+        {
+            # now we need to copy the file.
+            if(File::Copy::copy($m_srcFileLocation, $m_dstFileLocation))
+            {
+                Verbose("Copied Bin [$srcFilename] to [$m_dstFileLocation] ...");
+                # no need to go further, we have found the file.
+                #
+                return 1;
+            }
+            else
+            {
+                Error("Failed to copy binary [$srcFilename]: $!");
+            }
+        }
+        # else we have not found the file yet!
+    }
+    # if we do not find the file at all we need to inform the user.
+    #
+    Error("Dpkg_archive bin file [$srcFilename]",
+          "File does not exist or is not in correct directory structure");
+}
+#------------------------------------------------------------------------------
 sub installDpkgArchiveBinFile
+#
 # Description:
 #       This sub-routine is used to install a binary file from the
 #       dpkg_archive into the supplied install dir.
 #                   --SelectFrom=xxxx       - Limits file source selection
 #                                             By default all LIB sources are searched.
 #                                             The selector should be a Platform, Product
 #                                             ,Target or MachineType
+#
+#                   --Rename=xxxx           - Rename the file during the copy operation
+#                                             Not valid if $sfile is a ref to a list
+#
+#                   --InstallProdAndDebug   - install both production and debug
+#                                             versions of any binary files
+#                                             in bin/P and bin/D sub-dirs,
+#                                             and create a links/copy of the
+#                                             file for the $BuildType
+#                                             in the actual bin directory.
+#                                             (only tested for sparc)
+#
 # Returns         :     Nothing of use
 #                       Will not return if the file is not found
+#
 #------------------------------------------------------------------------------
+{
     my @args;
     my $select = '_ALL_';
+    my $rename = "";
+    my $installProdAndDebug;
+    #
     #   Process parameters and extract options
+    #
     foreach  ( @_ )
+    {
         if ( m/^--SelectFrom=(.*)/ ) {
             $select = $1;
             Error("installDpkgArchiveBinFile: Selector not known: $_")
                 unless ( defined $DpkgLibDirList{$select} );
+        } elsif ( m/^--InstallProdAndDebug/ ) {
+            if ( "$MachType" eq "sparc" )
+            {
+                $installProdAndDebug = 1;
+            }
+            else
+            {
+                Error("--InstallProdAndDebug option only supported for sparc.");
+            }
+        } elsif ( m/^--Rename=(.+)/ ) {
+            $rename = $1;
         } elsif ( m/^--/ ) {
             Warning ("installDpkgArchiveBinFile: Unknown option ignored: $_")
         } else {
     unless ( ref ( $fref ) eq 'ARRAY' )
+    {
         push @one_file, $fref;
         $fref = \@one_file;
+    }
+    else
+    {
+        Error ("installDpkgArchiveBinFile. --Rename option cannot be used with a list of files")
+            if $rename;
+    }
     foreach my $sfile ( @$fref )
+    {
-        if ( "$MachType" eq "win32" )
+        if ( $installProdAndDebug )
+        {
-            # if the item does not have an .exe extention
+            # This option allows you to install both prod and debug binaries.
+            # 1) creates a bin/P and bin/D subdirectory of the bin directory,
-            # we shall add one for convience.
+            # 2) copies the binaries into them, then
+            # 3) links/copies from bin/$BuildType to bin directory.
-            #
-            if ( $sfile !~ m/\.exe$/  &&
+            # if the bin/P bin/D dirs don't exist, create them.
-                 $sfile !~ m/\.dll$/ )
+            if (! -d "$targetValue/$BuildType" )
+            {
-                $sfile = $sfile . ".exe";
+                make_directory( "$targetValue/$BuildType", 0777, "Create BinDir/$BuildType dir");
+            }
-        }
-        my ($i);
-        my ($foundFileFlag) = "false";
-        my ($m_DpkgBinDir)  = "";
-        my ($m_srcFileLocation) = "";
-        my ($m_dstFileLocation) = "";
-        foreach $i (@{$DpkgBinDirList{$select}})
-        {
-            $m_DpkgBinDir = "$DpkgBinDir" . "/$i";
-            if ( ! -d "$m_DpkgBinDir" )
+            if (! -d "$targetValue/$AlternateBuildType" )
+            {
-                Debug("Directory [$m_DpkgBinDir] not found.");
+                make_directory( "$targetValue/$AlternateBuildType", 0777, "Create BinDir/$AlternateBuildType dir");
-                next;
+            }
+            # copy in the production and debug binaries. Note the separate search paths.
+            copyDpkgArchiveBinFile(\@{$DpkgBinDirList{$select}}, $sfile, "$targetValue/$BuildType", $rename);
+            copyDpkgArchiveBinFile(\@{$DpkgBinDirListAlternate{$select}}, $sfile, "$targetValue/$AlternateBuildType", "$rename");
-            # lets define the absolute location of the file
+            # create link (or copy) from bin to bin/$BuildType dir
-            $m_srcFileLocation = "$m_DpkgBinDir/$sfile";
-            $m_dstFileLocation = "$targetValue/$sfile";
-            # we will check to see if the file exists.
-            #
-            if ( -f "$m_srcFileLocation" )
+            if ( $MachType eq "sparc" )
+            {
-                # now we need to copy the file.
+                # create symbolic link in the bin directory
-                if(File::Copy::copy("$m_srcFileLocation", "$m_dstFileLocation"))
+                if ( ! -f "$targetValue/$sfile" )
+                {
-                    Verbose("Copied Bin [$sfile] to [$m_dstFileLocation] ...");
+                    my $cmd = "cd $targetValue; ln -s $BuildType/$sfile $sfile ";
+                    my $retVal = system($cmd);
-                    $foundFileFlag = "true";
+                    if ( $retVal != 0 )
+                    {
-                    # no need to go further, we have found the file.
+                        Error("Failed to create generic link [$targetValue/$sfile] to [$targetValue/$BuildType/$sfile]: $retVal");
-                    #
+                    }
-                    last;
+                    else
+                    {
+                        Verbose("Created generic link [$targetValue/$sfile] to [$targetValue/$BuildType/$sfile] ...");
+                    }
+                }
+            }
+            else
+            {
+                # create a copy in the bin directory
+                if(File::Copy::copy("$targetValue/$BuildType/$sfile" , "$targetValue" ))
+                {
+                    Verbose("Copied Bin [$targetValue/$BuildType/$sfile] to [$targetValue] ...");
+                }
                 else
+                {
-                    Error("Failed to copy binary [$sfile]: $!");
+                    Error("Failed to copy binary [$targetValue/$BuildType/$sfile] to [$targetValue]: $!");
+                }
+            }
-            # else we have not found the file yet!
+        }
-        # if we do not find the file at all we need to inform
-        # the user.
-        #
+        else
-        if ( "$foundFileFlag" eq "false" )
+        {
-            Error("Dpkg_archive bin file [$sfile] does not exist or is not in correct directory structure.");
+            copyDpkgArchiveBinFile(\@{$DpkgBinDirList{$select}}, $sfile, $targetValue, $rename );
+        }
+    }
     return 1;
+}
 #------------------------------------------------------------------------------
 sub installDpkgArchiveLibFile
+#
 # Description:
-#       This sub-routine is used to install a binary file from the
+#       This sub-routine is used to install a library file from the
 #       dpkg_archive into the supplied install location dir.
+#
 #       It assumes based on the build type where the file will be located.
+#
 #       If it fails to find the file it will report an error and terminates
 #                   --Link                  - Default
 #                   --SelectFrom=xxxx       - Limits file source selection
 #                                             By default all LIB sources are searched.
 #                                             The selector should be a Platform, Product
 #                                             ,Target or MachineType
+#                   --InstallProdAndDebug   - install both production and debug
+#                                             versions of any libraries
+#                                             (only tested for sparc)
+#
 # SourceFile options:
 #                   Source files may be a filter rule which will expand to
 #                   one or more files.
 #                       --FilterIn=xx
 #------------------------------------------------------------------------------
+{
     my @args;
     my $links = 1;
     my $select = '_ALL_';
+    my $installProdAndDebug;
+    #
     #   Process parameters and extract options
+    #
     foreach  ( @_ )
             Error("installDpkgArchiveLibFile: Selector not known: $_")
                 unless ( defined $DpkgLibDirList{$select} );
         } elsif ( m/^--Filter.*=/ ) {
             push @args, $_;
+        } elsif ( m/^--InstallProdAndDebug/ ) {
+            # not sure if the filename conventions allow the installation
+            # of both prod/debug files on windows, so limit this to sparc/unix.
+            if ( "$MachType" ne "sparc" ){
+                Error("Can only use the InstallProdAndDebug option for sparc.");
+            }
+            $installProdAndDebug = 1;
         } elsif ( m/^--/ ) {
             Warning ("installDpkgArchiveLibFile: Unknown option ignored: $_")
         } else {
             push @args, $_;
         my ($ExcludedFlag) = "false";
+        #
         #   Search all the 'lib' locations, or a specified subset
+        #
-        foreach $i (@{$DpkgLibDirList{$select}})
+        my (@libDirList) = @{$DpkgLibDirList{$select}};
+        if ($installProdAndDebug)
+        {
+            # we want to be able to search both prod and debug dirs.
+            # we can just add them together here because the lib filenames
+            # are different (i.e. xxxD.so vs xxxP.so) and a P or D library
+            # will only exist in one dir. i.e. P.so in prod dirs, D.so in debug dirs.
+            push @libDirList, @{$DpkgLibDirListAlternate{$select}};
+        }
+        foreach $i (@libDirList)
+        {
             $m_DpkgLibDir = "$DpkgLibDir" . "/$i";
             if ( ! -d "$m_DpkgLibDir" )
+            {
             $m_srcFileLocation = "$m_DpkgLibDir/$sfile";
             $m_dstFileLocation = "$targetValue/$sfile";
             # we only want debug items in a debug build
-            #
+            # unless we are told to installProdAndDebug
-            if(excludeItemFromBuild($sfile))
+            if ( ( !$installProdAndDebug) && (excludeItemFromBuild($sfile)) )
+            {
                 Verbose("Excluding item [$sfile] from build as not compatible with build type [$BuildType].");
                 $ExcludedFlag = "true";
+            }
             else
                         if ( $links && ( "x$PkgPatchID" eq "x" || "$MachType" eq "win32") )
+                        {
                             # normal build or if we are building win32 we want generic names
                             # we want to create a copy of our target using
-                            # the generic name
+                            # the generic name (no version number)
                             if ( $sfile ne $nVerName )
+                            {
                                 createGenericCopy("$sfile", "$m_srcFileLocation", "$nVerName", "$targetValue");
+                            }
+                            # and another copy with no build type or version number.
                             if ( $sfile ne $gName )
+                            {
+                                # because this link doesn't have a P/D
+                                # differentiator, we can only have one, so
+                                # do this for the $BuildType file, but not any
+                                # $AlternateBuildType files
+                                if ( (!$installProdAndDebug) || ( $sfile =~ /$BuildType\./ ) )
+                                {
-                                createGenericCopy("$sfile", "$m_srcFileLocation", "$gName",    "$targetValue");
+                                    createGenericCopy("$sfile", "$m_srcFileLocation", "$gName",    "$targetValue");
+                                }
+                            }
+                        }
                         # lets add this lib to our check list for next time.
+#
 #        On sparc this will be a link, but on win32 it will be a file based on the
 #        buildType.
+#
 #    INPUT:
-#        src item name
+#        sName = src item name without path
+#        sLoc = src item name including path
-#        generic item name
+#        gName = generic item name
-#        target dir
+#        tDir = target dir
+#
 #    RETURN:
 #         1
+#
 #------------------------------------------------------------------------------
+        {
             Error("Failed to copy info file [$PKG_UTIL_DIR/$i] to [$PkgBaseDir] : $!");
+        }
+    }
+    #
+    #   Scan the install 'image' looking for files and directories that have a 'space' in the name
+    #   These are not handled by the pkgmk utility, so it is best to create a nice error message now.
+    #
+    my $search = LocateFiles->new( recurse => 1, dirs_too => 1 );
+    $search->filter_in_re('\s');
+    my @m_nfiles = $search->search($PkgBaseDir);
+    if ( @m_nfiles )
+    {
+        Error ("Pathnames containing a space cannot be packaged under Solaris",
+               "The following paths contain a space",
+               @m_nfiles );
+    }
     my ( $m_pkgmkCmd );
     my ( $m_pkgtransCmd );
     $m_pkgmkCmd = "pkgmk -o " .
                   "-f $PkgBaseDir/prototype " .
+                  "-d $PkgBaseDir " .
-                  "-d $PkgBaseDir";
+                  "-r $PkgBaseDir";
     $m_pkgtransCmd = "pkgtrans -o " .
                      "-s $PkgBaseDir " .
                      "$PkgOutputFile " .
                      "$PkgName";
         next unless ( -f $prog );
         $prog_found = 1;
         last;
+    }
+    #
+    #   Note: Use $RootDir for the ISBUILD workdir
+    #         Would like t use interface, but it makes
+    #         the pathname longer and some MergeModules can
+    #         be extracted. ISBUILD appears to have a path length limit of
+    #         about 204 character. We need all we can get.
+    #
     Error("isbuild.pl not found") unless $prog_found;
     Verbose("isbuild: $prog");
     my $rv = system ( $ENV{GBE_PERL}, $prog,
                             "-project=../$PkgName.ism",
                             "-version=$PkgVersionUser",
                             "-out=$ReleaseDir",
-                            "-workdir=$InterfaceDir",
+                            "-workdir=$RootDir",
                             @user_options,
                             map { "-mergemodule=$_" } @mm_dirs
                              );
     Error ("InstallShield Builder Error" ) if ( $rv );
     return 1;
     # lets take the passed in args.
     my ($uid, $gid) = @_;
-    # we need to determine whiich file we are dealing with
+    # we need to determine which file we are dealing with
     my ($protoTypeFile);
     my ($targetBaseDir);
     my ($pkgBaseDir);
     $protoTypeFile = "$ProtoTypeFile";
     $targetBaseDir = "$PkgBaseDir/$TargetBaseDir";
+}
 #------------------------------------------------------------------------------
-sub chmod
+sub setPermissions
+#   Called to set permissions of files/dirs in a directory structure.
+#       With no options sets DirTag and all files/dirs in it to perms
 #
-# Description:
+#   Parameters:
-#       This sub-routine is used to change the ownership of a file or
+#               DirTag:  The directory tag to start setting permissions on
+#
+#   Required Options:
-#       directory structure.
+#       One or both of
+#               --FilePerms=    Sets the permissions of files to this permission.
+#                               If not supplied then no files have their permissions changed
+#               --DirPerms=     Sets the permissions of directories to this permission
+#                               If not supplied then no directories have their permissions changed
+#       OR
+#               --Perms=        Sets the permissions of both files and directories to this permissions
+#                               Equivalent to supplying both --FilePerms=X && --DirPerms=X
+#
+#   Options:
+#               --Recurse       Recurse the directory tree.  Does a deptth first recurse so that all
+#                               dir entries are processed before the dir itself
+#               --NoRecurse     Dont recurse, default
+#               --DirTagOnly    Only sets the permissions on the DirTag directory,
+#                               all other options ignored
+#               --SkipDirTag    Does not set permissions on the DirTag Directory,
+#                               obviously mutually exlusive with --DirTagOnly
+#               --FilterIn=     Apply permissions to files/directories that matches this value.
+#               --FilterInRE=   Perl RE's can be used (Not Shell wildcards) and this option
+#                               can be supplied mulitple times
+#               --FilterOut=    Dont apply permissions to any files/directories matching this value
+#               --FilterOutRE=  Perl RE's can be used (Not Shell wildcards) and this option
+#                               can be supplied mulitple times
+#
+#                               FilterIn is applied before FilterOut.  If Recurse is specified
+#                               the directory will be recursed regardless of these filters, however
+#                               the filter will be applied when it comes time to chmod the dir
+#
 #------------------------------------------------------------------------------
+{
-    # correct number of parameters?
+    my ( $dirTag, $filePerms, $dirPerms );
+    my ( $dirTagOnly, $skipDirTag ) = ( 0, 0 );
+    my $search =  LocateFiles->new( recurse => 0, dirs_too =>1 );
-    if ( ($#_+1) != 3 )
+    foreach ( @_ )
+    {
-        Error("Incorrect number of params passed to " .
+        if ( m/^--Perms=(.*)/ ) {
-                  "chmod() function. Check deploy config.");
+            $filePerms = $1;
-    }
+            $dirPerms = $1;
+        } elsif ( m/^--FilePerms=(.*)/ )  {
+            $filePerms = $1;
+        } elsif ( m/^--DirPerms=(.*)/ )  {
+            $dirPerms = $1;
-    # lets setup the passed values.
+        } elsif ( m/^--Recurse/ ) {
+            $search->recurse(1);
+        }
-    my ($m_sDirTag, $m_sfile, $m_ownPerms) = @_;
+        elsif ( m/^--NoRecurse/ ) {
+            $search->recurse(0);
+        }  elsif ( m/^--DirTagOnly/ ) {
+            $dirTagOnly = 1;
+        } elsif ( m/^--SkipDirTag/ )  {
+            $skipDirTag = 1;
+        }  elsif ( m/^--FilterInRE=(.*)/ ) {
+            $search->filter_in_re($1);
+        } elsif ( m/^--FilterIn=(.*)/ ) {
+            $search->filter_in($1);
+        }  elsif ( m/^--FilterOutRE=(.*)/ ) {
+            $search->filter_out_re($1);
+        }  elsif ( m/^--FilterOut=(.*)/ ) {
+            $search->filter_out($1);
+        } else  {
+            Error("SetPermissions DirTag already set") if ( $dirTag );
+            $dirTag = $_;
+        }
+    }
+    Error("SetPermissions called with out DirTag parameter") if ( !defined($dirTag) );
+    Error("SetPermissions called with out any Permission options") if ( !defined($filePerms) && !defined($dirPerms) );
+    Error("SetPermissions: Options --DirTagOnly & --SkipDirTag are mutually exclusive" ) if ( $dirTagOnly && $skipDirTag );
+    #
     # lets just check to see if the perms are in correct format.
+    #
-    if ( "$m_ownPerms" !~ m/^[0-9][0-9][0-9][0-9]$/ )
+    if ( (defined($filePerms) && $filePerms !~ m/^\d{4}$/) || (defined($dirPerms) && $dirPerms !~ m/^\d{4}$/) )
+    {
-        Error("chmod() does not support [$m_ownPerms] permission, use format 0755 etc.");
+        Error("setPermissions called with invalid permissions format");
-        return 1;
+    }
-    # lets get the absolute src dir value
+    #   Convert the symbolic target directory name into a real path
-    my ($m_sDirAbsoluteValue) = getTargetDstDirValue($m_sDirTag, "A");
+    my ($topDir) = getTargetDstDirValue($dirTag, "A");
+    #
+    #   Only set perms on the root directory
+    #   This is a trivial operation
-    my($item);
+    #
-    if ( "x$m_sfile" eq "x" )
+    if ( $dirTagOnly )
+    {
+        Error("SetPermissions:  --DirPerms or --Perms not supplied for setting perms with --DirTagOnly")
+            if ( ! defined($dirPerms) );
+        Information("SetPermissions: Setting permissions on top level dir only [$topDir] to " . $dirPerms);
-        $item = "$m_sDirAbsoluteValue";
+        chmodFile($topDir, $dirPerms);
+        return;
+    }
+    Information("SetPermissions: Called with options " . join(", ", @_));
+    #
+    #   Create a list of files/dirs to process
-    else
+    #
+    my @elements = $search->search( $topDir );
+    Warning ("setPermissions: No files located") unless ( @elements );
+    foreach my $dirEntry ( @elements )
+    {
-        $item = "$m_sDirAbsoluteValue/$m_sfile";
+        my $fullPath = "$topDir/$dirEntry";
+        # A dir and we dont have dirperms, so skip
+        if ( -d $fullPath && !defined($dirPerms) )
+        {
+            Debug2("SetPermissions: Skipping dir $fullPath as we have no dir permissions");
+            next;
+        }
+        # A file and we dont have fileperms, so skip
+        if ( -f $fullPath && !defined($filePerms) )
+        {
+            Debug2("SetPermissions: Skipping file $fullPath as we have no file permissions");
+            next;
+        }
+        # a file or a dir and have the right permissions and we are not recursing
+        if ( -f $fullPath || -d $fullPath )
+        {
+            chmodFile($fullPath, ( -f $fullPath ) ? $filePerms : $dirPerms);
+        }
+        else
+        {
+            Warning("SetPermissions: Skipping $fullPath as its not a file or directory");
+        }
+    }
-    # check to see if item exists
+    #
-    if ( ! -f "$item" &&
+    #   Process the topDir
+    #   May not be modified if --SkipDirTag has been requested
+    #
-         ! -d "$item" )
+    if ( !$skipDirTag && defined($dirPerms) )
+    {
-        Error("Failed to find item [$item]. Check deploy config.");
+        chmodFile($topDir, $dirPerms);
+    }
+}   # setPermissions
+#------------------------------------------------------------------------------
+sub chmod
+#
+# Description:
+#       This sub-routine is used to change the ownership of a file or
+#       directory structure.
+#
+#------------------------------------------------------------------------------
+{
+    # correct number of parameters?
-    Verbose("chmod: Changing permisions of file [$m_sfile] in dirtag [$m_sDirTag] to [$m_ownPerms]");
+    Error("Incorrect number of params passed to chmod() function. Check deploy config.") if ( ($#_+1) != 3 );
+    # lets setup the passed values.
-    chmodFile("$item", $m_ownPerms);
+    my ($m_sDirTag, $m_sfile, $m_ownPerms) = @_;
+    Warning("chmod has been deprecated by and now calls setPermissions, see deploylib.pm");
+    # call setPermissions, if no File then do DirTagOnly, otherwise set FilterIn=File
+    setPermissions($m_sDirTag, "--NoRecurse",
+                    ($m_sfile) ? "--DirPerms=$m_ownPerms" : "--FilePerms=$m_ownPerms",
+                    ($m_sfile) ? "--DirTagOnly"           : "--FilterIn=$m_sfile" );
     return 1;
+}
 #       the target packgae.
+#
 #------------------------------------------------------------------------------
+{
     # correct number of parameters?
-    if ( ($#_+1) != 2 )
-    {
-        Error("Incorrect number of params passed to " .
-                  "chmodRecursive() function. Check deploy config.");
+    Error("Incorrect number of params passed to chmodRecursive() function. Check deploy config.") if ( ($#_+1) != 2 );
-    }
     # lets setup the passed values.
     my ($m_sDirTag, $m_ownPerms) = @_;
-    # lets just check to see if the perms are in correct format.
-    #
-    if ( "$m_ownPerms" !~ m/^[0-9][0-9][0-9][0-9]$/ )
-    {
-        Error("chmod() does not support [$m_ownPerms] permission, use format 0755 etc.");
+    Warning("chmodRecursive has been deprecated by and now calls setPermissions, see deploylib.pm");
-        return 1;
-    }
-    # lets get the absolute src dir value
-    my ($m_sDirAbsoluteValue) = getTargetDstDirValue($m_sDirTag, "A");
-    # check to see if item exists
-    #
-    if ( ! -f "$m_sDirAbsoluteValue" &&
-         ! -d "$m_sDirAbsoluteValue" )
-    {
-        Error("Failed to find item [$m_sDirAbsoluteValue]. " .
-                  "Check deploy config.");
-    }
-    # if its a not a dir
-    #
-    if ( ! -d "$m_sDirAbsoluteValue" && -f "$m_sDirAbsoluteValue" )
-    {
-        Warning("chmodRecursive: This should not happen as dirtag [$m_sDirTag] is a file, changings perms to [$m_ownPerms] anyway");
-        chmodFile("$m_sDirAbsoluteValue", $m_ownPerms);
-    }
-    else
-    {
-        # it must be a dir
-        Verbose("chmodRecursive: Recursively setting perms on dirtag [$m_sDirTag] to [$m_ownPerms]");
+    # call setPermissions, if no File then do DirTagOnly, otherwise set FilterIn=File
-        chmodDir("$m_sDirAbsoluteValue", $m_ownPerms);
+    setPermissions($m_sDirTag, "--Recurse", "--Perms=$m_ownPerms");
-    }
     return 1;
+}
 #       finds a dir it recurses into that dir chmod'ing it as well.
+#
 #------------------------------------------------------------------------------
+{
     # correct number of parameters?
-    if ( ($#_+1) != 2 )
-    {
-        Error("Incorrect number of params passed to " .
+    Error("Incorrect number of params passed to chmodDir() function.") if ( ($#_+1) != 2 );
-                  "chmodDir() function.");
-    }
     my ($startingPoint, $perms) = @_;
+    Warning("chmodDir has been deprecated by setPermissions, see deploylib.pm");
     Verbose("chmodDir: Recursively setting permsision of [$startingPoint] to [$perms]");
     local *DIR;
-    opendir(DIR, $startingPoint) or
-        Error("can't opendir $startingPoint: $!");
+    opendir(DIR, $startingPoint) or Error("can't opendir $startingPoint: $!");
     my ($item);
     while (defined($item = readdir(DIR)))
+    {
-        if ( "$item" !~ /^\.$/  &&
-             "$item" !~ /^\.\.$/ )
+        if ( "$item" !~ /^\.$/  && "$item" !~ /^\.\.$/ )
+        {
             if ( -d "$startingPoint/$item" )
+            {
                 chmodDir("$startingPoint/$item", $perms);
+            }
 #------------------------------------------------------------------------------
 sub chmodFile
+#
-#    this function is used to chmod the perms od an item
+#    this function is used to chmod the perms of an item
 #    it is passed the absolute path to the item and the associated
 #    perms.
+#
 #------------------------------------------------------------------------------
+{
     my ($item, $perms) = @_;
-    my ($cmd) = "CORE::chmod $perms, $item";
     my ($noItems) = CORE::chmod oct($perms), $item;
     if ( $noItems == 0 )
+    {
-        Error("Failed to complete command [$cmd], retVal=[$noItems]");
+        Error("ERROR: Failed to chmod $item=$perms, retVal=[$noItems]");
+    }
     else
+    {
-        Debug("Executed command: [$cmd]");
+        Debug("Successfully chmod $item=$perms");
+    }
     return 1;
+}
 #       This sub-routine is used to create the required package prototype file
 #       fom a known directory struture using the a=b format.
+#
 #------------------------------------------------------------------------------
+{
-    my ($opt_keep_mask, @args);
+    my ($opt_keep_mask, $opt_keep_links, @args);
+    #
     #   Process the arguments and extract parameters and options
+    #
     foreach ( @_ )
+    {
         if ( m/^--KeepMask/ ) {
             $opt_keep_mask = 1;
+        } elsif ( m/^--KeepLinks/ ) {
+            $opt_keep_links = 1;
         } elsif ( m/^--/ ) {
             Error("createPrototypeFile2: Unknown option: $_")
         } else {
             push @args, $_;
+    #
     $m_UID  = $uid;
     $m_GID  = $gid;
     $m_MASK = $mask;
     $m_KEEP_MASK = $opt_keep_mask;
+    $m_KEEP_LINKS = $opt_keep_links;
     # now we need to add entries for each directory we will
     # be installing
     File::Find::find(\&prototype2Find, "$targetBaseDir");
+            }
             open ( FILE, ">> $pfile") or
                 Error("Failed to open file [$pfile].");
+            if ( $m_KEEP_LINKS && -l "$m_sfile" )
+            {
+                my $linkDest = readlink($m_sfile);
+                Warning("Link $m_sfile has an absolute path, may not be a problem but make sure its what you want") if ( $linkDest =~ /^\// );
+                printf FILE ("s none $file=$linkDest\n");
+            }
-            if ( -f "$m_sfile" )
+            elsif ( -f "$m_sfile" )
+            {
                 printf FILE ("f none $file=$file $fmask $m_UID $m_GID\n");
+            }
-            if ( -d "$m_sfile" )
+            elsif ( -d "$m_sfile" )
+            {
                 printf FILE ("d none $file $fmask $m_UID $m_GID\n");
+            }
             close (FILE);
 #       It also checks if the name provided should be excluded from
 #       the build.
+#
 #------------------------------------------------------------------------------
+{
+    my $installProdAndDebug;
+    my $itemName = "";
    # correct number of parameters?
-    if ( ($#_+1) != 1 )
+    if ( (($#_+1) < 1) || (($#_+1) > 2))
+    {
         Error("Incorrect number of params passed to " .
                   "getGenericNameNoVersionForLib() function. Check deploy config.");
+    }
+    #
+    #   Process parameters and extract options
+    #
+    foreach  ( @_ )
+    {
+        if ( m/^--InstallProdAndDebug/ ) {
+            # not sure if the filename conventions allow the installation
+            # of both prod/debug files on windows, so limit this to sparc/unix.
+            if ( "$MachType" ne "sparc" ){
+                Error("Can only use the InstallProdAndDebug option for sparc.");
+            }
+            $installProdAndDebug = 1;
+        } else {
+            $itemName = $_;
+        }
+    }
     # lets just check to see if we can execute this function on
     # this machine.
+    #
     if ( "$MachType" ne "sparc" )
+    {
         Verbose("getGenericNameNoVersionForLib() not supported on this machine type.");
         return "";
+    }
-    my($itemName) = @_;
-    # first we need to check to see if it belongs in this build
+    # first we need to check to see if it belongs in this build.
-    #
+    # if we've been told that both P & D are allowed, skip this check.
     my ($gName) = "";
-    if(excludeItemFromBuild($itemName))
+    if( !$installProdAndDebug && excludeItemFromBuild($itemName))
+    {
         Verbose("Excluding item [$itemName] from build as not compatible with build type " .
                 "[$BuildType].");
         return "";  # file should be excluded.
+    }
+}
 #===============================================================================
+#
 #   Internal Package
-#   An attempt to simplify the WildCardinf interface by capturing the parameters
+#   An attempt to simplify the WildCarding interface by capturing the parameters
 #   in a package. The idea is that storing the arguments can be easier
+#
 package LocateFiles;
 use JatsError;
     $self->{recurse}  = 0;
     $self->{exclude}  = [];
     $self->{include}  = [];
     $self->{base_dir} = undef;
     $self->{results}  = [];
+    $self->{dirs_too} = 0;
     bless ($self, $class);
+    #
     #   Process user arguments
     #   These are are a hash
+    }
     return $self;
+}
 #-------------------------------------------------------------------------------
-# Function        : recurse
+# Function        :  Class accessor fucntions
-#                   filter_in
+#                   recurse                     - Recurse subdirs
-#                   filter_in_re
+#                   filter_in                   - Filter in these files
+#                   filter_in_re                - Filter in (Regular Expression)
-#                   filter_out
+#                   filter_out                  - Filter out these files
-#                   filter_out_re
+#                   filter_out_re               - Filter out (RE)
-#                   base_dir
+#                   base_dir                    - Base dir for search
+#                   results                     - Results of the last search
+#                   dirs_too                    - Include dirs in the search
+#                   has_filter                  - Has any filter been defined
-#                   results
+#                   search                      - Perform the search
+#
 # Description     : Accessor functions
+#
 # Inputs          : class
 #                   One argument (optional)
     my $self = shift;
     if (@_) { push @{$self->{exclude}}, shift }
     return $self->{exclude};
+}
+sub dirs_too
+{
+    my $self = shift;
+    if (@_) { $self->{dirs_too} = shift }
+    return $self->{dirs_too};
+}
 sub base_dir
+{
     my $self = shift;
     if (@_) { $self->{base_dir} = shift }
     return $self->{base_dir};
 # Returns         : List of files that match the search criteria
+#
 my @search_list;             # Must be global to avoid closure problems
 my $search_len;
+my $search_base_dir;
+my $search_dirs_too;
 sub search
+{
     my $self = shift;
     $self->{base_dir} = $_[0] if (defined $_[0] );
     #       1) Start with a '/'
     #       2) Are rooted as $dir, but don't include $dir
+    #
     if ( $self->{recurse} )
+    {
+        $search_dirs_too = $self->{dirs_too};
+        $search_base_dir = $self->{base_dir};
         sub find_file_wanted
+        {
-            return if ( -d $_ );
+            return if ( !$search_dirs_too && -d $_ );               # skip if current is dir and we are not including dirs
+            return if ( $search_base_dir eq $File::Find::name );    # skip if current is base_dir as we dont include it
             my $file = $File::Find::name;
             push @search_list, substr($file, $search_len );
+        }
+        #
         opendir DIR, $self->{base_dir} || die ("Cannot open $self->{base_dir}");
         foreach ( readdir( DIR ) )
+        {
             next if /^\Q.\E$/;
             next if /^\Q..\E$/;
-            next if ( -d "$self->{base_dir}/$_" );
+            next if ( !$self->{dirs_too} && -d "$self->{base_dir}/$_" );
             push @search_list, '/' . $_;
+        }
         closedir DIR;
+    }

Subversion Repositories DevTools

(root)/deployfiles/trunk/src/tools/scripts/deploylib.pm – Rev 1554 → 1556