[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.73, Tue Oct 3 12:04:50 2006 UTC revision 1.77, Sat Oct 7 13:21:08 2006 UTC
# Line 34  Line 34 
34      use LWP::UserAgent;      use LWP::UserAgent;
35      use Time::HiRes 'gettimeofday';      use Time::HiRes 'gettimeofday';
36      use URI::Escape;      use URI::Escape;
37        use Time::Local;
38    
39  =head1 Tracing and Debugging Helpers  =head1 Tracing and Debugging Helpers
40    
# Line 931  Line 932 
932      return $value;      return $value;
933  }  }
934    
935    =head3 ParseTraceDate
936    
937    C<< my $time = Tracer::ParseTraceDate($dateString); >>
938    
939    Convert a date from the trace file into a PERL timestamp.
940    
941    =over 4
942    
943    =item dateString
944    
945    The date string from the trace file. The format of the string is determined by the
946    L</Now> method.
947    
948    =item RETURN
949    
950    Returns a PERL time, that is, a number of seconds since the epoch, or C<undef> if
951    the time string is invalid.
952    
953    =cut
954    
955    sub ParseTraceDate {
956        # Get the parameters.
957        my ($dateString) = @_;
958        # Declare the return variable.
959        my $retVal;
960        # Parse the date.
961        if ($dateString =~ m#(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+)#) {
962            # Create a time object. Note we need to convert the day, month,
963            # and year to a different base. Years count from 1900, and
964            # the internal month value is relocated to January = 0.
965            $retVal = timelocal($6, $5, $4, $2, $1 - 1, $3 - 1900);
966        }
967        # Return the result.
968        return $retVal;
969    }
970    
971  =head3 LogErrors  =head3 LogErrors
972    
973  C<< Tracer::LogErrors($fileName); >>  C<< Tracer::LogErrors($fileName); >>
# Line 1598  Line 1635 
1635      # Close it.      # Close it.
1636      close $handle;      close $handle;
1637      my $actualLines = @retVal;      my $actualLines = @retVal;
1638        Trace("$actualLines lines read from file $fileName.") if T(File => 2);
1639      # Return the file's contents in the desired format.      # Return the file's contents in the desired format.
1640      if (wantarray) {      if (wantarray) {
1641          return @retVal;          return @retVal;
# Line 1633  Line 1671 
1671      my ($fileName, $lines) = @_;      my ($fileName, $lines) = @_;
1672      # Open the output file.      # Open the output file.
1673      my $handle = Open(undef, ">$fileName");      my $handle = Open(undef, ">$fileName");
1674        # Count the lines written.
1675      if (ref $lines ne 'ARRAY') {      if (ref $lines ne 'ARRAY') {
1676          # Here we have a scalar, so we write it raw.          # Here we have a scalar, so we write it raw.
1677          print $handle $lines;          print $handle $lines;
1678            Trace("Scalar put to file $fileName.") if T(File => 3);
1679      } else {      } else {
1680          # Write the lines one at a time.          # Write the lines one at a time.
1681            my $count = 0;
1682          for my $line (@{$lines}) {          for my $line (@{$lines}) {
1683              print $handle "$line\n";              print $handle "$line\n";
1684                $count++;
1685          }          }
1686            Trace("$count lines put to file $fileName.") if T(File => 3);
1687      }      }
1688      # Close the output file.      # Close the output file.
1689      close $handle;      close $handle;
# Line 2546  Line 2589 
2589  sub Insure {  sub Insure {
2590      my ($dirName) = @_;      my ($dirName) = @_;
2591      if (! -d $dirName) {      if (! -d $dirName) {
2592          Trace("Creating $dirName directory.") if T(2);          Trace("Creating $dirName directory.") if T(File => 2);
2593          eval { mkpath $dirName; };          eval { mkpath $dirName; };
2594          if ($@) {          if ($@) {
2595              Confess("Error creating $dirName: $@");              Confess("Error creating $dirName: $@");
# Line 2575  Line 2618 
2618      if (! -d $dirName) {      if (! -d $dirName) {
2619          Confess("Cannot change to directory $dirName: no such directory.");          Confess("Cannot change to directory $dirName: no such directory.");
2620      } else {      } else {
2621          Trace("Changing to directory $dirName.") if T(4);          Trace("Changing to directory $dirName.") if T(File => 4);
2622          my $okFlag = chdir $dirName;          my $okFlag = chdir $dirName;
2623          if (! $okFlag) {          if (! $okFlag) {
2624              Confess("Error switching to directory $dirName.");              Confess("Error switching to directory $dirName.");
# Line 2754  Line 2797 
2797          my $gid = getgrnam($group);          my $gid = getgrnam($group);
2798          # Get the mask for tracing.          # Get the mask for tracing.
2799          my $traceMask = sprintf("%04o", $mask) . "($mask)";          my $traceMask = sprintf("%04o", $mask) . "($mask)";
2800          Trace("Fixing permissions for directory $dirName using group $group($gid) and mask $traceMask.") if T(2);          Trace("Fixing permissions for directory $dirName using group $group($gid) and mask $traceMask.") if T(File => 2);
2801          my $fixCount = 0;          my $fixCount = 0;
2802          my $lookCount = 0;          my $lookCount = 0;
2803          # @dirs will be a stack of directories to be processed.          # @dirs will be a stack of directories to be processed.
# Line 2769  Line 2812 
2812              if ($dir =~ m!/([^/]+)$!) {              if ($dir =~ m!/([^/]+)$!) {
2813                  $simpleName = $1;                  $simpleName = $1;
2814              }              }
2815              Trace("Simple directory name for $dir is $simpleName.") if T(4);              Trace("Simple directory name for $dir is $simpleName.") if T(File => 4);
2816              # Search for a match.              # Search for a match.
2817              my $match = 0;              my $match = 0;
2818              my $i;              my $i;
# Line 2794  Line 2837 
2837                      Trace("Checking member $thisMem.") if T(4);                      Trace("Checking member $thisMem.") if T(4);
2838                      $lookCount++;                      $lookCount++;
2839                      if ($lookCount % 1000 == 0) {                      if ($lookCount % 1000 == 0) {
2840                          Trace("$lookCount members examined. Current is $thisMem. Mask is $traceMask") if T(3);                          Trace("$lookCount members examined. Current is $thisMem. Mask is $traceMask") if T(File => 3);
2841                      }                      }
2842                      # Fix the group.                      # Fix the group.
2843                      chown -1, $gid, $thisMem;                      chown -1, $gid, $thisMem;
# Line 2821  Line 2864 
2864                  }                  }
2865              }              }
2866          }          }
2867          Trace("$lookCount files and directories processed, $fixCount fixed.") if T(2);          Trace("$lookCount files and directories processed, $fixCount fixed.") if T(File => 2);
2868      };      };
2869      # Check for an error.      # Check for an error.
2870      if ($@) {      if ($@) {
# Line 2924  Line 2967 
2967      my ($handle) = @_;      my ($handle) = @_;
2968      # Declare the return variable.      # Declare the return variable.
2969      my @retVal = ();      my @retVal = ();
2970        Trace("File position is " . tell($handle) . ". EOF flag is " . eof($handle) . ".") if T(File => 4);
2971      # Read from the file.      # Read from the file.
2972      my $line = <$handle>;      my $line = <$handle>;
2973      # Only proceed if we found something.      # Only proceed if we found something.
2974      if (defined $line) {      if (defined $line) {
2975          # Remove the new-line.          # Remove the new-line.
2976          chomp $line;          chomp $line;
2977            Trace("Line read: $line") if T(File => 4);
2978          # If the line is empty, return a single empty string; otherwise, parse          # If the line is empty, return a single empty string; otherwise, parse
2979          # it into fields.          # it into fields.
2980          if ($line eq "") {          if ($line eq "") {
# Line 2937  Line 2982 
2982          } else {          } else {
2983              push @retVal, split /\t/,$line;              push @retVal, split /\t/,$line;
2984          }          }
2985        } else {
2986            # Trace the reason the read failed.
2987            Trace("End of file: $!") if T(File => 3);
2988      }      }
2989      # Return the result.      # Return the result.
2990      return @retVal;      return @retVal;

Legend:
Removed from v.1.73  
changed lines
  Added in v.1.77

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3