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

Annotation of /FigKernelPackages/DocUtils.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : olson 1.3 #
2 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
3 :     # for Interpretations of Genomes. All Rights Reserved.
4 :     #
5 :     # This file is part of the SEED Toolkit.
6 : parrello 1.12 #
7 : olson 1.3 # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 : parrello 1.12 # Public License.
10 : olson 1.3 #
11 :     # You should have received a copy of the SEED Toolkit Public License
12 :     # along with this program; if not write to the University of Chicago
13 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14 :     # Genomes at veronika@thefig.info or download a copy from
15 :     # http://www.theseed.org/LICENSE.TXT.
16 :     #
17 :    
18 : parrello 1.1 package DocUtils;
19 :    
20 :     =head1 Sprout Documentation Utilities
21 :    
22 :     =head2 Introduction
23 :    
24 : parrello 1.13 This module contains utilities for manipulating PERL source files.
25 : parrello 1.1
26 :     =cut
27 :    
28 :     use strict;
29 :     use Tracer;
30 :     use File::Basename;
31 :     use File::stat;
32 : parrello 1.13 use Time::Local;
33 :     use CGI;
34 : parrello 1.18 use Pod::Simple::HTML;
35 : parrello 1.1
36 :     =head2 Public Methods
37 :    
38 : parrello 1.6 =head3 ModifyConfigFile
39 :    
40 : parrello 1.12 DocUtils::ModifyConfigFile($targetFile, \%changes, \@inserts);
41 : parrello 1.6
42 :     Modify the contents of a PERL configuration file. A PERL configuration file contains a
43 :     C<package> statement followed by a set of assignments having the form
44 :    
45 :     $var_name = "string";
46 :    
47 :     with optional comments. The caller passes in a hash keyed by variable name, and the
48 :     configuration file will be updated to insure the variables mentioned in the hash have
49 :     the associated value in the specified configuration file. If the variables in the hash
50 :     already exist in the file, they will be replaced. If they do not exist they will be
51 :     added before the first line beginning with C<1;>.
52 :    
53 :     =over 4
54 :    
55 :     =item targetFile
56 :    
57 :     Name of the configuration file to be changed.
58 :    
59 :     =item changes
60 :    
61 :     Reference to a hash mapping variable names to string values.
62 :    
63 : parrello 1.9 =item inserts
64 : parrello 1.7
65 : parrello 1.9 Reference to a list of lines to be inserted at the beginning.
66 : parrello 1.7
67 : parrello 1.6 =back
68 :    
69 :     =cut
70 :     #: Return Type ;
71 :     sub ModifyConfigFile {
72 :     # Get the parameters.
73 : parrello 1.9 my ($targetFile, $changes, $inserts) = @_;
74 : parrello 1.6 # Insure the target file exists.
75 :     if (! -e $targetFile) {
76 :     Confess("Configuration file $targetFile not found in ModifyConfigFile.");
77 :     } else {
78 : parrello 1.17 Trace("Updating configuration file $targetFile.") if T(3);
79 : parrello 1.6 # Create a temporary file name from the target file name.
80 :     my $tempFile = "$targetFile~";
81 :     # Create a hash for tracking variable names used.
82 :     my %varHash = ();
83 :     # Open the target file for input and the temp file for output.
84 :     Open(\*CONFIGIN, "<$targetFile");
85 :     Open(\*CONFIGOUT, ">$tempFile");
86 : parrello 1.7 # Denote we haven't found a trailer line.
87 :     my $oneFound = 0;
88 : parrello 1.17 # Count the lines skipped abd updated.
89 :     my $skipLines = 0;
90 :     my $updateLines = 0;
91 :     my $insertLines = 0;
92 : parrello 1.6 # Read through the target file.
93 :     while (my $line = <CONFIGIN>) {
94 :     # Parse the input line. Note we look for the longest possible string value
95 :     # that does not extend into the comment field.
96 : parrello 1.17 if ($line =~ /^\s*\$(\S+)\s*=\s*"([^#]*)";(.*)$/) {
97 : parrello 1.6 # Get the variable name and the value string.
98 :     my ($varName, $value, $comment) = ($1, $2, $3);
99 :     # See if this variable name has a new value.
100 :     if (exists $changes->{$varName}) {
101 :     # Get the new value.
102 :     $value = $changes->{$varName};
103 :     # Denote it's been used.
104 :     $varHash{$varName} = 1;
105 : parrello 1.17 Trace("New value for $varName is \"$value\".") if T(4);
106 :     $updateLines++;
107 :     } else {
108 :     Trace("Variable $varName not modified.") if T(4);
109 : parrello 1.6 }
110 :     # Write out the assignment statement.
111 :     my $newLine = _BuildAssignment($varName, $value, $comment);
112 :     print CONFIGOUT $newLine;
113 :     } elsif ($line =~ /^1;/) {
114 :     # This is the end line, so we write out the rest of the variables.
115 :     for my $varName (keys %{$changes}) {
116 :     # Find out if this variable has already been seen.
117 :     if (! exists $varHash{$varName}) {
118 :     # It hasn't been seen, so we need to add it to the output.
119 :     my $value = $changes->{$varName};
120 :     my $newLine = _BuildAssignment($varName, $value, "");
121 : parrello 1.7 Trace("Adding new value for $varName to config file.") if T(3);
122 : parrello 1.6 print CONFIGOUT $newLine;
123 : parrello 1.17 $insertLines++;
124 : parrello 1.6 }
125 :     }
126 : parrello 1.7 # Write out the end line.
127 :     print CONFIGOUT "1;\n";
128 :     # Denote we found it.
129 :     $oneFound = 1;
130 : parrello 1.9 } elsif ($line =~ /package\s/i) {
131 :     # Here we have a package statement. We write it out followed by the
132 :     # insert lines.
133 :     print CONFIGOUT $line;
134 :     # Only proceed if insert lines were specified.
135 :     if (defined $inserts) {
136 : parrello 1.17 for my $insert (@{$inserts}) {
137 : parrello 1.9 print CONFIGOUT "$insert\n";
138 :     }
139 :     }
140 : parrello 1.6 } else {
141 :     # Here the line doesn't parse, so we write it unmodified.
142 :     print CONFIGOUT $line;
143 : parrello 1.17 $skipLines++;
144 : parrello 1.6 }
145 :     }
146 : parrello 1.17 Trace("$skipLines lines skipped, $insertLines inserted, $updateLines updated.") if T(3);
147 : parrello 1.7 # Complain if we didn't find a trailer.
148 :     if (! $oneFound) {
149 :     Confess("No trailer (1;) found in FIG_Config.pm.");
150 :     } else {
151 :     # Close the files and rename the output file so it overwrites the input file.
152 :     close CONFIGIN;
153 :     close CONFIGOUT;
154 :     rename $tempFile, $targetFile;
155 :     }
156 : parrello 1.6 }
157 :     }
158 :    
159 : parrello 1.1 =head3 Augment
160 :    
161 : parrello 1.12 DocUtils::Augment($inFile, $outDirectory, @statements);
162 : parrello 1.1
163 :     Augment a PERL script file by adding a set of pre-defined statements. The statements
164 :     will be added immediately after the shebang line, if one is present. Otherwise they will
165 :     be added to the beginning of the file. The augmented file will have the same name
166 :     as the original file but will be placed in the specified output directory.
167 :    
168 :     =over 4
169 :    
170 :     =item inFile
171 :    
172 :     Name of the input file.
173 :    
174 :     =item outDirectory
175 :    
176 :     Name of the directory to contain the output file.
177 :    
178 :     =item libs
179 :    
180 :     Statements to be added to the output file.
181 :    
182 :     =back
183 :    
184 :     =cut
185 :    
186 :     sub Augment {
187 : parrello 1.5 # Get the parameters.
188 :     my ($inFile, $outDirectory, @statements) = @_;
189 :     # Get the input file name components.
190 :     my ($fileName, $inDirectory) = fileparse($inFile);
191 :     # Construct the output file name.
192 :     my $outFile = "$outDirectory/$fileName";
193 :     # Open the input and output files.
194 :     (open INFILE, '<', $inFile) || Confess("Could not open input file $inFile.");
195 :     (open OUTFILE, '>', $outFile) || Confess("Could not open output file $outFile.");
196 :     # Get the first input line.
197 :     my $line = <INFILE>;
198 :     # If it's a shebang and we have statements to insert, echo
199 :     # it out and save a blank line for later.
200 :     if ($#statements >= 0 && $line =~ /#!/) {
201 :     print OUTFILE $line;
202 :     $line = "\n";
203 :     }
204 :     # Write out the augmenting statements.
205 :     for my $statement (@statements) {
206 :     print OUTFILE "$statement\n";
207 :     }
208 :     # Echo the saved line.
209 :     print OUTFILE $line;
210 :     # Spin out the rest of the file.
211 :     while ($line = <INFILE>) {
212 :     # If we're in PERL mode, we need to check for a duplicate line.
213 :     print OUTFILE $line;
214 :     }
215 :     # Close both files.
216 :     close INFILE;
217 :     close OUTFILE;
218 : parrello 1.1 }
219 :    
220 :     =head3 GetDirectory
221 :    
222 : parrello 1.12 my $fileHash = DocUtils::GetDirectory($directoryName);
223 : parrello 1.1
224 :     Get a list of the files in the specified directory. The files will be returned as
225 :     a hash of lists. The hash will map the various file extensions to the corresponding
226 :     file titles. So, for example, if the directory contained C<Sprout.pm>, C<DocUtils.pl>,
227 :     C<Tracer.pm>, C<Genome.pm>, and C<Makefile>, the hash returned would be
228 :    
229 : parrello 1.12 ( pm => ['Sprout', 'Tracer', 'Genome'], pl => ['DocUtils'], '' => ['Makefile'] )
230 : parrello 1.1
231 :     =over 4
232 :    
233 :     =item directoryName
234 :    
235 :     Name of the directory whose files are desired.
236 :    
237 :     =item RETURN
238 :    
239 : parrello 1.12 Returns a reference to a hash mapping each file extension to a list of the titles
240 : parrello 1.1 of files having that extension.
241 :    
242 :     =back
243 :    
244 :     =cut
245 :    
246 :     sub GetDirectory {
247 : parrello 1.5 # Get the parameter.
248 :     my ($directoryName) = @_;
249 :     # Create the return hash.
250 :     my %retVal = ();
251 :     # Open the directory and read in the file names.
252 :     (opendir INDIR, $directoryName) || Confess("Could not open directory $directoryName.");
253 :     my @fileNames = readdir INDIR;
254 :     # Create the variables for holding the file titles and extensions.
255 :     my ($ext, $title);
256 :     # Loop through the files.
257 :     for my $fileName (@fileNames) {
258 :     # Separate the file name into a title and an extension.
259 :     if ($fileName =~ /^\./) {
260 :     # Ignore filenames that start with a period.
261 :     } elsif ($fileName =~ /(.+)\.([^.]*)$/) {
262 :     ($title, $ext) = ($1, $2);
263 :     # Add the file's data into the hash.
264 : parrello 1.13 push @{$retVal{$ext}}, $title;
265 : parrello 1.5 } elsif ($fileName) {
266 :     # Here the file name does not have an extension. Note that null filenames and
267 :     # the various hidden files are skipped.
268 :     ($title, $ext) = ($fileName, '');
269 :     # Add the file's data into the hash.
270 : parrello 1.13 push @{$retVal{$ext}}, $title;
271 : parrello 1.5 }
272 :     }
273 :     # Return the result hash.
274 :     return \%retVal;
275 : parrello 1.1 }
276 :    
277 : parrello 1.16 =head3 GetPod
278 : parrello 1.13
279 : parrello 1.16 my $podText = DocUtils::GetPod($parser, $fileName);
280 : parrello 1.1
281 : parrello 1.16 Get the POD text from the specified file using the specified parser. The
282 :     result will be a single text string with embedded new-lines. If there is
283 :     no POD text, this method will return an undefined value.
284 : parrello 1.1
285 : parrello 1.16 =over 4
286 :    
287 :     =item parser
288 : parrello 1.1
289 : parrello 1.16 A subclass of B<Pod::Simple> that specifies the desired output format.
290 : parrello 1.1
291 : parrello 1.16 =item fileName
292 : parrello 1.13
293 : parrello 1.16 Name of the file to read.
294 : parrello 1.13
295 : parrello 1.16 =item RETURN
296 : parrello 1.13
297 : parrello 1.16 Returns the formatted Pod text if successful, or C<undef> if no Pod
298 :     documentation was found.
299 : parrello 1.13
300 :     =back
301 :    
302 :     =cut
303 :    
304 : parrello 1.16 sub GetPod {
305 : parrello 1.13 # Get the parameters.
306 : parrello 1.16 my ($parser, $fileName) = @_;
307 :     # Declare the return variable.
308 :     my $retVal;
309 :     # Tell the parser to output to a string.
310 :     $parser->output_string(\$retVal);
311 :     # Parse the incoming file.
312 :     $parser->parse_file($fileName);
313 :     # Check for a meaningful result.
314 :     if ($retVal !~ /\S/) {
315 :     # No documentation was found, so we return an undefined value.
316 :     undef $retVal;
317 : parrello 1.13 }
318 : parrello 1.16 # Return the result.
319 :     return $retVal;
320 : parrello 1.13 }
321 :    
322 : parrello 1.18 =head3 FindPod
323 :    
324 :     my $fileFound = DocUtils::FindPod($modName);
325 :    
326 :     Attempt to find a POD document with the given name. If found, the file
327 :     name will be returned.
328 :    
329 :     =over 4
330 :    
331 :     =item modName
332 :    
333 :     Name of the Pod module.
334 :    
335 :     =item RETURN
336 :    
337 :     Returns the name of the POD file found, or C<undef> if no such file was found.
338 :    
339 :     =back
340 :    
341 :     =cut
342 :    
343 :     sub FindPod {
344 :     # Get the parameters.
345 :     my ($modName) = @_;
346 :     # Declare the return variable.
347 :     my $retVal;
348 :     # Only proceed if this is a reasonable Pod name.
349 :     if ($modName =~ /^(?:\w|::)+$/) {
350 :     # Here we have a module. Convert the module name to a path.
351 :     $modName =~ s/::/\//g;
352 :     # Get a list of the possible file names for our desired file.
353 :     my @files = map { ("$_/$modName.pod", "$_/$modName.pm", "$_/pod/$modName.pod") } @INC;
354 :     # Find the first file that exists.
355 :     for (my $i = 0; $i <= $#files && ! defined $retVal; $i++) {
356 :     # Get the file name.
357 :     my $fileName = $files[$i];
358 :     # Fix windows/Unix file name confusion.
359 :     $fileName =~ s#\\#/#g;
360 :     if (-f $fileName) {
361 :     $retVal = $fileName;
362 :     }
363 :     }
364 :     } elsif ($modName =~ /^(\w+)\.pl$/) {
365 :     # Here we have a command-line script. We strip off the .pl and
366 :     # look for it in the binary directory.
367 :     my $file = "$FIG_Config::bin/$1";
368 :     $retVal = $file if -f $file;
369 :     } elsif ($modName =~ /^\w+\.cgi$/) {
370 :     # Here we have a web service.
371 :     my $file = "$FIG_Config::fig/CGI/$modName";
372 :     $retVal = $file if -f $file;
373 :     }
374 :     # Return the result.
375 :     return $retVal;
376 :     }
377 :    
378 :     =head3 ShowPod
379 :    
380 :     my $html = DocUtils::ShowPod($module, $url);
381 :    
382 :     Return the HTML pod documentation for the specified module. The incoming
383 :     URL will be used to relocate links.
384 :    
385 :     =over 4
386 :    
387 :     =item module
388 :    
389 :     Name of the module whose POD documentation is to be converted to HTML.
390 :    
391 :     =item url
392 :    
393 :     URL prefix to be used for documentation of other modules. It should be possible
394 :     to concatenate a module name directly to this string and produce a valid URL.
395 :    
396 :     =item RETURN
397 :    
398 :     Returns HTML text for displaying the POD documentation. The HTML will not include
399 :     page or body tags, and will be enclosed in a DIV block named C<pod>. Errors will
400 :     be displayed as block quotes of class C<error>.
401 :    
402 :     =back
403 :    
404 :     =cut
405 :    
406 :     sub ShowPod {
407 :     # Get the parameters.
408 :     my ($module, $url) = @_;
409 :     # We'll build the HTML in here.
410 :     my @lines;
411 :     # Try to find the module.
412 :     my $fileFound = FindPod($module);
413 :     if (! $fileFound) {
414 :     push @lines, CGI::blockquote({ class => 'error' }, "Module $module not found.");
415 :     } else {
416 :     # We have a file containing our module documentation. Display its name
417 :     # and date. This helps us to insure we have the correct file.
418 :     my $fileData = stat($fileFound);
419 :     my $fileDate = Tracer::DisplayTime($fileData->mtime);
420 :     push @lines, CGI::p("Documentation read from $fileDate version of $fileFound.");
421 :     # Now the real meaty part. We must convert the file's POD to hTML.
422 :     # To do that, we need a parser.
423 :     my $parser = Pod::Simple::HTML->new();
424 :     # Denote we want an index.
425 :     $parser->index(1);
426 :     # Set up L-links to use this script.
427 :     $parser->perldoc_url_prefix($url);
428 :     # Denote that we want to format the Pod into a string.
429 :     my $pod;
430 :     $parser->output_string(\$pod);
431 :     # Parse the file.
432 :     $parser->parse_file($fileFound);
433 :     # Check for a meaningful result.
434 :     if ($pod !~ /\S/) {
435 :     # No luck. Output an error message.
436 :     push @lines, CGI::blockquote({ class => 'error' }, "No POD documentation found in <u>$module</u>.");
437 :     } else {
438 :     # Put the result in the output area. We use a DIV to give ourselves
439 :     # greater control in the CSS file.
440 :     push @lines, CGI::start_div({ id => "pod" }), $pod, CGI::end_div();
441 :     # Put a horizontal line at the bottom to make it pretty.
442 :     push @lines, CGI::hr({ style => 'clear: all'});
443 :     }
444 :     }
445 :     # Return the result.
446 :     return join("\n", @lines);
447 :     }
448 :    
449 :    
450 : parrello 1.13 =head2 Private Methods
451 :    
452 :     =head3 _BuildAssignment
453 :    
454 :     my $statement = _BuildAssignment($varName, $value, $comment);
455 :    
456 :     Create an assignment statement out of the specified components.
457 : parrello 1.1
458 : parrello 1.13 =over 4
459 : parrello 1.1
460 : parrello 1.13 =item varName
461 : parrello 1.1
462 : parrello 1.13 Variable name.
463 : parrello 1.1
464 : parrello 1.13 =item value
465 : parrello 1.2
466 : parrello 1.13 Value to be assigned to the variable (will be quoted).
467 : parrello 1.2
468 : parrello 1.13 =item comment
469 : parrello 1.10
470 : parrello 1.13 Comments or trailing characters.
471 : parrello 1.10
472 : parrello 1.1 =back
473 :    
474 :     =cut
475 :    
476 : parrello 1.13 sub _BuildAssignment {
477 : parrello 1.5 # Get the parameters.
478 : parrello 1.13 my ($varName, $value, $comment) = @_;
479 :     # Pad the variable name.
480 :     my $varPad = Tracer::Pad($varName, 30);
481 : parrello 1.14 # Check the value. It could be a string, a hash reference literal, or
482 :     # a list reference literal.
483 :     my $literal;
484 : parrello 1.15 if ($value =~ /^{.+}$|^\[.+\]$/) {
485 : parrello 1.14 # Here we have a reference.
486 :     $literal = $value;
487 :     } else {
488 :     # Here we have a string.
489 :     $literal = "\"$value\"";
490 :     }
491 : parrello 1.13 # Return the assignment statement.
492 : parrello 1.14 my $retVal = '$' . "$varPad = $literal; $comment\n";
493 : parrello 1.5 return $retVal;
494 : parrello 1.1 }
495 :    
496 : parrello 1.6
497 : golsen 1.4 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3