WebSVN – DevTools – Diff – /deployfiles/branches/deployfiles_2.4.4.cr_for_2.4.6.cr/src/tools/scripts/deploylib.pm

 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
     #   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.
+}
 #------------------------------------------------------------------------------
-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;
+        } elsif ( m/^--Recurse/ ) {
+            $search->recurse(1);
+        }
+        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=(.*)/ ) {
-    # lets setup the passed values.
+            $search->filter_in($1);
+        }  elsif ( m/^--FilterOutRE=(.*)/ ) {
-    my ($m_sDirTag, $m_sfile, $m_ownPerms) = @_;
+            $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
+    #   Process the topDir
+    #   May not be modified if --SkipDirTag has been requested
+    #
-    if ( ! -f "$item" &&
+    if ( !$skipDirTag && defined($dirPerms) )
-         ! -d "$item" )
+    {
-        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", "--Perms=$m_ownPerms",
+                    ($m_sfile eq "") ? "--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);
+            }
+#
 #------------------------------------------------------------------------------
+{
     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;
+}
     $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
     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};
+    #
     if ( $self->{recurse} )
+    {
         sub find_file_wanted
+        {
-            return if ( -d $_ );
+            return if ( !$self->{dirs_too} && -d $_ );
             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/branches/deployfiles_2.4.4.cr_for_2.4.6.cr/src/tools/scripts/deploylib.pm – Rev 1591 → 1592