[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.6, Mon Mar 7 02:01:51 2005 UTC revision 1.13, Tue Jun 28 21:26:24 2005 UTC
# Line 2  Line 2 
2    
3          require Exporter;          require Exporter;
4          @ISA = ('Exporter');          @ISA = ('Exporter');
5          @EXPORT = qw(Trace T TSetup QTrace Confess Cluck Min Max Assert);      @EXPORT = qw(Trace T TSetup QTrace Confess Cluck Min Max Assert Open OpenDir);
6          @EXPORT_OK = qw(GetFile GetOptions Merge MergeOptions ParseCommand ParseRecord UnEscape);      @EXPORT_OK = qw(GetFile GetOptions Merge MergeOptions ParseCommand ParseRecord UnEscape Escape);
7          use strict;          use strict;
8          use Carp qw(longmess croak);          use Carp qw(longmess croak);
9          use CGI;          use CGI;
10        use FIG_Config;
11        use PageBuilder;
12    
13  =head1 Tracing and Debugging Helpers  =head1 Tracing and Debugging Helpers
14    
# Line 18  Line 20 
20  has a list of categories and a single trace level set by the B<TSetup> method. Only messages whose trace  has a list of categories and a single trace level set by the B<TSetup> method. Only messages whose trace
21  level is less than or equal to this package's trace level and whose category is activated will  level is less than or equal to this package's trace level and whose category is activated will
22  be written. Thus, a higher trace level on a message indicates that the message  be written. Thus, a higher trace level on a message indicates that the message
23  is less likely to be seen. A higher trace level passed to B<Setup> means more trace messages will  is less likely to be seen. A higher trace level passed to B<TSetup> means more trace messages will
24  appear. To generate a trace message, use the following syntax.  appear. To generate a trace message, use the following syntax.
25    
26  C<< Trace($message) if T(errors => 4); >>  C<< Trace($message) if T(errors => 4); >>
# Line 36  Line 38 
38    
39  C<< Trace($message) if T(2); >>  C<< Trace($message) if T(2); >>
40    
41  To set up tracing, you call the C</Setup> method. The method takes as input a trace level, a list  To set up tracing, you call the L</TSetup> method. The method takes as input a trace level, a list
42  of category names, and a set of options. The trace level and list of category names are  of category names, and a set of options. The trace level and list of category names are
43  specified as a space-delimited string. Thus  specified as a space-delimited string. Thus
44    
45  C<< TSetup('3 errors Sprout ERDB', 'HTML'); >>  C<< TSetup('3 errors Sprout ERDB', 'HTML'); >>
46    
47  sets the trace level to 3, activated the C<errors>, C<Sprout>, and C<ERDB> categories, and  sets the trace level to 3, activates the C<errors>, C<Sprout>, and C<ERDB> categories, and
48  specifies that messages should be output as HTML paragraphs. The idea is to make it easier to  specifies that messages should be output as HTML paragraphs.
49  input tracing configuration on a web form.  
50    To turn on tracing for ALL categories, use an asterisk. The call below sets every category to
51    level 3 and writes the output to the standard error output. This sort of thing might be
52    useful in a CGI environment.
53    
54    C<< TSetup('3 *', 'WARN'); >>
55    
56  In addition to HTML and file output for trace messages, you can specify that the trace messages  In addition to HTML and file output for trace messages, you can specify that the trace messages
57  be queued. The messages can then be retrieved by calling the L</QTrace> method. This approach  be queued. The messages can then be retrieved by calling the L</QTrace> method. This approach
# Line 59  Line 66 
66  Thus, debugging information is available and easily retrieved even when the application is  Thus, debugging information is available and easily retrieved even when the application is
67  being used out in the field.  being used out in the field.
68    
69    There is no hard and fast rule on how to use trace levels. The following is therefore only
70    a suggestion.
71    
72    =over 4
73    
74    =item 0 Error
75    
76    Message indicates an error that may lead to incorrect results or that has stopped the
77    application entirely.
78    
79    =item 1 Warning
80    
81    Message indicates something that is unexpected but that probably did not interfere
82    with program execution.
83    
84    =item 2 Notice
85    
86    Message indicates the beginning or end of a major task.
87    
88    =item 3 Information
89    
90    Message indicates a subtask. In the FIG system, a subtask generally relates to a single
91    genome. This would be a big loop that is not expected to execute more than 500 times or so.
92    
93    =item 4 Detail
94    
95    Message indicates a low-level loop iteration.
96    
97    =back
98    
99  =cut  =cut
100    
101  # Declare the configuration variables.  # Declare the configuration variables.
102    
103  my $Destination = "NONE";       # Description of where to send the trace output.  my $Destination = "NONE";       # Description of where to send the trace output.
104    my $TeeFlag = 0;            # TRUE if output is going to a file and to the
105                                # standard output
106  my %Categories = ( main => 1 );  my %Categories = ( main => 1 );
107                                                          # hash of active category names                                                          # hash of active category names
108  my $TraceLevel = 0;                     # trace level; a higher trace level produces more  my $TraceLevel = 0;                     # trace level; a higher trace level produces more
109                                                          # messages                                                          # messages
110  my @Queue = ();                         # queued list of trace messages.  my @Queue = ();                         # queued list of trace messages.
111    my $LastCategory = "main";  # name of the last category interrogated
112    my $SetupCount = 0;         # number of times TSetup called
113    my $AllTrace = 0;           # TRUE if we are tracing all categories.
114    
115  =head2 Public Methods  =head2 Public Methods
116    
# Line 90  Line 132 
132    
133  The destination for the trace output. To send the trace output to a file, specify the file  The destination for the trace output. To send the trace output to a file, specify the file
134  name preceded by a ">" symbol. If a double symbol is used (">>"), then the data is appended  name preceded by a ">" symbol. If a double symbol is used (">>"), then the data is appended
135  to the file. Otherwise the file is cleared before tracing begins. In addition to sending  to the file. Otherwise the file is cleared before tracing begins. Precede the first ">"
136  the trace messages to a file, you can specify a special destination. C<HTML> will cause  symbol with a C<+> to echo output to a file AND to the standard output. In addition to
137  tracing to the standard output with each line formatted as an HTML paragraph. C<TEXT>  sending the trace messages to a file, you can specify a special destination. C<HTML> will
138    cause tracing to the standard output with each line formatted as an HTML paragraph. C<TEXT>
139  will cause tracing to the standard output as ordinary text. C<ERROR> will cause trace  will cause tracing to the standard output as ordinary text. C<ERROR> will cause trace
140  messages to be sent to the standard error output as ordinary text. C<QUEUE> will cause trace  messages to be sent to the standard error output as ordinary text. C<QUEUE> will cause trace
141  messages to be stored in a queue for later retrieval by the L</QTrace> method. C<WARN> will  messages to be stored in a queue for later retrieval by the L</QTrace> method. C<WARN> will
# Line 110  Line 153 
153          my @categoryData = split /\s+/, $categoryList;          my @categoryData = split /\s+/, $categoryList;
154          # Extract the trace level.          # Extract the trace level.
155          $TraceLevel = shift @categoryData;          $TraceLevel = shift @categoryData;
156          # Build the category hash.      # Presume category-based tracing until we learn otherwise.
157        $AllTrace = 0;
158        # Build the category hash. Note that if we find a "*", we turn on non-category
159        # tracing.
160          for my $category (@categoryData) {          for my $category (@categoryData) {
161                  $Categories{$category} = 1;          if ($category eq '*') {
162                $AllTrace = 1;
163            } else {
164                $Categories{lc $category} = 1;
165            }
166          }          }
167          # Now we need to process the destination information. The most important special          # Now we need to process the destination information. The most important special
168          # case is the single ">", which requires we clear the file first. After doing      # cases are the single ">", which requires we clear the file first, and the
169          # so, we tack on another ">" sign so that future trace messages are appended.      # "+" prefix which indicates a double echo.
170        if ($target =~ m/^\+?>>?/) {
171            if ($target =~ m/^\+/) {
172                $TeeFlag = 1;
173                $target = substr($target, 1);
174            }
175          if ($target =~ m/^>[^>]/) {          if ($target =~ m/^>[^>]/) {
176                  open TRACEFILE, $target;                  open TRACEFILE, $target;
177                  print TRACEFILE Now() . " Tracing initialized.\n";                  print TRACEFILE Now() . " Tracing initialized.\n";
178                  close TRACEFILE;                  close TRACEFILE;
179                  $Destination = ">$target";                  $Destination = ">$target";
180          } else {          } else {
181                $Destination = $target;
182            }
183        } else {
184                  $Destination = uc($target);                  $Destination = uc($target);
185          }          }
186        # Increment the setup counter.
187        $SetupCount++;
188    }
189    
190    =head3 Setups
191    
192    C<< my $count = Tracer::Setups(); >>
193    
194    Return the number of times L</TSetup> has been called.
195    
196    This method allows for the creation of conditional tracing setups where, for example, we
197    may want to set up tracing if nobody else has done it before us.
198    
199    =cut
200    
201    sub Setups {
202        return $SetupCount;
203    }
204    
205    =head3 Open
206    
207    C<< my $handle = Open($fileHandle, $fileSpec, $message); >>
208    
209    Open a file.
210    
211    The I<$fileSpec> is essentially the second argument of the PERL C<open>
212    function. The mode is specified using Unix-like shell information. So, for
213    example,
214    
215        Open(\*LOGFILE, '>>/usr/spool/news/twitlog', "Could not open twit log.");
216    
217    would open for output appended to the specified file, and
218    
219        Open(\*DATASTREAM, "| sort -u >$outputFile", "Could not open $outputFile.");
220    
221    would open a pipe that sorts the records written and removes duplicates. Note
222    the use of file handle syntax in the Open call. To use anonymous file handles,
223    code as follows.
224    
225        my $logFile = Open(undef, '>>/usr/spool/news/twitlog', "Could not open twit log.");
226    
227    The I<$message> parameter is used if the open fails. If it is set to C<0>, then
228    the open returns TRUE if successful and FALSE if an error occurred. Otherwise, a
229    failed open will throw an exception and the third parameter will be used to construct
230    an error message. If the parameter is omitted, a standard message is constructed
231    using the file spec.
232    
233        Could not open "/usr/spool/news/twitlog"
234    
235    Note that the mode characters are automatically cleaned from the file name.
236    The actual error message from the file system will be captured and appended to the
237    message in any case.
238    
239        Could not open "/usr/spool/news/twitlog": file not found.
240    
241    In some versions of PERL the only error message we get is a number, which
242    corresponds to the C++ C<errno> value.
243    
244        Could not open "/usr/spool/news/twitlog": 6.
245    
246    =over 4
247    
248    =item fileHandle
249    
250    File handle. If this parameter is C<undef>, a file handle will be generated
251    and returned as the value of this method.
252    
253    =item fileSpec
254    
255    File name and mode, as per the PERL C<open> function.
256    
257    =item message (optional)
258    
259    Error message to use if the open fails. If omitted, a standard error message
260    will be generated. In either case, the error information from the file system
261    is appended to the message. To specify a conditional open that does not throw
262    an error if it fails, use C<0>.
263    
264    =item RETURN
265    
266    Returns the name of the file handle assigned to the file, or C<undef> if the
267    open failed.
268    
269    =back
270    
271    =cut
272    
273    sub Open {
274        # Get the parameters.
275        my ($fileHandle, $fileSpec, $message) = @_;
276        # Attempt to open the file.
277        my $rv = open $fileHandle, $fileSpec;
278        # If the open failed, generate an error message.
279        if (! $rv) {
280            # Save the system error message.
281            my $sysMessage = $!;
282            # See if we need a default message.
283            if (!$message) {
284                # Clean any obvious mode characters and leading spaces from the
285                # filename.
286                my ($fileName) = FindNamePart($fileSpec);
287                $message = "Could not open \"$fileName\"";
288            }
289            # Terminate with an error using the supplied message and the
290            # error message from the file system.
291            Confess("$message: $!");
292        }
293        # Return the file handle.
294        return $fileHandle;
295    }
296    
297    =head3 FindNamePart
298    
299    C<< my ($fileName, $start, $len) = Tracer::FindNamePart($fileSpec); >>
300    
301    Extract the portion of a file specification that contains the file name.
302    
303    A file specification is the string passed to an C<open> call. It specifies the file
304    mode and name. In a truly complex situation, it can specify a pipe sequence. This
305    method assumes that the file name is whatever follows the first angle bracket
306    sequence.  So, for example, in the following strings the file name is
307    C</usr/fig/myfile.txt>.
308    
309        >>/usr/fig/myfile.txt
310        </usr/fig/myfile.txt
311        | sort -u > /usr/fig/myfile.txt
312    
313    If the method cannot find a file name using its normal methods, it will return the
314    whole incoming string.
315    
316    =over 4
317    
318    =item fileSpec
319    
320    File specification string from which the file name is to be extracted.
321    
322    =item RETURN
323    
324    Returns a three-element list. The first element contains the file name portion of
325    the specified string, or the whole string if a file name cannot be found via normal
326    methods. The second element contains the start position of the file name portion and
327    the third element contains the length.
328    
329    =back
330    
331    =cut
332    #: Return Type $;
333    sub FindNamePart {
334        # Get the parameters.
335        my ($fileSpec) = @_;
336        # Default to the whole input string.
337        my ($retVal, $pos, $len) = ($fileSpec, 0, length $fileSpec);
338        # Parse out the file name if we can.
339        if ($fileSpec =~ m/(<|>>?)(.+?)(\s*)$/) {
340            $retVal = $2;
341            $len = length $retVal;
342            $pos = (length $fileSpec) - (length $3) - $len;
343        }
344        # Return the result.
345        return ($retVal, $pos, $len);
346    }
347    
348    =head3 OpenDir
349    
350    C<< my @files = OpenDir($dirName, $filtered); >>
351    
352    Open a directory and return all the file names. This function essentially performs
353    the functions of an C<opendir> and C<readdir>. If the I<$filtered> parameter is
354    set to TRUE, all filenames beginning with a period (C<.>) will be filtered out of
355    the return list. If the directory does not open, an exception is thrown. So,
356    for example,
357    
358        my @files = OpenDir("/Volumes/fig/contigs", 1);
359    
360    is effectively the same as
361    
362        opendir(TMP, "/Volumes/fig/contigs") || Confess("Could not open /Volumes/fig/contigs.");
363        my @files = grep { $_ !~ /^\./ } readdir(TMP);
364    
365    Similarly, the following code
366    
367        my @files = grep { $_ =~ /^\d/ } OpenDir("/Volumes/fig/orgs");
368    
369    Returns the names of all files in C</Volumes/fig/orgs> that begin with digits and
370    automatically throws an error if the directory fails to open.
371    
372    =over 4
373    
374    =item dirName
375    
376    Name of the directory to open.
377    
378    =item filtered
379    
380    TRUE if files whose names begin with a period (C<.>) should be automatically removed
381    from the list, else FALSE.
382    
383    =back
384    
385    =cut
386    #: Return Type @;
387    sub OpenDir {
388        # Get the parameters.
389        my ($dirName, $filtered) = @_;
390        # Declare the return variable.
391        my @retVal;
392        # Open the directory.
393        if (opendir(my $dirHandle, $dirName)) {
394            # The directory opened successfully. Get the appropriate list according to the
395            # strictures of the filter parameter.
396            if ($filtered) {
397                @retVal = grep { $_ !~ /^\./ } readdir $dirHandle;
398            } else {
399                @retVal = readdir $dirHandle;
400            }
401        } else {
402            # Here the directory would not open.
403            Confess("Could not open directory $dirName.");
404        }
405        # Return the result.
406        return @retVal;
407  }  }
408    
409  =head3 SetLevel  =head3 SetLevel
# Line 370  Line 649 
649          my ($message) = @_;          my ($message) = @_;
650          # Get the timestamp.          # Get the timestamp.
651          my $timeStamp = Now();          my $timeStamp = Now();
652          # Format the message.      # Format the message. Note we strip off any line terminators at the end.
653          my $formatted = "$timeStamp $message";      my $formatted = "$timeStamp <$LastCategory>: " . Strip($message);
654          # Process according to the destination.          # Process according to the destination.
655          if ($Destination eq "TEXT") {          if ($Destination eq "TEXT") {
656                  # Write the message to the standard output.                  # Write the message to the standard output.
# Line 394  Line 673 
673                  open TRACING, $Destination;                  open TRACING, $Destination;
674                  print TRACING "$formatted\n";                  print TRACING "$formatted\n";
675                  close TRACING;                  close TRACING;
676            # If the Tee flag is on, echo it to the standard output.
677            if ($TeeFlag) {
678                print "$formatted\n";
679            }
680          }          }
681  }  }
682    
# Line 436  Line 719 
719                  my ($category, $traceLevel) = @_;                  my ($category, $traceLevel) = @_;
720                  if (!defined $traceLevel) {                  if (!defined $traceLevel) {
721                          # Here we have no category, so we need to get the calling package.                          # Here we have no category, so we need to get the calling package.
722                # The calling package is normally the first parameter. If it is
723                # omitted, the first parameter will be the tracelevel. So, the
724                # first thing we do is shift the so-called category into the
725                # $traceLevel variable where it belongs.
726                          $traceLevel = $category;                          $traceLevel = $category;
727                          my ($package, $fileName, $line) = caller;                          my ($package, $fileName, $line) = caller;
728              # If there is no calling package, we default to "main".              # If there is no calling package, we default to "main".
# Line 445  Line 732 
732                                  $category = $package;                                  $category = $package;
733                          }                          }
734                  }                  }
735                  # Use the package and tracelevel to compute the result.          # Save the category name.
736                  $retVal = ($traceLevel <= $TraceLevel && exists $Categories{$category});          $LastCategory = $category;
737            # Convert it to lower case before we hash it.
738            $category = lc $category;
739            # Use the category and tracelevel to compute the result.
740            $retVal = ($traceLevel <= $TraceLevel && ($AllTrace || exists $Categories{$category}));
741      }      }
742          # Return the computed result.          # Return the computed result.
743      return $retVal;      return $retVal;
# Line 528  Line 819 
819          return ($optionTable, @retVal);          return ($optionTable, @retVal);
820  }  }
821    
822    =head3 Escape
823    
824    C<< my $codedString = Tracer::Escape($realString); >>
825    
826    Escape a string for use in a command length. Spaces will be replaced by C<\b>,
827    tabs replaced by C<\t>, new-lines replaced by C<\n>, and backslashes will be
828    doubled. The effect is to exactly reverse the effect of L</UnEscape>.
829    
830    =over 4
831    
832    =item realString
833    
834    String to escape.
835    
836    =item RETURN
837    
838    Escaped equivalent of the real string.
839    
840    =back
841    
842    =cut
843    
844    sub Escape {
845        # Get the parameter.
846        my ($realString) = @_;
847        # Initialize the return variable.
848        my $retVal = "";
849        # Loop through the parameter string, looking for sequences to escape.
850        while (length $realString > 0) {
851            # Look for the first sequence to escape.
852            if ($realString =~ /^(.*?)([ \n\t\\])/) {
853                # Here we found it. The text preceding the sequence is in $1. The sequence
854                # itself is in $2. First, move the clear text to the return variable.
855                $retVal .= $1;
856                $realString = substr $realString, (length $2 + length $1);
857                # Encode the escape sequence.
858                my $char = $2;
859                $char =~ tr/ \t\n/btn/;
860                $retVal .= "\\" . $char;
861            } else {
862                # Here there are no more escape sequences. The rest of the string is
863                # transferred unmodified.
864                $retVal .= $realString;
865                $realString = "";
866            }
867        }
868        # Return the result.
869        return $retVal;
870    }
871    
872  =head3 UnEscape  =head3 UnEscape
873    
874  C<< my $realString = Tracer::UnEscape($codedString); >>  C<< my $realString = Tracer::UnEscape($codedString); >>
# Line 555  Line 896 
896          my ($codedString) = @_;          my ($codedString) = @_;
897          # Initialize the return variable.          # Initialize the return variable.
898          my $retVal = "";          my $retVal = "";
899        # Only proceed if the incoming string is nonempty.
900        if (defined $codedString) {
901          # Loop through the parameter string, looking for escape sequences. We can't do          # Loop through the parameter string, looking for escape sequences. We can't do
902          # translating because it causes problems with the escaped slash. ("\\b" becomes          # translating because it causes problems with the escaped slash. ("\\b" becomes
903          # "\ " no matter what we do.)          # "\ " no matter what we do.)
# Line 576  Line 919 
919                          $codedString = "";                          $codedString = "";
920                  }                  }
921          }          }
922        }
923          # Return the result.          # Return the result.
924          return $retVal;          return $retVal;
925  }  }
# Line 705  Line 1049 
1049                  # If we had an error, trace it. We will automatically return a null value.                  # If we had an error, trace it. We will automatically return a null value.
1050                  Trace("Could not open \"$fileName\" for input.") if T(0);                  Trace("Could not open \"$fileName\" for input.") if T(0);
1051          } else {          } else {
1052                  # Read the whole file into the return variable, stripping off an terminator          # Read the whole file into the return variable, stripping off any terminator
1053          # characters.          # characters.
1054          my $lineCount = 0;          my $lineCount = 0;
1055                  while (my $line = <INPUTFILE>) {                  while (my $line = <INPUTFILE>) {
1056              $lineCount++;              $lineCount++;
1057              $line =~ s/(\r|\n)+$//g;              $line = Strip($line);
1058                          push @retVal, $line;                          push @retVal, $line;
1059                  }                  }
1060                  # Close it.                  # Close it.
1061                  close INPUTFILE;                  close INPUTFILE;
1062          my $actualLines = @retVal;          my $actualLines = @retVal;
         Trace("$lineCount lines read from $fileName. $actualLines processed.") if T(0);  
1063          }          }
1064          # Return the file's contents in the desired format.          # Return the file's contents in the desired format.
1065      if (wantarray) {      if (wantarray) {
# Line 958  Line 1301 
1301      }      }
1302  }  }
1303    
1304    =head3 DebugMode
1305    
1306    C<< if (Tracer::DebugMode) { ...code... } >>
1307    
1308    Return TRUE if debug mode has been turned on in FIG_Config, else output
1309    an error page and return FALSE.
1310    
1311    Certain CGI scripts are too dangerous to exist in the production
1312    environment. This method provides a simple way to prevent them
1313    from working unless they are explicitly turned on in the configuration
1314    file by setting C<$FIG_Config::debug_mode> to 1. If debugging mode
1315    is not turned on, an error web page will be output.
1316    
1317    =cut
1318    
1319    sub DebugMode {
1320        # Declare the return variable.
1321        my $retVal;
1322        # Check the debug configuration.
1323        if ($FIG_Config::debug_mode) {
1324            $retVal = 1;
1325        } else {
1326            # Here debug mode is off, so we generate an error page.
1327            my $pageString = PageBuilder::Build("<Html/ErrorPage.html", {}, "Html");
1328            print $pageString;
1329        }
1330        # Return the determination indicator.
1331        return $retVal;
1332    }
1333    
1334    =head3 Strip
1335    
1336    C<< my $string = Tracer::Strip($line); >>
1337    
1338    Strip all line terminators off a string. This is necessary when dealing with files
1339    that may have been transferred back and forth several times among different
1340    operating environments.
1341    
1342    =over 4
1343    
1344    =item line
1345    
1346    Line of text to be stripped.
1347    
1348    =item RETURN
1349    
1350    The same line of text with all the line-ending characters chopped from the end.
1351    
1352    =back
1353    
1354    =cut
1355    
1356    sub Strip {
1357        # Get a copy of the parameter string.
1358        my ($string) = @_;
1359        my $retVal = $string;
1360        # Strip the line terminator characters.
1361        $retVal =~ s/(\r|\n)+$//g;
1362        # Return the result.
1363        return $retVal;
1364    }
1365    
1366    =head3 Pad
1367    
1368    C<< my $paddedString = Tracer::Pad($string, $len, $left, $padChar); >>
1369    
1370    Pad a string to a specified length. The pad character will be a
1371    space, and the padding will be on the right side unless specified
1372    in the third parameter.
1373    
1374    =over 4
1375    
1376    =item string
1377    
1378    String to be padded.
1379    
1380    =item len
1381    
1382    Desired length of the padded string.
1383    
1384    =item left (optional)
1385    
1386    TRUE if the string is to be left-padded; otherwise it will be padded on the right.
1387    
1388    =item padChar (optional)
1389    
1390    =item RETURN
1391    
1392    Returns a copy of the original string with the spaces added to the specified end so
1393    that it achieves the desired length.
1394    
1395    =back
1396    
1397    =cut
1398    
1399    sub Pad {
1400        # Get the parameters.
1401        my ($string, $len, $left, $padChar) = @_;
1402        # Compute the padding character.
1403        if (! defined $padChar) {
1404            $padChar = " ";
1405        }
1406        # Compute the number of spaces needed.
1407        my $needed = $len - length $string;
1408        # Copy the string into the return variable.
1409        my $retVal = $string;
1410        # Only proceed if padding is needed.
1411        if ($needed > 0) {
1412            # Create the pad string.
1413            my $pad = $padChar x $needed;
1414            # Affix it to the return value.
1415            if ($left) {
1416                $retVal = $pad . $retVal;
1417            } else {
1418                $retVal .= $pad;
1419            }
1420        }
1421        # Return the result.
1422        return $retVal;
1423    }
1424    
1425  1;  1;

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.13

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3