[Bio] / FigKernelPackages / Tracer.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/Tracer.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.45, Mon May 8 20:37:02 2006 UTC revision 1.54, Sun Jun 18 07:40:23 2006 UTC
# Line 24  Line 24 
24      use strict;      use strict;
25      use Carp qw(longmess croak);      use Carp qw(longmess croak);
26      use CGI;      use CGI;
27        use Cwd;
28      use FIG_Config;      use FIG_Config;
29      use PageBuilder;      use PageBuilder;
30      use Digest::MD5;      use Digest::MD5;
31      use File::Basename;      use File::Basename;
32      use File::Path;      use File::Path;
33        use File::stat;
34    
35  =head1 Tracing and Debugging Helpers  =head1 Tracing and Debugging Helpers
36    
# Line 1346  Line 1348 
1348      return @inputList;      return @inputList;
1349  }  }
1350    
1351    =head3 Percent
1352    
1353    C<< my $percent = Tracer::Percent($number, $base); >>
1354    
1355    Returns the percent of the base represented by the given number. If the base
1356    is zero, returns zero.
1357    
1358    =over 4
1359    
1360    =item number
1361    
1362    Percent numerator.
1363    
1364    =item base
1365    
1366    Percent base.
1367    
1368    =item RETURN
1369    
1370    Returns the percentage of the base represented by the numerator.
1371    
1372    =back
1373    
1374    =cut
1375    
1376    sub Percent {
1377        # Get the parameters.
1378        my ($number, $base) = @_;
1379        # Declare the return variable.
1380        my $retVal = 0;
1381        # Compute the percent.
1382        if ($base != 0) {
1383            $retVal = $number * 100 / $base;
1384        }
1385        # Return the result.
1386        return $retVal;
1387    }
1388    
1389  =head3 GetFile  =head3 GetFile
1390    
1391  C<< my @fileContents = Tracer::GetFile($fileName); >>  C<< my @fileContents = Tracer::GetFile($fileName); >>
# Line 1604  Line 1644 
1644    
1645  =head3 AddToListMap  =head3 AddToListMap
1646    
1647  C<< Tracer::AddToListMap(\%hash, $key, $value); >>  C<< Tracer::AddToListMap(\%hash, $key, $value1, $value2, ... valueN); >>
1648    
1649  Add a key-value pair to a hash of lists. If no value exists for the key, a singleton list  Add a key-value pair to a hash of lists. If no value exists for the key, a singleton list
1650  is created for the key. Otherwise, the new value is pushed onto the list.  is created for the key. Otherwise, the new value is pushed onto the list.
# Line 1619  Line 1659 
1659    
1660  Key for which the value is to be added.  Key for which the value is to be added.
1661    
1662  =item value  =item value1, value2, ... valueN
1663    
1664  Value to add to the key's value list.  List of values to add to the key's value list.
1665    
1666  =back  =back
1667    
# Line 1629  Line 1669 
1669    
1670  sub AddToListMap {  sub AddToListMap {
1671      # Get the parameters.      # Get the parameters.
1672      my ($hash, $key, $value) = @_;      my ($hash, $key, @values) = @_;
1673      # Process according to whether or not the key already has a value.      # Process according to whether or not the key already has a value.
1674      if (! exists $hash->{$key}) {      if (! exists $hash->{$key}) {
1675          $hash->{$key} = [$value];          $hash->{$key} = [@values];
1676      } else {      } else {
1677          push @{$hash->{$key}}, $value;          push @{$hash->{$key}}, @values;
1678      }      }
1679  }  }
1680    
# Line 2008  Line 2048 
2048      }      }
2049  }  }
2050    
2051    =head3 SetPermissions
2052    
2053    C<< Tracer::SetPermissions($dirName, $group, $mask, %otherMasks); >>
2054    
2055    Set the permissions for a directory and all the files and folders inside it.
2056    In addition, the group ownership will be changed to the specified value.
2057    
2058    This method is more vulnerable than most to permission and compatability
2059    problems, so it does internal error recovery.
2060    
2061    =over 4
2062    
2063    =item dirName
2064    
2065    Name of the directory to process.
2066    
2067    =item group
2068    
2069    Name of the group to be assigned.
2070    
2071    =item mask
2072    
2073    Permission mask. Bits that are C<1> in this mask will be ORed into the
2074    permission bits of any file or directory that does not already have them
2075    set to 1.
2076    
2077    =item otherMasks
2078    
2079    Map of search patterns to permission masks. If a directory name matches
2080    one of the patterns, that directory and all its members and subdirectories
2081    will be assigned the new pattern. For example, the following would
2082    assign 01664 to most files, but would use 01777 for directories named C<tmp>.
2083    
2084        Tracer::SetPermissions($dirName, 'fig', 01664, '^tmp$' => 01777);
2085    
2086    The list is ordered, so the following would use 0777 for C<tmp1> and
2087    0666 for C<tmp>, C<tmp2>, or C<tmp3>.
2088    
2089        Tracer::SetPermissions($dirName, 'fig', 01664, '^tmp1' => 0777,
2090                                                       '^tmp' => 0666);
2091    
2092    Note that the pattern matches are all case-insensitive, and only directory
2093    names are matched, not file names.
2094    
2095    =back
2096    
2097    =cut
2098    
2099    sub SetPermissions {
2100        # Get the parameters.
2101        my ($dirName, $group, $mask, @otherMasks) = @_;
2102        # Set up for error recovery.
2103        eval {
2104            # Switch to the specified directory.
2105            ChDir($dirName);
2106            # Get the group ID.
2107            my $gid = getgrnam($group);
2108            # Get the mask for tracing.
2109            my $traceMask = sprintf("%04o", $mask) . "($mask)";
2110            Trace("Fixing permissions for directory $dirName using group $group($gid) and mask $traceMask.") if T(2);
2111            my $fixCount = 0;
2112            my $lookCount = 0;
2113            # @dirs will be a stack of directories to be processed.
2114            my @dirs = (getcwd());
2115            while (scalar(@dirs) > 0) {
2116                # Get the current directory.
2117                my $dir = pop @dirs;
2118                # Check for a match to one of the specified directory names. To do
2119                # that, we need to pull the individual part of the name off of the
2120                # whole path.
2121                my $simpleName = $dir;
2122                if ($dir =~ m!/(.+)$!) {
2123                    $simpleName = $1;
2124                }
2125                # Search for a match.
2126                my $match = 0;
2127                my $i;
2128                for ($i = 0; $i < $#otherMasks && ! $match; $i += 2) {
2129                    my $pattern = $otherMasks[$i];
2130                    if ($simpleName =~ /$pattern/i) {
2131                        $match = 1;
2132                    }
2133                }
2134                # Check for a match. Note we use $i-1 because the loop added 2
2135                # before terminating due to the match.
2136                if ($match && $otherMasks[$i-1] != $mask) {
2137                    # This directory matches one of the incoming patterns, and it's
2138                    # a different mask, so we process it recursively with that mask.
2139                    SetPermissions($dir, $group, $otherMasks[$i-1], @otherMasks);
2140                } else {
2141                    # Here we can process normally. Get all of the non-hidden members.
2142                    my @submems = OpenDir($dir, 1);
2143                    for my $submem (@submems) {
2144                        # Get the full name.
2145                        my $thisMem = "$dir/$submem";
2146                        Trace("Checking member $thisMem.") if T(4);
2147                        $lookCount++;
2148                        if ($lookCount % 1000 == 0) {
2149                            Trace("$lookCount members examined. Current is $thisMem. Mask is $traceMask") if T(3);
2150                        }
2151                        # Fix the group.
2152                        chown -1, $gid, $thisMem;
2153                        # Insure this member is not a symlink.
2154                        if (! -l $thisMem) {
2155                            # Get its info.
2156                            my $fileInfo = stat $thisMem;
2157                            # Only proceed if we got the info. Otherwise, it's a hard link
2158                            # and we want to skip it anyway.
2159                            if ($fileInfo) {
2160                                my $fileMode = $fileInfo->mode;
2161                                if (($fileMode & $mask) == 0) {
2162                                    # Fix this member.
2163                                    $fileMode |= $mask;
2164                                    chmod $fileMode, $thisMem;
2165                                    $fixCount++;
2166                                }
2167                                # If it's a subdirectory, stack it.
2168                                if (-d $thisMem) {
2169                                    push @dirs, $thisMem;
2170                                }
2171                            }
2172                        }
2173                    }
2174                }
2175            }
2176            Trace("$lookCount files and directories processed, $fixCount fixed.") if T(2);
2177        };
2178        # Check for an error.
2179        if ($@) {
2180            Confess("SetPermissions error: $@");
2181        }
2182    }
2183    
2184  1;  1;

Legend:
Removed from v.1.45  
changed lines
  Added in v.1.54

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3