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

Annotation of /FigKernelPackages/Tracer.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download) (as text)

1 : olson 1.1 package Tracer;
2 :    
3 :     require Exporter;
4 :     @ISA = ('Exporter');
5 :     @EXPORT = qw(Trace T TSetup QTrace Confess Cluck Assert);
6 :     @EXPORT_OK = qw(GetFile GetOptions Merge MergeOptions ParseCommand ParseRecord UnEscape);
7 :     use strict;
8 :     use Carp qw(longmess croak);
9 :     use CGI;
10 :    
11 :     =head1 Tracing and Debugging Helpers
12 :    
13 :     =head2 Introduction
14 :    
15 :     This package provides simple tracing for debugging and reporting purposes. To use it simply call the
16 :     L</TSetup> method to set the options and call L</Trace> to write out trace messages. Each trace
17 :     message has a I<trace level> and I<category> associated with it. In addition, the tracing package itself
18 :     has a list of categories and a single trace level set by the B<TSetup> method. Only messages whose trace
19 :     level is less than or equal to this package's trace level and whose category is activated will
20 :     be written. Thus, a higher trace level on a message indicates that the message
21 :     is less likely to be seen. A higher trace level passed to B<Setup> means more trace messages will
22 :     appear. To generate a trace message, use the following syntax.
23 :    
24 :     C<< Trace($message) if T(errors => 4); >>
25 :    
26 :     This statement will produce a trace message if the trace level is 4 or more and the C<errors>
27 :     category is active. Note that the special category C<root> is always active, so
28 :    
29 :     C<< Trace($message) if T(root => 4); >>
30 :    
31 :     will trace if the trace level is 4 or more.
32 :    
33 :     If the category name is the same as the package name, all you need is the number. So, if the
34 :     following call is made in the B<Sprout> package, it will appear if the C<Sprout> category is
35 :     active and the trace level is 2 or more.
36 :    
37 :     C<< Trace($message) if T(2); >>
38 :    
39 :     To set up tracing, you call the C</Setup> method. The method takes as input a trace level, a list
40 :     of category names, and a set of options. The trace level and list of category names are
41 :     specified as a space-delimited string. Thus
42 :    
43 :     C<< TSetup('3 errors Sprout ERDB', 'HTML'); >>
44 :    
45 :     sets the trace level to 3, activated the C<errors>, C<Sprout>, and C<ERDB> categories, and
46 :     specifies that messages should be output as HTML paragraphs. The idea is to make it easier to
47 :     input tracing configuration on a web form.
48 :    
49 :     In addition to HTML and file output for trace messages, you can specify that the trace messages
50 :     be queued. The messages can then be retrieved by calling the L</QTrace> method. This approach
51 :     is useful if you are building a web page. Instead of having the trace messages interspersed with
52 :     the page output, they can be gathered together and displayed at the end of the page. This makes
53 :     it easier to debug page formatting problems.
54 :    
55 :     The flexibility of tracing makes it superior to simple use of directives like C<die> and C<warn>.
56 :     Tracer calls can be left in the code with minimal overhead and then turned on only when needed.
57 :     Thus, debugging information is available and easily retrieved even when the application is
58 :     being used out in the field.
59 :    
60 :     =cut
61 :    
62 :     # Declare the configuration variables.
63 :    
64 :     my $Destination = "NONE"; # Description of where to send the trace output.
65 :     my %Categories = ( root => 1 );
66 :     # hash of active category names
67 :     my $TraceLevel = 0; # trace level; a higher trace level produces more
68 :     # messages
69 :     my @Queue = (); # queued list of trace messages.
70 :    
71 :     =head2 Public Methods
72 :    
73 :     =head3 TSetup
74 :    
75 :     C<< TSetup($categoryList, $target); >>
76 :    
77 :     This method is used to specify the trace options. The options are stored as package data
78 :     and interrogated by the L</Trace> and L</T> methods.
79 :    
80 :     =over 4
81 :    
82 :     =item categoryList
83 :    
84 :     A string specifying the trace level and the categories to be traced, separated by spaces.
85 :     The trace level must come first.
86 :    
87 :     =item target
88 :    
89 :     The destination for the trace output. To send the trace output to a file, specify the file
90 :     name preceded by a ">" symbol. If a double symbol is used (">>"), then the data is appended
91 :     to the file. Otherwise the file is cleared before tracing begins. In addition to sending
92 :     the trace messages to a file, you can specify XX special destinations. C<HTML> will
93 :     cause tracing to the standard output with each line formatted as an HTML paragraph. C<TEXT>
94 :     will cause tracing to the standard output as ordinary text. C<QUEUE> will cause trace messages
95 :     to be stored in a queue for later retrieval by the L</QTrace> method. C<NONE> will cause
96 :     tracing to be suppressed.
97 :    
98 :     =back
99 :    
100 :     =cut
101 :    
102 :     sub TSetup {
103 :     # Get the parameters.
104 :     my ($categoryList, $target) = @_;
105 :     # Parse the category list.
106 :     my @categoryData = split /\s+/, $categoryList;
107 :     # Extract the trace level.
108 :     $TraceLevel = shift @categoryData;
109 :     # Build the category hash.
110 :     for my $category (@categoryData) {
111 :     $Categories{$category} = 1;
112 :     }
113 :     # Now we need to process the destination information. The most important special
114 :     # case is the single ">", which requires we clear the file first. After doing
115 :     # so, we tack on another ">" sign so that future trace messages are appended.
116 :     if ($target =~ m/^>[^>]/) {
117 :     open TRACEFILE, $target;
118 :     print TRACEFILE Now() . " Tracing initialized.\n";
119 :     close TRACEFILE;
120 :     $Destination = ">$target";
121 :     } else {
122 :     $Destination = uc($target);
123 :     }
124 :     }
125 :    
126 :     =head3 Now
127 :    
128 :     C<< my $string = Tracer::Now(); >>
129 :    
130 :     Return a displayable time stamp containing the local time.
131 :    
132 :     =cut
133 :    
134 :     sub Now {
135 :     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
136 :     my $retVal = _p2($mon+1) . "/" . _p2($mday) . "/" . ($year + 1900) . " " .
137 :     _p2($hour) . ":" . _p2($min) . ":" . _p2($sec);
138 :     return $retVal;
139 :     }
140 :    
141 :     # Pad a number to 2 digits.
142 :     sub _p2 {
143 :     my ($value) = @_;
144 :     $value = "0$value" if ($value < 10);
145 :     return $value;
146 :     }
147 :    
148 :     =head3 LogErrors
149 :    
150 :     C<< Tracer::LogErrors($fileName); >>
151 :    
152 :     Route the standard error output to a log file.
153 :    
154 :     =over 4
155 :    
156 :     =item fileName
157 :    
158 :     Name of the file to receive the error output.
159 :    
160 :     =back
161 :    
162 :     =cut
163 :    
164 :     sub LogErrors {
165 :     # Get the file name.
166 :     my ($fileName) = @_;
167 :     # Open the file as the standard error output.
168 :     open STDERR, '>', $fileName;
169 :     }
170 :    
171 :     =head3 GetOptions
172 :    
173 :     C<< Tracer::GetOptions(\%defaults, \%options); >>
174 :    
175 :     Merge a specified set of options into a table of defaults. This method takes two hash references
176 :     as input and uses the data from the second to update the first. If the second does not exist,
177 :     there will be no effect. An error will be thrown if one of the entries in the second hash does not
178 :     exist in the first.
179 :    
180 :     Consider the following example.
181 :    
182 :     C<< my $optionTable = GetOptions({ dbType => 'mySQL', trace => 0 }, $options); >>
183 :    
184 :     In this example, the variable B<$options> is expected to contain at most two options-- B<dbType> and
185 :     B<trace>. The default database type is C<mySQL> and the default trace level is C<0>. If the value of
186 :     B<$options> is C<< {dbType => 'Oracle'} >>, then the database type will be changed to C<Oracle> and
187 :     the trace level will remain at 0. If B<$options> is undefined, then the database type and trace level
188 :     will remain C<mySQL> and C<0>. If, on the other hand, B<$options> is defined as
189 :    
190 :     C<< {databaseType => 'Oracle'} >>
191 :    
192 :     an error will occur because the B<databaseType> option does not exist.
193 :    
194 :     =over 4
195 :    
196 :     =item defaults
197 :    
198 :     Table of default option values.
199 :    
200 :     =item options
201 :    
202 :     Table of overrides, if any.
203 :    
204 :     =item RETURN
205 :    
206 :     Returns a reference to the default table passed in as the first parameter.
207 :    
208 :     =back
209 :    
210 :     =cut
211 :    
212 :     sub GetOptions {
213 :     # Get the parameters.
214 :     my ($defaults, $options) = @_;
215 :     # Check for overrides.
216 :     if ($options) {
217 :     # Loop through the overrides.
218 :     while (my ($option, $setting) = each %{$options}) {
219 :     # Insure this override exists.
220 :     if (!exists $defaults->{$option}) {
221 :     croak "Unrecognized option $option encountered.";
222 :     } else {
223 :     # Apply the override.
224 :     $defaults->{$option} = $setting;
225 :     }
226 :     }
227 :     }
228 :     # Return the merged table.
229 :     return $defaults;
230 :     }
231 :    
232 :     =head3 MergeOptions
233 :    
234 :     C<< Tracer::MergeOptions(\%table, \%defaults); >>
235 :    
236 :     Merge default values into a hash table. This method looks at the key-value pairs in the
237 :     second (default) hash, and if a matching key is not found in the first hash, the default
238 :     pair is copied in. The process is similar to L</GetOptions>, but there is no error-
239 :     checking and no return value.
240 :    
241 :     =over 4
242 :    
243 :     =item table
244 :    
245 :     Hash table to be updated with the default values.
246 :    
247 :     =item defaults
248 :    
249 :     Default values to be merged into the first hash table if they are not already present.
250 :    
251 :     =back
252 :    
253 :     =cut
254 :    
255 :     sub MergeOptions {
256 :     # Get the parameters.
257 :     my ($table, $defaults) = @_;
258 :     # Loop through the defaults.
259 :     while (my ($key, $value) = each %{$defaults}) {
260 :     if (!exists $table->{$key}) {
261 :     $table->{$key} = $value;
262 :     }
263 :     }
264 :     }
265 :    
266 :     =head3 Trace
267 :    
268 :     C<< Trace($message); >>
269 :    
270 :     Write a trace message to the target location specified in L</TSetup>. If there has not been
271 :     any prior call to B<TSetup>.
272 :    
273 :     =over 4
274 :    
275 :     =item message
276 :    
277 :     Message to write.
278 :    
279 :     =back
280 :    
281 :     =cut
282 :    
283 :     sub Trace {
284 :     # Get the parameters.
285 :     my ($message) = @_;
286 :     # Get the timestamp.
287 :     my $timeStamp = Now();
288 :     # Process according to the destination.
289 :     if ($Destination eq "TEXT") {
290 :     # Write the message to the standard output.
291 :     print "$timeStamp $message\n";
292 :     } elsif ($Destination eq "QUEUE") {
293 :     # Push the message into the queue.
294 :     push @Queue, "$timeStamp $message";
295 :     } elsif ($Destination eq "HTML") {
296 :     # Convert the message to HTML and write it to the standard output.
297 :     my $escapedMessage = CGI::escapeHTML($message);
298 :     print "<p>$timeStamp $message</p>\n";
299 :     } elsif ($Destination =~ m/^>>/) {
300 :     # Write the trace message to an output file.
301 :     open TRACING, $Destination;
302 :     print TRACING "$timeStamp $message\n";
303 :     close TRACING;
304 :     }
305 :     }
306 :    
307 :     =head3 T
308 :    
309 :     C<< my $switch = T($category, $traceLevel); >>
310 :    
311 :     or
312 :    
313 :     C<< my $switch = T($traceLevel); >>
314 :    
315 :     Return TRUE if the trace level is at or above a specified value and the specified category
316 :     is active, else FALSE. If no category is specified, the caller's package name is used.
317 :    
318 :     =over 4
319 :    
320 :     =item category
321 :    
322 :     Category to which the message belongs. If not specified, the caller's package name is
323 :     used.
324 :    
325 :     =item traceLevel
326 :    
327 :     Relevant tracing level.
328 :    
329 :     =item RETURN
330 :    
331 :     TRUE if a message at the specified trace level would appear in the trace, else FALSE.
332 :    
333 :     =back
334 :    
335 :     =cut
336 :    
337 :     sub T {
338 :     # Declare the return variable.
339 :     my $retVal = 0;
340 :     # Only proceed if tracing is turned on.
341 :     if ($Destination ne "NONE") {
342 :     # Get the parameters.
343 :     my ($category, $traceLevel) = @_;
344 :     if (!defined $traceLevel) {
345 :     # Here we have no category, so we need to get the calling package.
346 :     $traceLevel = $category;
347 :     my ($package, $fileName, $line) = caller;
348 :     # If there is no calling package, we default to "root".
349 :     if (!$package) {
350 :     $category = "root";
351 :     } else {
352 :     $category = $package;
353 :     }
354 :     }
355 :     # Use the package and tracelevel to compute the result.
356 :     $retVal = ($traceLevel <= $TraceLevel && exists $Categories{$category});
357 :     }
358 :     # Return the computed result.
359 :     return $retVal;
360 :     }
361 :    
362 :     =head3 ParseCommand
363 :    
364 :     C<< my ($options, @arguments) = Tracer::ParseCommand(\%optionTable, @inputList); >>
365 :    
366 :     Parse a command line consisting of a list of parameters. The initial parameters may be option
367 :     specifiers of the form C<->I<option> or C<->I<option>C<=>I<value>. The options are stripped
368 :     off and merged into a table of default options. The remainder of the command line is
369 :     returned as a list of positional arguments. For example, consider the following invocation.
370 :    
371 :     C<< my ($options, @arguments) = ParseCommand({ errors => 0, logFile => 'trace.log'}, @words); >>
372 :    
373 :     In this case, the list @words will be treated as a command line. There are two options available,
374 :     B<errors> and B<logFile>. If @words has the following format
375 :    
376 :     C<< -logFile=error.log apple orange rutabaga >>
377 :    
378 :     then at the end of the invocation, C<$options> will be
379 :    
380 :     C<< { errors => 0, logFile => 'error.log' } >>
381 :    
382 :     and C<@arguments> will contain
383 :    
384 :     C<< apple orange rutabaga >>
385 :    
386 :     The parser allows for some escape sequences. See L</UnEscape> for a description. There is no
387 :     support for quote characters.
388 :    
389 :     =over 4
390 :    
391 :     =item optionTable
392 :    
393 :     Table of default options.
394 :    
395 :     =item inputList
396 :    
397 :     List of words on the command line.
398 :    
399 :     =item RETURN
400 :    
401 :     Returns a reference to the option table and a list of the positional arguments.
402 :    
403 :     =back
404 :    
405 :     =cut
406 :    
407 :     sub ParseCommand {
408 :     # Get the parameters.
409 :     my ($optionTable, @inputList) = @_;
410 :     # Process any options in the input list.
411 :     my %overrides = ();
412 :     while ((@inputList > 0) && ($inputList[0] =~ /^-/)) {
413 :     # Get the current option.
414 :     my $arg = shift @inputList;
415 :     # Pull out the option name.
416 :     $arg =~ /^-([^=]*)/g;
417 :     my $name = $1;
418 :     # Check for an option value.
419 :     if ($arg =~ /\G=(.*)$/g) {
420 :     # Here we have a value for the option.
421 :     $overrides{$name} = UnEscape($1);
422 :     } else {
423 :     # Here there is no value, so we use 1.
424 :     $overrides{$name} = 1;
425 :     }
426 :     }
427 :     # Merge the options into the defaults.
428 :     GetOptions($optionTable, \%overrides);
429 :     # Translate the remaining parameters.
430 :     my @retVal = ();
431 :     for my $inputParm (@inputList) {
432 :     push @retVal, UnEscape($inputParm);
433 :     }
434 :     # Return the results.
435 :     return ($optionTable, @retVal);
436 :     }
437 :    
438 :     =head3 UnEscape
439 :    
440 :     C<< my $realString = Tracer::UnEscape($codedString); >>
441 :    
442 :     Replace escape sequences with their actual equivalents. C<\b> will be replaced by a space,
443 :     C<\t> by a tab, C<\n> by a new-line character, and C<\\> by a back-slash.
444 :    
445 :     =over 4
446 :    
447 :     =item codedString
448 :    
449 :     String to un-escape.
450 :    
451 :     =item RETURN
452 :    
453 :     Returns a copy of the original string with the escape sequences converted to their actual
454 :     values.
455 :    
456 :     =back
457 :    
458 :     =cut
459 :    
460 :     sub UnEscape {
461 :     # Get the parameter.
462 :     my ($codedString) = @_;
463 :     # Initialize the return variable.
464 :     my $retVal = "";
465 :     # Loop through the parameter string, looking for escape sequences. We can't do
466 :     # translating because it causes problems with the escaped slash. ("\\b" becomes
467 :     # "\ " no matter what we do.)
468 :     while (length $codedString > 0) {
469 :     # Look for the first escape sequence.
470 :     if ($codedString =~ /^(.*?)\\(\\|b|n|t)/) {
471 :     # Here we found it. The text preceding the sequence is in $1. The sequence
472 :     # itself is in $2. First, move the clear text to the return variable.
473 :     $retVal .= $1;
474 :     $codedString = substr $codedString, (2 + length $1);
475 :     # Decode the escape sequence.
476 :     my $char = $2;
477 :     $char =~ tr/\\btn/\\ \t\n/;
478 :     $retVal .= $char;
479 :     } else {
480 :     # Here there are no more escape sequences. The rest of the string is
481 :     # transferred unmodified.
482 :     $retVal .= $codedString;
483 :     $codedString = "";
484 :     }
485 :     }
486 :     # Return the result.
487 :     return $retVal;
488 :     }
489 :    
490 :     =head3 ParseRecord
491 :    
492 :     C<< my @fields = Tracer::ParseRecord($line); >>
493 :    
494 :     Parse a tab-delimited data line. The data line is split into field values. Embedded tab
495 :     and new-line characters in the data line must be represented as C<\t> and C<\n>, respectively.
496 :     These will automatically be converted.
497 :    
498 :     =over 4
499 :    
500 :     =item line
501 :    
502 :     Line of data containing the tab-delimited fields.
503 :    
504 :     =item RETURN
505 :    
506 :     Returns a list of the fields found in the data line.
507 :    
508 :     =back
509 :    
510 :     =cut
511 :    
512 :     sub ParseRecord {
513 :     # Get the parameter.
514 :     my ($line) = @_;
515 :     # Remove the trailing new-line, if any.
516 :     chomp $line;
517 :     # Split the line read into pieces using the tab character.
518 :     my @retVal = split /\t/, $line;
519 :     # Trim and fix the escapes in each piece.
520 :     for my $value (@retVal) {
521 :     # Trim leading whitespace.
522 :     $value =~ s/^\s+//;
523 :     # Trim trailing whitespace.
524 :     $value =~ s/\s+$//;
525 :     # Delete the carriage returns.
526 :     $value =~ s/\r//g;
527 :     # Convert the escapes into their real values.
528 :     $value =~ s/\\t/"\t"/ge;
529 :     $value =~ s/\\n/"\n"/ge;
530 :     }
531 :     # Return the result.
532 :     return @retVal;
533 :     }
534 :    
535 :     =head3 Merge
536 :    
537 :     C<< my @mergedList = Tracer::Merge(@inputList); >>
538 :    
539 :     Sort a list of strings and remove duplicates.
540 :    
541 :     =over 4
542 :    
543 :     =item inputList
544 :    
545 :     List of scalars to sort and merge.
546 :    
547 :     =item RETURN
548 :    
549 :     Returns a list containing the same elements sorted in ascending order with duplicates
550 :     removed.
551 :    
552 :     =back
553 :    
554 :     =cut
555 :    
556 :     sub Merge {
557 :     # Get the input list in sort order.
558 :     my @inputList = sort @_;
559 :     # Only proceed if the list has at least two elements.
560 :     if (@inputList > 1) {
561 :     # Now we want to move through the list splicing out duplicates.
562 :     my $i = 0;
563 :     while ($i < @inputList) {
564 :     # Get the current entry.
565 :     my $thisEntry = $inputList[$i];
566 :     # Find out how many elements duplicate the current entry.
567 :     my $j = $i + 1;
568 :     my $dup1 = $i + 1;
569 :     while ($j < @inputList && $inputList[$j] eq $thisEntry) { $j++; };
570 :     # If the number is nonzero, splice out the duplicates found.
571 :     if ($j > $dup1) {
572 :     splice @inputList, $dup1, $j - $dup1;
573 :     }
574 :     # Now the element at position $dup1 is different from the element before it
575 :     # at position $i. We push $i forward one position and start again.
576 :     $i++;
577 :     }
578 :     }
579 :     # Return the merged list.
580 :     return @inputList;
581 :     }
582 :    
583 :     =head3 GetFile
584 :    
585 :     C<< my $fileContents = Tracer::GetFile($fileName); >>
586 :    
587 :     Return the entire contents of a file.
588 :    
589 :     =over 4
590 :    
591 :     =item fileName
592 :    
593 :     Name of the file to read.
594 :    
595 :     =item RETURN
596 :    
597 :     Returns the entire file as a single string. If an error occurs, will return
598 :     an empty string.
599 :    
600 :     =back
601 :    
602 :     =cut
603 :    
604 :     sub GetFile {
605 :     # Get the parameters.
606 :     my ($fileName) = @_;
607 :     # Declare the return variable.
608 :     my $retVal = "";
609 :     # Open the file for input.
610 :     my $ok = open INPUTFILE, "<$fileName";
611 :     if (!$ok) {
612 :     # If we had an error, trace it. We will automatically return a null string.
613 :     Trace(0, "Could not open \"$fileName\" for input.");
614 :     } else {
615 :     # Read the whole file into the return variable.
616 :     while (<INPUTFILE>) {
617 :     $retVal .= $_;
618 :     }
619 :     # Close it.
620 :     close INPUTFILE;
621 :     }
622 :     # Return the file's contents.
623 :     return $retVal;
624 :     }
625 :    
626 :     =head3 QTrace
627 :    
628 :     C<< my $data = QTrace($format); >>
629 :    
630 :     Return the queued trace data in the specified format.
631 :    
632 :     =over 4
633 :    
634 :     =item format
635 :    
636 :     C<html> to format the data as an HTML list, C<text> to format it as straight text.
637 :    
638 :     =back
639 :    
640 :     =cut
641 :    
642 :     sub QTrace {
643 :     # Get the parameter.
644 :     my ($format) = @_;
645 :     # Create the return variable.
646 :     my $retVal = "";
647 :     # Process according to the format.
648 :     if ($format =~ m/^HTML$/i) {
649 :     # Convert the queue into an HTML list.
650 :     $retVal = "<ul>\n";
651 :     for my $line (@Queue) {
652 :     my $escapedLine = CGI::escapeHTML($line);
653 :     $retVal .= "<li>$escapedLine</li>\n";
654 :     }
655 :     $retVal .= "</ul>\n";
656 :     } elsif ($format =~ m/^TEXT$/i) {
657 :     # Convert the queue into a list of text lines.
658 :     $retVal = join("\n", @Queue) . "\n";
659 :     }
660 :     # Clear the queue.
661 :     @Queue = ();
662 :     # Return the formatted list.
663 :     return $retVal;
664 :     }
665 :    
666 :     =head3 Confess
667 :    
668 :     C<< Confess($message); >>
669 :    
670 :     Trace the call stack and abort the program with the specified message. The stack
671 :     trace will only appear if the trace level for this package is 1 or more. When used with
672 :     the OR operator, this method can function as a debugging assert. So, for example
673 :    
674 :     C<< ($recNum >= 0) || Confess("Invalid record number $recNum."); >>
675 :    
676 :     Will abort the program with a stack trace if the value of C<$recNum> is negative.
677 :    
678 :     =over 4
679 :    
680 :     =item message
681 :    
682 :     Message to include in the trace.
683 :    
684 :     =back
685 :    
686 :     =cut
687 :    
688 :     sub Confess {
689 :     # Get the parameters.
690 :     my ($message) = @_;
691 :     # Trace the call stack.
692 :     Cluck($message) if T(1);
693 :     # Abort the program.
694 :     die $message;
695 :     }
696 :    
697 :     =head3 Cluck
698 :    
699 :     C<< Cluck($message); >>
700 :    
701 :     Trace the call stack. Note that for best results, you should qualify the call with a
702 :     trace condition. For example,
703 :    
704 :     C<< Cluck("Starting record parse.") if T(3); >>
705 :    
706 :     will only trace the stack if the trace level for the package is 3 or more.
707 :    
708 :     =over 4
709 :    
710 :     =item message
711 :    
712 :     Message to include in the trace.
713 :    
714 :     =back
715 :    
716 :     =cut
717 :    
718 :     sub Cluck {
719 :     # Get the parameters.
720 :     my ($message) = @_;
721 :     my $confession = longmess($message);
722 :     # Convert the confession to a series of trace messages.
723 :     for my $line (split /\s*\n/, $confession) {
724 :     Trace($line);
725 :     }
726 :     }
727 :    
728 :    
729 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3