[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.74, Thu Oct 5 21:51:09 2006 UTC revision 1.79, Thu Nov 9 21:12:46 2006 UTC
# Line 950  Line 950 
950  Returns a PERL time, that is, a number of seconds since the epoch, or C<undef> if  Returns a PERL time, that is, a number of seconds since the epoch, or C<undef> if
951  the time string is invalid.  the time string is invalid.
952    
953    =back
954    
955  =cut  =cut
956    
957  sub ParseTraceDate {  sub ParseTraceDate {
# Line 959  Line 961 
961      my $retVal;      my $retVal;
962      # Parse the date.      # Parse the date.
963      if ($dateString =~ m#(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+)#) {      if ($dateString =~ m#(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+)#) {
964          # Create a time object.          # Create a time object. Note we need to convert the day, month,
965          $retVal = timelocal($6, $5, $4, $3, $2, $1);          # and year to a different base. Years count from 1900, and
966            # the internal month value is relocated to January = 0.
967            $retVal = timelocal($6, $5, $4, $2, $1 - 1, $3 - 1900);
968      }      }
969      # Return the result.      # Return the result.
970      return $retVal;      return $retVal;
# Line 1633  Line 1637 
1637      # Close it.      # Close it.
1638      close $handle;      close $handle;
1639      my $actualLines = @retVal;      my $actualLines = @retVal;
1640        Trace("$actualLines lines read from file $fileName.") if T(File => 2);
1641      # Return the file's contents in the desired format.      # Return the file's contents in the desired format.
1642      if (wantarray) {      if (wantarray) {
1643          return @retVal;          return @retVal;
# Line 1668  Line 1673 
1673      my ($fileName, $lines) = @_;      my ($fileName, $lines) = @_;
1674      # Open the output file.      # Open the output file.
1675      my $handle = Open(undef, ">$fileName");      my $handle = Open(undef, ">$fileName");
1676        # Count the lines written.
1677      if (ref $lines ne 'ARRAY') {      if (ref $lines ne 'ARRAY') {
1678          # Here we have a scalar, so we write it raw.          # Here we have a scalar, so we write it raw.
1679          print $handle $lines;          print $handle $lines;
1680            Trace("Scalar put to file $fileName.") if T(File => 3);
1681      } else {      } else {
1682          # Write the lines one at a time.          # Write the lines one at a time.
1683            my $count = 0;
1684          for my $line (@{$lines}) {          for my $line (@{$lines}) {
1685              print $handle "$line\n";              print $handle "$line\n";
1686                $count++;
1687          }          }
1688            Trace("$count lines put to file $fileName.") if T(File => 3);
1689      }      }
1690      # Close the output file.      # Close the output file.
1691      close $handle;      close $handle;
# Line 2581  Line 2591 
2591  sub Insure {  sub Insure {
2592      my ($dirName) = @_;      my ($dirName) = @_;
2593      if (! -d $dirName) {      if (! -d $dirName) {
2594          Trace("Creating $dirName directory.") if T(2);          Trace("Creating $dirName directory.") if T(File => 2);
2595          eval { mkpath $dirName; };          eval { mkpath $dirName; };
2596          if ($@) {          if ($@) {
2597              Confess("Error creating $dirName: $@");              Confess("Error creating $dirName: $@");
# Line 2610  Line 2620 
2620      if (! -d $dirName) {      if (! -d $dirName) {
2621          Confess("Cannot change to directory $dirName: no such directory.");          Confess("Cannot change to directory $dirName: no such directory.");
2622      } else {      } else {
2623          Trace("Changing to directory $dirName.") if T(4);          Trace("Changing to directory $dirName.") if T(File => 4);
2624          my $okFlag = chdir $dirName;          my $okFlag = chdir $dirName;
2625          if (! $okFlag) {          if (! $okFlag) {
2626              Confess("Error switching to directory $dirName.");              Confess("Error switching to directory $dirName.");
# Line 2789  Line 2799 
2799          my $gid = getgrnam($group);          my $gid = getgrnam($group);
2800          # Get the mask for tracing.          # Get the mask for tracing.
2801          my $traceMask = sprintf("%04o", $mask) . "($mask)";          my $traceMask = sprintf("%04o", $mask) . "($mask)";
2802          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);
2803          my $fixCount = 0;          my $fixCount = 0;
2804          my $lookCount = 0;          my $lookCount = 0;
2805          # @dirs will be a stack of directories to be processed.          # @dirs will be a stack of directories to be processed.
# Line 2804  Line 2814 
2814              if ($dir =~ m!/([^/]+)$!) {              if ($dir =~ m!/([^/]+)$!) {
2815                  $simpleName = $1;                  $simpleName = $1;
2816              }              }
2817              Trace("Simple directory name for $dir is $simpleName.") if T(4);              Trace("Simple directory name for $dir is $simpleName.") if T(File => 4);
2818              # Search for a match.              # Search for a match.
2819              my $match = 0;              my $match = 0;
2820              my $i;              my $i;
# Line 2829  Line 2839 
2839                      Trace("Checking member $thisMem.") if T(4);                      Trace("Checking member $thisMem.") if T(4);
2840                      $lookCount++;                      $lookCount++;
2841                      if ($lookCount % 1000 == 0) {                      if ($lookCount % 1000 == 0) {
2842                          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);
2843                      }                      }
2844                      # Fix the group.                      # Fix the group.
2845                      chown -1, $gid, $thisMem;                      chown -1, $gid, $thisMem;
# Line 2856  Line 2866 
2866                  }                  }
2867              }              }
2868          }          }
2869          Trace("$lookCount files and directories processed, $fixCount fixed.") if T(2);          Trace("$lookCount files and directories processed, $fixCount fixed.") if T(File => 2);
2870      };      };
2871      # Check for an error.      # Check for an error.
2872      if ($@) {      if ($@) {
# Line 2959  Line 2969 
2969      my ($handle) = @_;      my ($handle) = @_;
2970      # Declare the return variable.      # Declare the return variable.
2971      my @retVal = ();      my @retVal = ();
2972        Trace("File position is " . tell($handle) . ". EOF flag is " . eof($handle) . ".") if T(File => 4);
2973      # Read from the file.      # Read from the file.
2974      my $line = <$handle>;      my $line = <$handle>;
2975      # Only proceed if we found something.      # Only proceed if we found something.
2976      if (defined $line) {      if (defined $line) {
2977          # Remove the new-line.          # Remove the new-line.
2978          chomp $line;          chomp $line;
2979            Trace("Line read: $line") if T(File => 4);
2980          # If the line is empty, return a single empty string; otherwise, parse          # If the line is empty, return a single empty string; otherwise, parse
2981          # it into fields.          # it into fields.
2982          if ($line eq "") {          if ($line eq "") {
# Line 2972  Line 2984 
2984          } else {          } else {
2985              push @retVal, split /\t/,$line;              push @retVal, split /\t/,$line;
2986          }          }
2987        } else {
2988            # Trace the reason the read failed.
2989            Trace("End of file: $!") if T(File => 3);
2990      }      }
2991      # Return the result.      # Return the result.
2992      return @retVal;      return @retVal;
# Line 3017  Line 3032 
3032    
3033  would return  would return
3034    
3035      form.cgi?type=1&string=%22high%20pass%22%20or%20highway      form.cgi?type=1;string=%22high%20pass%22%20or%20highway
3036    
3037  =over 4  =over 4
3038    
# Line 3047  Line 3062 
3062      my @parmList = map { "$_=" . uri_escape($parameters{$_}) } keys %parameters;      my @parmList = map { "$_=" . uri_escape($parameters{$_}) } keys %parameters;
3063      # If the list is nonempty, tack it on.      # If the list is nonempty, tack it on.
3064      if (@parmList) {      if (@parmList) {
3065          $retVal .= "?" . join("&", @parmList);          $retVal .= "?" . join(";", @parmList);
3066        }
3067        # Return the result.
3068        return $retVal;
3069    }
3070    
3071    =head3 ApplyURL
3072    
3073    C<< Tracer::ApplyURL($table, $target, $url); >>
3074    
3075    Run through a two-dimensional table (or more accurately, a list of lists), converting the
3076    I<$target> column to HTML text having a hyperlink to a URL in the I<$url> column. The
3077    URL column will be deleted by this process and the target column will be HTML-escaped.
3078    
3079    This provides a simple way to process the results of a database query into something
3080    displayable by combining a URL with text.
3081    
3082    =over 4
3083    
3084    =item table
3085    
3086    Reference to a list of lists. The elements in the containing list will be updated by
3087    this method.
3088    
3089    =item target
3090    
3091    The index of the column to be converted into HTML.
3092    
3093    =item url
3094    
3095    The index of the column containing the URL. Note that the URL must have a recognizable
3096    C<http:> at the beginning.
3097    
3098    =back
3099    
3100    =cut
3101    
3102    sub ApplyURL {
3103        # Get the parameters.
3104        my ($table, $target, $url) = @_;
3105        # Loop through the table.
3106        for my $row (@{$table}) {
3107            # Apply the URL to the target cell.
3108            $row->[$target] = CombineURL($row->[$target], $row->[$url]);
3109            # Delete the URL from the row.
3110            delete $row->[$url];
3111        }
3112    }
3113    
3114    =head3 CombineURL
3115    
3116    C<< my $combinedHtml = Tracer::CombineURL($text, $url); >>
3117    
3118    This method will convert the specified text into HTML hyperlinked to the specified
3119    URL. The hyperlinking will only take place if the URL looks legitimate: that is, it
3120    is defined and begins with an C<http:> header.
3121    
3122    =over 4
3123    
3124    =item text
3125    
3126    Text to return. This will be HTML-escaped automatically.
3127    
3128    =item url
3129    
3130    A URL to be hyperlinked to the text. If it does not look like a URL, then the text
3131    will be returned without any hyperlinking.
3132    
3133    =item RETURN
3134    
3135    Returns the original text, HTML-escaped, with the URL hyperlinked to it. If the URL
3136    doesn't look right, the HTML-escaped text will be returned without any further
3137    modification.
3138    
3139    =back
3140    
3141    =cut
3142    
3143    sub CombineURL {
3144        # Get the parameters.
3145        my ($text, $url) = @_;
3146        # Declare the return variable.
3147        my $retVal = CGI::escapeHTML($text);
3148        # Verify the URL.
3149        if (defined($url) && $url =~ m!http://!i) {
3150            # It's good, so we apply it to the text.
3151            $retVal = "<a href=\"$url\">$retVal</a>";
3152      }      }
3153      # Return the result.      # Return the result.
3154      return $retVal;      return $retVal;

Legend:
Removed from v.1.74  
changed lines
  Added in v.1.79

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3