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

Annotation of /FigKernelPackages/DocUtils.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : parrello 1.1 package DocUtils;
2 :    
3 :     =head1 Sprout Documentation Utilities
4 :    
5 :     =head2 Introduction
6 :    
7 :     This module processes documentation files. It can invoke C<pod2html> to convert a PM
8 :     file to a POD document or stylize an existing HTML file.
9 :    
10 :     Stylization is automatically performed on all POD documents. It involves two separate
11 :     steps. First, it sorts the table of contents in alphabetical order; second, it inserts
12 :     a style link to a specified cascading style sheet. This makes the POD document easier
13 :     to read and easier to navigate.
14 :    
15 :     =cut
16 :    
17 :     use strict;
18 :     use Tracer;
19 :     use File::Basename;
20 :     use File::stat;
21 :    
22 :     =head2 Public Methods
23 :    
24 :     =head3 PerlDoc
25 :    
26 :     C<< DocUtils::PerlDoc($inFile, $docDirectory, $style); >>
27 :    
28 :     This method generates an HTML document for the specified PERL source file in the
29 :     specified output directory. If a style file name is specified, it will be added
30 :     as a style link. The style file name should be specified relative to the output
31 :     directory. So, for example
32 :    
33 :     C<< DocUtils::PerlDoc('lib/Sprout.pm', 'CGI/Html/pod_doc', '../Georgia.css'); >>
34 :    
35 :     would produce the POD documentation for C<Sprout.pm> in the C<lib> directory.
36 :     The output file would be C<CGI/Html/pod_doc/Sprout.html>, and it would reference
37 :     the style file C<CGI/Html/Georgia.css>.
38 :    
39 :     =over 4
40 :    
41 :     =item inFile
42 :    
43 :     Name of the PERL source file.
44 :    
45 :     =item docDirectory
46 :    
47 :     Output directory into which the HTML document should be placed.
48 :    
49 :     =item style (optional)
50 :    
51 :     If specified, the name of the style file to be used, relative to the output directory.
52 :    
53 :     =back
54 :    
55 :     =cut
56 :    
57 :     sub PerlDoc {
58 :     # Get the parameters.
59 :     my ($inFile, $docDirectory, $style) = @_;
60 :     # Get the file name components.
61 :     my ($fileTitle, $inDirectory, $fileType) = fileparse($inFile, qr{\.[^.]+$});
62 :     # Check the file for POD stuff.
63 :     (open PODCHECK, $inFile) || Confess("Could not open POD input file $inFile.");
64 :     my $podFound = 0;
65 :     while (! $podFound && (my $line = <PODCHECK>)) {
66 :     if ($line =~ /^=(head|pod)/i) {
67 :     # We consider a file to have POD in it if we find a POD line or
68 :     # a header line.
69 :     $podFound = 1;
70 :     }
71 :     }
72 :     close PODCHECK;
73 :     # Check to see if we found POD stuff.
74 :     if (! $podFound) {
75 :     Trace("Module $fileTitle in $inDirectory does not have POD documentation.") if T(2);
76 :     } else {
77 :     Trace("Generating POD documentation for module $fileTitle.") if T(2);
78 :     # Here we need to create POD documentation for this input file.
79 :     # Switch to the input directory.
80 :     chdir $inDirectory;
81 :     my $result = system("pod2html --infile=$fileTitle$fileType --outfile=$fileTitle.tmp --title=$fileTitle") >> 8;
82 :     Trace("POD for $inFile returned $result.") if T(1);
83 : parrello 1.2 # Compute the output file name. We convert the input file base name by translating
84 :     # the period to a hyphen and then suffix "html".
85 :     $fileType =~ tr'.'-';
86 :     my $outFileName = "$docDirectory/$fileTitle$fileType.html";
87 : parrello 1.1 # Customize the result.
88 : parrello 1.2 Stylize("$fileTitle.tmp", $style, $outFileName);
89 : parrello 1.1 unlink "$fileTitle.tmp";
90 :     }
91 :     }
92 :    
93 :     =head3 Stylize
94 :    
95 :     C<< DocUtils::Stylize($inFile, $style, $outFile); >>
96 :    
97 :     Dress up an HTML file. Dressing up the file includes putting a header line in for
98 :     the table of contents, adding a style link, and sorted the table of contents into
99 :     alphabetical order for ease of maneuvering. The Table of Contents is identified by
100 :     two HTML comment lines:
101 :    
102 :     C<< <!-- INDEX BEGIN --> >>
103 :    
104 :     C<< <!-- INDEX END --> >>
105 :    
106 :     These are automatically inserted into the output of the C<pod2html> program. The directory
107 :     is presumed to be in outline form, using C<ul> and C<li> tags. Only the lowest level of
108 :     the outline is sorted.
109 :    
110 :     =over 4
111 :    
112 :     =item inFile
113 :    
114 :     Input file name.
115 :    
116 :     =item style
117 :    
118 :     Style file name, relative to the output file's directory. If null or undefined, no style link is added.
119 :    
120 :     =item outFile
121 :    
122 :     Output file name.
123 :    
124 :     =back
125 :    
126 :     =cut
127 :    
128 :     sub Stylize {
129 :     # Get the parameters.
130 :     my ($inFile, $style, $outFile) = @_;
131 :     Trace("Stylizing $inFile into $outFile.") if T(3);
132 :     # Open the files.
133 :     (open INFILE, '<', $inFile) || Confess("Could not open input file $inFile.");
134 :     (open OUTFILE, '>', $outFile) || Confess("Could not open output file $outFile.");
135 :     # Loop through the input file.
136 :     while (<INFILE>) {
137 :     # Check for one of the marker lines.
138 :     if (m!^\s*<body!i) {
139 :     # Here we have a body tag. We replace it with a null body tag and a header line
140 :     # for the table of contents.
141 :     print OUTFILE "<body>\n<h2>Table of Contents</h2>\n";
142 :     } elsif (m!^\s*</head!i) {
143 :     # Here we have the end of the heading section. We may need to insert a style link.
144 :     if ($style) {
145 :     print OUTFILE "<link href=\"$style\" rel=\"stylesheet\" type=\"text/css\">\n";
146 :     }
147 :     print OUTFILE "</head>\n";
148 :     } elsif (m/^<!-- INDEX BEGIN/) {
149 :     # Here we have the start of a POD index. We need to sort the sections.
150 :     # Read the whole index into a buffer.
151 :     Trace("Buffering table of contents.") if T(4);
152 :     my @buffer = ();
153 :     my $endFound = 0;
154 :     while (!$endFound && (my $record = <INFILE>)) {
155 :     if (m/^<!-- INDEX END/) {
156 :     $endFound = 1;
157 :     } else {
158 :     push @buffer, $record;
159 :     }
160 :     }
161 :     # Sort the buffer.
162 :     Trace("Sorting table of contents.") if T(4);
163 :     my @sortedBuffer = SortIndexes(@buffer);
164 :     # Write it back out.
165 :     for my $record (@sortedBuffer) {
166 :     print OUTFILE $record;
167 :     }
168 :     Trace("Sort complete.") if T(4);
169 :     } else {
170 :     # Here we have a normal line, so we write it unmodified.
171 :     print OUTFILE $_;
172 :     }
173 :     }
174 :     # Close the files.
175 :     close INFILE;
176 :     close OUTFILE;
177 :     Trace("Stylized file is at $outFile.") if T(4);
178 :     }
179 :    
180 :     =head3 Augment
181 :    
182 :     C<< DocUtils::Augment($inFile, $outDirectory, @statements); >>
183 :    
184 :     Augment a PERL script file by adding a set of pre-defined statements. The statements
185 :     will be added immediately after the shebang line, if one is present. Otherwise they will
186 :     be added to the beginning of the file. The augmented file will have the same name
187 :     as the original file but will be placed in the specified output directory.
188 :    
189 :     =over 4
190 :    
191 :     =item inFile
192 :    
193 :     Name of the input file.
194 :    
195 :     =item outDirectory
196 :    
197 :     Name of the directory to contain the output file.
198 :    
199 :     =item libs
200 :    
201 :     Statements to be added to the output file.
202 :    
203 :     =back
204 :    
205 :     =cut
206 :    
207 :     sub Augment {
208 :     # Get the parameters.
209 :     my ($inFile, $outDirectory, @statements) = @_;
210 :     # Get the input file name components.
211 :     my ($fileName, $inDirectory) = fileparse($inFile);
212 :     # Construct the output file name.
213 :     my $outFile = "$outDirectory/$fileName";
214 :     # Open the input and output files.
215 :     (open INFILE, '<', $inFile) || Confess("Could not open input file $inFile.");
216 :     (open OUTFILE, '>', $outFile) || Confess("Could not open output file $outFile.");
217 :     # Get the first input line.
218 :     my $line = <INFILE>;
219 :     # If it's a shebang and we have statements to insert, echo
220 :     # it out and save a blank line for later.
221 :     if ($#statements >= 0 && $line =~ /#!/) {
222 :     print OUTFILE $line;
223 :     $line = "\n";
224 :     }
225 :     # Write out the augmenting statements.
226 :     for my $statement (@statements) {
227 :     print OUTFILE "$statement\n";
228 :     }
229 :     # Echo the saved line.
230 :     print OUTFILE $line;
231 :     # Spin out the rest of the file.
232 :     while ($line = <INFILE>) {
233 : parrello 1.2 # If we're in PERL mode, we need to check for a duplicate line.
234 : parrello 1.1 print OUTFILE $line;
235 :     }
236 :     # Close both files.
237 :     close INFILE;
238 :     close OUTFILE;
239 :     }
240 :    
241 :     =head3 GetDirectory
242 :    
243 :     C<< my $fileHash = DocUtils::GetDirectory($directoryName); >>
244 :    
245 :     Get a list of the files in the specified directory. The files will be returned as
246 :     a hash of lists. The hash will map the various file extensions to the corresponding
247 :     file titles. So, for example, if the directory contained C<Sprout.pm>, C<DocUtils.pl>,
248 :     C<Tracer.pm>, C<Genome.pm>, and C<Makefile>, the hash returned would be
249 :    
250 :     C<< ( pm => ['Sprout', 'Tracer', 'Genome'], pl => ['DocUtils'], '' => ['Makefile'] ) >>
251 :    
252 :     =over 4
253 :    
254 :     =item directoryName
255 :    
256 :     Name of the directory whose files are desired.
257 :    
258 :     =item RETURN
259 :    
260 :     Returns a reference to a hash mapping each file extension to a list of the titles
261 :     of files having that extension.
262 :    
263 :     =back
264 :    
265 :     =cut
266 :    
267 :     sub GetDirectory {
268 :     # Get the parameter.
269 :     my ($directoryName) = @_;
270 :     # Create the return hash.
271 :     my %retVal = ();
272 :     # Open the directory and read in the file names.
273 :     (opendir INDIR, $directoryName) || Confess("Could not open directory $directoryName.");
274 :     my @fileNames = readdir INDIR;
275 :     # Create the variables for holding the file titles and extensions.
276 :     my ($ext, $title);
277 :     # Loop through the files.
278 :     for my $fileName (@fileNames) {
279 :     # Separate the file name into a title and an extension.
280 :     if ($fileName =~ /(.*)\.([^.]*)$/) {
281 :     ($title, $ext) = ($1, $2);
282 :     } else {
283 :     # Here the file name does not have an extension.
284 :     ($title, $ext) = ($fileName, '');
285 :     }
286 :     # Add the file's data into the hash.
287 :     Tracer::AddToListMap(\%retVal, $ext, $title);
288 :     }
289 :     # Return the result hash.
290 :     return \%retVal;
291 :     }
292 :    
293 :     =head3 CheckFile
294 :    
295 : parrello 1.2 C<< my $updated = DocUtils::CheckFile($inFile, $outDirectory, $suffix); >>
296 : parrello 1.1
297 :     This method compares the modification date of a specified file against the
298 :     date of a similarly-named file in the specified output directory. It
299 :     returns TRUE if the matching output file does not exist or has been
300 :     modified since the last modification of the matching file in the output
301 :     directory.
302 :    
303 :     =over 4
304 :    
305 :     =item inFile
306 :    
307 :     Name of the input file.
308 :    
309 :     =item outDirectory
310 :    
311 :     Directory to contain the output file.
312 :    
313 : parrello 1.2 =item suffix (optional)
314 :    
315 :     If specified, a suffix to be added to the input file name to create the
316 :     output file name.
317 :    
318 : parrello 1.1 =back
319 :    
320 :     =cut
321 :    
322 :     sub CheckFile {
323 :     # Get the parameters.
324 : parrello 1.2 my ($inFile, $outDirectory, $suffix) = @_;
325 : parrello 1.1 # Create the return variable.
326 :     my $retVal = 1;
327 :     # Get the name of the output file.
328 :     my ($fileTitle, $inDirectory) = fileparse($inFile);
329 :     my $outFileName = "$outDirectory/$fileTitle";
330 : parrello 1.2 if ($suffix) {
331 :     $outFileName .= $suffix;
332 :     }
333 : parrello 1.1 # Check to see if the output file exists.
334 :     if (-e $outFileName) {
335 :     # Get the input and output modify times.
336 :     my $inTime = stat($inFile)->mtime;
337 :     my $outTime = stat($outFileName)->mtime;
338 :     # If the output file is newer, return FALSE.
339 :     if ($outTime >= $inTime) {
340 :     $retVal = 0;
341 :     }
342 :     }
343 :     # Return the determination indicator.
344 :     return $retVal;
345 :     }
346 :    
347 :     =head2 Internal Utilities
348 :    
349 :     =head3 SortIndexes
350 :    
351 :     Sort a POD index. The index is provided as a list and is returned as a list.
352 :     The index itself consists of <ul>, </ul>, and <li> lines. Each <ul> adds an
353 :     indent level and each </ul> subtracts one. Only the <li> lines at the lowest
354 :     level are sorted. This is not very general-purpose, but it is enough to handle
355 :     the output from POD and the ERDB module.
356 :    
357 :     This is a static method.
358 :    
359 :     =over 4
360 :    
361 :     =item buffer
362 :    
363 :     List of lines making up the index.
364 :    
365 :     =item RETURN
366 :    
367 :     A list of the same lines in a more useful order.
368 :    
369 :     =back
370 :    
371 :     =cut
372 :    
373 :     sub SortIndexes {
374 :     # Get the list of lines to sort.
375 :     my @buffer = @_;
376 :     # Declare the output array.
377 :     my @retVal = ();
378 :     # Now we need to read through the buffer. At all times, we remember the
379 :     # location of the first <li> line in the current group. If a <ul> line is
380 :     # found, the current group is written to the output array unmodified and
381 :     # a new group starts. If a </ul> line is found, the current group is written
382 :     # to the output array after sorting. Thereafter, there is no current group
383 :     # until we find another <ul> line.
384 :     my @currentGroup = ();
385 :     # Denote we're not currently inside a group.
386 :     my $inGroup = 0;
387 :     # Denote we're not looking for the first line of a group.
388 :     my $looking = 0;
389 :     for my $record (@buffer) {
390 :     # Determine the type of record.
391 :     if ($record =~ m!^\s*$!) {
392 :     # Blank lines are ignored.
393 :     } elsif ($record =~ m!<ul>!) {
394 :     # Here we have the start of a new list. Denote we're
395 :     # no longer inside a group but we're looking for a
396 :     # new one.
397 :     push @currentGroup, $record;
398 :     $inGroup = 0;
399 :     $looking = 1;
400 :     } elsif ($record =~ m!</ul>!) {
401 :     # Here we have the end of a list. If we're inside a group,
402 :     # we sort it and call for a flush.
403 :     if ($inGroup) {
404 :     my @sortedGroup = sort @currentGroup;
405 :     push @sortedGroup, $record;
406 :     @currentGroup = @sortedGroup;
407 :     $inGroup = 0;
408 :     $looking = 0;
409 :     } else {
410 :     # Otherwise we echo the record.
411 :     push @retVal, $record;
412 :     }
413 :     } else {
414 :     # Here we have a line item. If we're looking, we start a group.
415 :     # if we're in a group, we continue the group. Otherwise, we
416 :     # echo the record.
417 :     if ($looking) {
418 :     @currentGroup = ($record);
419 :     $inGroup = 1;
420 :     $looking = 0;
421 :     } elsif ($inGroup) {
422 :     push @currentGroup, $record;
423 :     } else {
424 :     push @retVal, $record;
425 :     }
426 :     }
427 :     # If we're not in a group and we have records, we must flush them.
428 :     if (@currentGroup > 0 && !$inGroup) {
429 :     push @retVal, @currentGroup;
430 :     @currentGroup = ();
431 :     }
432 :     }
433 :     # Return the modified list.
434 :     return @retVal;
435 :     }
436 :    
437 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3