projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
[win32] integrate mainline
[p5sagit/p5-mst-13.2.git] / lib / Pod / Html.pm
CommitLineData
54310121 1package Pod::Html;
2
3use Pod::Functions;
4use Getopt::Long; # package for handling command-line parameters
5require Exporter;
6@ISA = Exporter;
7@EXPORT = qw(pod2html htmlify);
8use Cwd;
9
10use Carp;
11
12use strict;
13
14=head1 NAME
15
16Pod::HTML - module to convert pod files to HTML
17
18=head1 SYNOPSIS
19
20 use Pod::HTML;
21 pod2html([options]);
22
23=head1 DESCRIPTION
24
25Converts files from pod format (see L<perlpod>) to HTML format. It
26can automatically generate indexes and cross-references, and it keeps
27a cache of things it knows how to cross-reference.
28
29=head1 ARGUMENTS
30
31Pod::Html takes the following arguments:
32
33=over 4
34
35=item help
36
37 --help
38
39Displays the usage message.
40
41=item htmlroot
42
43 --htmlroot=name
44
45Sets the base URL for the HTML files. When cross-references are made,
46the HTML root is prepended to the URL.
47
48=item infile
49
50 --infile=name
51
52Specify the pod file to convert. Input is taken from STDIN if no
53infile is specified.
54
55=item outfile
56
57 --outfile=name
58
59Specify the HTML file to create. Output goes to STDOUT if no outfile
60is specified.
61
62=item podroot
63
64 --podroot=name
65
66Specify the base directory for finding library pods.
67
68=item podpath
69
70 --podpath=name:...:name
71
72Specify which subdirectories of the podroot contain pod files whose
73HTML converted forms can be linked-to in cross-references.
74
75=item libpods
76
77 --libpods=name:...:name
78
79List of page names (eg, "perlfunc") which contain linkable C<=item>s.
80
81=item netscape
82
83 --netscape
84
85Use Netscape HTML directives when applicable.
86
87=item nonetscape
88
89 --nonetscape
90
91Do not use Netscape HTML directives (default).
92
93=item index
94
95 --index
96
97Generate an index at the top of the HTML file (default behaviour).
98
99=item noindex
100
101 --noindex
102
103Do not generate an index at the top of the HTML file.
104
105
106=item recurse
107
108 --recurse
109
110Recurse into subdirectories specified in podpath (default behaviour).
111
112=item norecurse
113
114 --norecurse
115
116Do not recurse into subdirectories specified in podpath.
117
118=item title
119
120 --title=title
121
122Specify the title of the resulting HTML file.
123
124=item verbose
125
126 --verbose
127
128Display progress messages.
129
130=back
131
132=head1 EXAMPLE
133
134 pod2html("pod2html",
135 "--podpath=lib:ext:pod:vms",
136 "--podroot=/usr/src/perl",
137 "--htmlroot=/perl/nmanual",
138 "--libpods=perlfunc:perlguts:perlvar:perlrun:perlop",
139 "--recurse",
140 "--infile=foo.pod",
141 "--outfile=/perl/nmanual/foo.html");
142
143=head1 AUTHOR
144
145Tom Christiansen, E<lt>tchrist@perl.comE<gt>.
146
147=head1 BUGS
148
149Has trouble with C<> etc in = commands.
150
151=head1 SEE ALSO
152
153L<perlpod>
154
155=head1 COPYRIGHT
156
157This program is distributed under the Artistic License.
158
159=cut
160
161my $dircache = "pod2html-dircache";
162my $itemcache = "pod2html-itemcache";
163
164my @begin_stack = (); # begin/end stack
165
166my @libpods = (); # files to search for links from C<> directives
167my $htmlroot = "/"; # http-server base directory from which all
168 # relative paths in $podpath stem.
169my $htmlfile = ""; # write to stdout by default
170my $podfile = ""; # read from stdin by default
171my @podpath = (); # list of directories containing library pods.
172my $podroot = "."; # filesystem base directory from which all
173 # relative paths in $podpath stem.
174my $recurse = 1; # recurse on subdirectories in $podpath.
175my $verbose = 0; # not verbose by default
176my $doindex = 1; # non-zero if we should generate an index
177my $listlevel = 0; # current list depth
178my @listitem = (); # stack of HTML commands to use when a =item is
179 # encountered. the top of the stack is the
180 # current list.
181my @listdata = (); # similar to @listitem, but for the text after
182 # an =item
183my @listend = (); # similar to @listitem, but the text to use to
184 # end the list.
185my $ignore = 1; # whether or not to format text. we don't
186 # format text until we hit our first pod
187 # directive.
188
189my %items_named = (); # for the multiples of the same item in perlfunc
190my @items_seen = ();
191my $netscape = 0; # whether or not to use netscape directives.
192my $title; # title to give the pod(s)
193my $top = 1; # true if we are at the top of the doc. used
194 # to prevent the first <HR> directive.
195my $paragraph; # which paragraph we're processing (used
196 # for error messages)
197my %pages = (); # associative array used to find the location
198 # of pages referenced by L<> links.
199my %sections = (); # sections within this page
200my %items = (); # associative array used to find the location
201 # of =item directives referenced by C<> links
39e571d4 202my $Is83; # is dos with short filenames (8.3)
203
54310121 204sub init_globals {
205$dircache = "pod2html-dircache";
206$itemcache = "pod2html-itemcache";
207
208@begin_stack = (); # begin/end stack
209
210@libpods = (); # files to search for links from C<> directives
211$htmlroot = "/"; # http-server base directory from which all
212 # relative paths in $podpath stem.
213$htmlfile = ""; # write to stdout by default
214$podfile = ""; # read from stdin by default
215@podpath = (); # list of directories containing library pods.
216$podroot = "."; # filesystem base directory from which all
217 # relative paths in $podpath stem.
218$recurse = 1; # recurse on subdirectories in $podpath.
219$verbose = 0; # not verbose by default
220$doindex = 1; # non-zero if we should generate an index
221$listlevel = 0; # current list depth
222@listitem = (); # stack of HTML commands to use when a =item is
223 # encountered. the top of the stack is the
224 # current list.
225@listdata = (); # similar to @listitem, but for the text after
226 # an =item
227@listend = (); # similar to @listitem, but the text to use to
228 # end the list.
229$ignore = 1; # whether or not to format text. we don't
230 # format text until we hit our first pod
231 # directive.
232
233@items_seen = ();
234%items_named = ();
235$netscape = 0; # whether or not to use netscape directives.
236$title = ''; # title to give the pod(s)
237$top = 1; # true if we are at the top of the doc. used
238 # to prevent the first <HR> directive.
239$paragraph = ''; # which paragraph we're processing (used
240 # for error messages)
54310121 241%sections = (); # sections within this page
3e3baf6d 242
243# These are not reinitialised here but are kept as a cache.
244# See get_cache and related cache management code.
245#%pages = (); # associative array used to find the location
246 # of pages referenced by L<> links.
247#%items = (); # associative array used to find the location
54310121 248 # of =item directives referenced by C<> links
39e571d4 249$Is83=$^O eq 'dos';
54310121 250}
251
252sub pod2html {
253 local(@ARGV) = @_;
254 local($/);
255 local $_;
256
257 init_globals();
258
39e571d4 259 $Is83 = 0 if (defined (&Dos::UseLFN) && Dos::UseLFN());
260
54310121 261 # cache of %pages and %items from last time we ran pod2html
54310121 262
263 #undef $opt_help if defined $opt_help;
264
265 # parse the command-line parameters
266 parse_command_line();
267
268 # set some variables to their default values if necessary
269 local *POD;
270 unless (@ARGV && $ARGV[0]) {
271 $podfile = "-" unless $podfile; # stdin
272 open(POD, "<$podfile")
273 || die "$0: cannot open $podfile file for input: $!\n";
274 } else {
275 $podfile = $ARGV[0]; # XXX: might be more filenames
276 *POD = *ARGV;
277 }
278 $htmlfile = "-" unless $htmlfile; # stdout
279 $htmlroot = "" if $htmlroot eq "/"; # so we don't get a //
280
281 # read the pod a paragraph at a time
282 warn "Scanning for sections in input file(s)\n" if $verbose;
283 $/ = "";
284 my @poddata = <POD>;
285 close(POD);
286
287 # scan the pod for =head[1-6] directives and build an index
288 my $index = scan_headings(\%sections, @poddata);
289
3e3baf6d 290 unless($index) {
291 warn "No pod in $podfile\n" if $verbose;
292 return;
293 }
294
54310121 295 # open the output file
296 open(HTML, ">$htmlfile")
297 || die "$0: cannot open $htmlfile file for output: $!\n";
298
299 # put a title in the HTML file
300 $title = '';
301 TITLE_SEARCH: {
302 for (my $i = 0; $i < @poddata; $i++) {
303 if ($poddata[$i] =~ /^=head1\s*NAME\b/m) {
304 for my $para ( @poddata[$i, $i+1] ) {
305 last TITLE_SEARCH if ($title) = $para =~ /(\S+\s+-+\s*.*)/s;
306 }
307 }
308
309 }
310 }
3e3baf6d 311 if (!$title and $podfile =~ /\.pod$/) {
312 # probably a split pod so take first =head[12] as title
313 for (my $i = 0; $i < @poddata; $i++) {
314 last if ($title) = $poddata[$i] =~ /^=head[12]\s*(.*)/;
315 }
316 warn "adopted '$title' as title for $podfile\n"
317 if $verbose and $title;
318 }
54310121 319 unless ($title) {
3e3baf6d 320 warn "$0: no title for $podfile";
54310121 321 $podfile =~ /^(.*)(\.[^.\/]+)?$/;
322 $title = ($podfile eq "-" ? 'No Title' : $1);
3e3baf6d 323 warn "using $title" if $verbose;
54310121 324 }
325 print HTML <<END_OF_HEAD;
326 <HTML>
327 <HEAD>
328 <TITLE>$title</TITLE>
329 </HEAD>
330
331 <BODY>
332
333END_OF_HEAD
334
3e3baf6d 335 # load/reload/validate/cache %pages and %items
336 get_cache($dircache, $itemcache, \@podpath, $podroot, $recurse);
54310121 337
338 # scan the pod for =item directives
339 scan_items("", \%items, @poddata);
340
341 # put an index at the top of the file. note, if $doindex is 0 we
342 # still generate an index, but surround it with an html comment.
343 # that way some other program can extract it if desired.
344 $index =~ s/--+/-/g;
345 print HTML "<!-- INDEX BEGIN -->\n";
346 print HTML "<!--\n" unless $doindex;
347 print HTML $index;
348 print HTML "-->\n" unless $doindex;
349 print HTML "<!-- INDEX END -->\n\n";
350 print HTML "<HR>\n" if $doindex;
351
352 # now convert this file
353 warn "Converting input file\n" if $verbose;
354 foreach my $i (0..$#poddata) {
355 $_ = $poddata[$i];
356 $paragraph = $i+1;
357 if (/^(=.*)/s) { # is it a pod directive?
358 $ignore = 0;
359 $_ = $1;
360 if (/^=begin\s+(\S+)\s*(.*)/si) {# =begin
361 process_begin($1, $2);
362 } elsif (/^=end\s+(\S+)\s*(.*)/si) {# =end
363 process_end($1, $2);
364 } elsif (/^=cut/) { # =cut
365 process_cut();
366 } elsif (/^=pod/) { # =pod
367 process_pod();
368 } else {
369 next if @begin_stack && $begin_stack[-1] ne 'html';
370
371 if (/^=(head[1-6])\s+(.*)/s) { # =head[1-6] heading
372 process_head($1, $2);
373 } elsif (/^=item\s*(.*)/sm) { # =item text
374 process_item($1);
375 } elsif (/^=over\s*(.*)/) { # =over N
376 process_over();
377 } elsif (/^=back/) { # =back
378 process_back();
379 } elsif (/^=for\s+(\S+)\s+(.*)/si) {# =for
380 process_for($1,$2);
381 } else {
382 /^=(\S*)\s*/;
383 warn "$0: $podfile: unknown pod directive '$1' in "
384 . "paragraph $paragraph. ignoring.\n";
385 }
386 }
387 $top = 0;
388 }
389 else {
390 next if $ignore;
391 next if @begin_stack && $begin_stack[-1] ne 'html';
392 my $text = $_;
393 process_text(\$text, 1);
394 print HTML "$text\n<P>\n\n";
395 }
396 }
397
398 # finish off any pending directives
399 finish_list();
400 print HTML <<END_OF_TAIL;
401 </BODY>
402
403 </HTML>
404END_OF_TAIL
405
406 # close the html file
407 close(HTML);
408
409 warn "Finished\n" if $verbose;
410}
411
412##############################################################################
413
414my $usage; # see below
415sub usage {
416 my $podfile = shift;
417 warn "$0: $podfile: @_\n" if @_;
418 die $usage;
419}
420
421$usage =<<END_OF_USAGE;
422Usage: $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
423 --podpath=<name>:...:<name> --podroot=<name>
424 --libpods=<name>:...:<name> --recurse --verbose --index
425 --netscape --norecurse --noindex
426
427 --flush - flushes the item and directory caches.
428 --help - prints this message.
429 --htmlroot - http-server base directory from which all relative paths
430 in podpath stem (default is /).
431 --index - generate an index at the top of the resulting html
432 (default).
433 --infile - filename for the pod to convert (input taken from stdin
434 by default).
435 --libpods - colon-separated list of pages to search for =item pod
436 directives in as targets of C<> and implicit links (empty
437 by default). note, these are not filenames, but rather
438 page names like those that appear in L<> links.
439 --netscape - will use netscape html directives when applicable.
440 --nonetscape - will not use netscape directives (default).
441 --outfile - filename for the resulting html file (output sent to
442 stdout by default).
443 --podpath - colon-separated list of directories containing library
444 pods. empty by default.
445 --podroot - filesystem base directory from which all relative paths
446 in podpath stem (default is .).
447 --noindex - don't generate an index at the top of the resulting html.
448 --norecurse - don't recurse on those subdirectories listed in podpath.
449 --recurse - recurse on those subdirectories listed in podpath
450 (default behavior).
451 --title - title that will appear in resulting html file.
452 --verbose - self-explanatory
453
454END_OF_USAGE
455
456sub parse_command_line {
457 my ($opt_flush,$opt_help,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,$opt_netscape,$opt_outfile,$opt_podpath,$opt_podroot,$opt_norecurse,$opt_recurse,$opt_title,$opt_verbose);
458 my $result = GetOptions(
459 'flush' => \$opt_flush,
460 'help' => \$opt_help,
461 'htmlroot=s' => \$opt_htmlroot,
462 'index!' => \$opt_index,
463 'infile=s' => \$opt_infile,
464 'libpods=s' => \$opt_libpods,
465 'netscape!' => \$opt_netscape,
466 'outfile=s' => \$opt_outfile,
467 'podpath=s' => \$opt_podpath,
468 'podroot=s' => \$opt_podroot,
469 'norecurse' => \$opt_norecurse,
470 'recurse!' => \$opt_recurse,
471 'title=s' => \$opt_title,
472 'verbose' => \$opt_verbose,
473 );
474 usage("-", "invalid parameters") if not $result;
475
476 usage("-") if defined $opt_help; # see if the user asked for help
477 $opt_help = ""; # just to make -w shut-up.
478
479 $podfile = $opt_infile if defined $opt_infile;
480 $htmlfile = $opt_outfile if defined $opt_outfile;
481
482 @podpath = split(":", $opt_podpath) if defined $opt_podpath;
483 @libpods = split(":", $opt_libpods) if defined $opt_libpods;
484
485 warn "Flushing item and directory caches\n"
486 if $opt_verbose && defined $opt_flush;
487 unlink($dircache, $itemcache) if defined $opt_flush;
488
489 $htmlroot = $opt_htmlroot if defined $opt_htmlroot;
490 $podroot = $opt_podroot if defined $opt_podroot;
491
492 $doindex = $opt_index if defined $opt_index;
493 $recurse = $opt_recurse if defined $opt_recurse;
494 $title = $opt_title if defined $opt_title;
495 $verbose = defined $opt_verbose ? 1 : 0;
496 $netscape = $opt_netscape if defined $opt_netscape;
497}
498
3e3baf6d 499
500my $saved_cache_key;
501
502sub get_cache {
503 my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_;
504 my @cache_key_args = @_;
505
506 # A first-level cache:
507 # Don't bother reading the cache files if they still apply
508 # and haven't changed since we last read them.
509
510 my $this_cache_key = cache_key(@cache_key_args);
511
512 return if $saved_cache_key and $this_cache_key eq $saved_cache_key;
513
514 # load the cache of %pages and %items if possible. $tests will be
515 # non-zero if successful.
516 my $tests = 0;
517 if (-f $dircache && -f $itemcache) {
518 warn "scanning for item cache\n" if $verbose;
519 $tests = load_cache($dircache, $itemcache, $podpath, $podroot);
520 }
521
522 # if we didn't succeed in loading the cache then we must (re)build
523 # %pages and %items.
524 if (!$tests) {
525 warn "scanning directories in pod-path\n" if $verbose;
526 scan_podpath($podroot, $recurse, 0);
527 }
528 $saved_cache_key = cache_key(@cache_key_args);
529}
530
531sub cache_key {
532 my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_;
533 return join('!', $dircache, $itemcache, $recurse,
534 @$podpath, $podroot, stat($dircache), stat($itemcache));
535}
536
54310121 537#
3e3baf6d 538# load_cache - tries to find if the caches stored in $dircache and $itemcache
54310121 539# are valid caches of %pages and %items. if they are valid then it loads
540# them and returns a non-zero value.
541#
3e3baf6d 542
543sub load_cache {
54310121 544 my($dircache, $itemcache, $podpath, $podroot) = @_;
545 my($tests);
546 local $_;
547
548 $tests = 0;
549
550 open(CACHE, "<$itemcache") ||
551 die "$0: error opening $itemcache for reading: $!\n";
552 $/ = "\n";
553
554 # is it the same podpath?
555 $_ = <CACHE>;
556 chomp($_);
3e3baf6d 557 $tests++ if (join(":", @$podpath) eq $_);
54310121 558
559 # is it the same podroot?
560 $_ = <CACHE>;
561 chomp($_);
562 $tests++ if ($podroot eq $_);
563
564 # load the cache if its good
565 if ($tests != 2) {
566 close(CACHE);
54310121 567 return 0;
568 }
569
570 warn "loading item cache\n" if $verbose;
571 while (<CACHE>) {
572 /(.*?) (.*)$/;
573 $items{$1} = $2;
574 }
575 close(CACHE);
576
577 warn "scanning for directory cache\n" if $verbose;
578 open(CACHE, "<$dircache") ||
579 die "$0: error opening $dircache for reading: $!\n";
580 $/ = "\n";
581 $tests = 0;
582
583 # is it the same podpath?
584 $_ = <CACHE>;
585 chomp($_);
3e3baf6d 586 $tests++ if (join(":", @$podpath) eq $_);
54310121 587
588 # is it the same podroot?
589 $_ = <CACHE>;
590 chomp($_);
591 $tests++ if ($podroot eq $_);
592
593 # load the cache if its good
594 if ($tests != 2) {
595 close(CACHE);
54310121 596 return 0;
597 }
598
599 warn "loading directory cache\n" if $verbose;
600 while (<CACHE>) {
601 /(.*?) (.*)$/;
602 $pages{$1} = $2;
603 }
604
605 close(CACHE);
606
607 return 1;
608}
609
610#
611# scan_podpath - scans the directories specified in @podpath for directories,
612# .pod files, and .pm files. it also scans the pod files specified in
613# @libpods for =item directives.
614#
615sub scan_podpath {
3e3baf6d 616 my($podroot, $recurse, $append) = @_;
54310121 617 my($pwd, $dir);
618 my($libpod, $dirname, $pod, @files, @poddata);
619
3e3baf6d 620 unless($append) {
621 %items = ();
622 %pages = ();
623 }
624
54310121 625 # scan each directory listed in @podpath
626 $pwd = getcwd();
627 chdir($podroot)
628 || die "$0: error changing to directory $podroot: $!\n";
629 foreach $dir (@podpath) {
630 scan_dir($dir, $recurse);
631 }
632
633 # scan the pods listed in @libpods for =item directives
634 foreach $libpod (@libpods) {
635 # if the page isn't defined then we won't know where to find it
636 # on the system.
637 next unless defined $pages{$libpod} && $pages{$libpod};
638
639 # if there is a directory then use the .pod and .pm files within it.
640 if ($pages{$libpod} =~ /([^:]*[^(\.pod|\.pm)]):/) {
641 # find all the .pod and .pm files within the directory
642 $dirname = $1;
643 opendir(DIR, $dirname) ||
644 die "$0: error opening directory $dirname: $!\n";
645 @files = grep(/(\.pod|\.pm)$/ && ! -d $_, readdir(DIR));
646 closedir(DIR);
647
648 # scan each .pod and .pm file for =item directives
649 foreach $pod (@files) {
650 open(POD, "<$dirname/$pod") ||
651 die "$0: error opening $dirname/$pod for input: $!\n";
652 @poddata = <POD>;
653 close(POD);
654
655 scan_items("$dirname/$pod", @poddata);
656 }
657
658 # use the names of files as =item directives too.
659 foreach $pod (@files) {
660 $pod =~ /^(.*)(\.pod|\.pm)$/;
661 $items{$1} = "$dirname/$1.html" if $1;
662 }
663 } elsif ($pages{$libpod} =~ /([^:]*\.pod):/ ||
664 $pages{$libpod} =~ /([^:]*\.pm):/) {
665 # scan the .pod or .pm file for =item directives
666 $pod = $1;
667 open(POD, "<$pod") ||
668 die "$0: error opening $pod for input: $!\n";
669 @poddata = <POD>;
670 close(POD);
671
672 scan_items("$pod", @poddata);
673 } else {
674 warn "$0: shouldn't be here (line ".__LINE__."\n";
675 }
676 }
677 @poddata = (); # clean-up a bit
678
679 chdir($pwd)
680 || die "$0: error changing to directory $pwd: $!\n";
681
682 # cache the item list for later use
683 warn "caching items for later use\n" if $verbose;
684 open(CACHE, ">$itemcache") ||
685 die "$0: error open $itemcache for writing: $!\n";
686
687 print CACHE join(":", @podpath) . "\n$podroot\n";
688 foreach my $key (keys %items) {
689 print CACHE "$key $items{$key}\n";
690 }
691
692 close(CACHE);
693
694 # cache the directory list for later use
695 warn "caching directories for later use\n" if $verbose;
696 open(CACHE, ">$dircache") ||
697 die "$0: error open $dircache for writing: $!\n";
698
699 print CACHE join(":", @podpath) . "\n$podroot\n";
700 foreach my $key (keys %pages) {
701 print CACHE "$key $pages{$key}\n";
702 }
703
704 close(CACHE);
705}
706
707#
708# scan_dir - scans the directory specified in $dir for subdirectories, .pod
709# files, and .pm files. notes those that it finds. this information will
710# be used later in order to figure out where the pages specified in L<>
711# links are on the filesystem.
712#
713sub scan_dir {
714 my($dir, $recurse) = @_;
715 my($t, @subdirs, @pods, $pod, $dirname, @dirs);
716 local $_;
717
718 @subdirs = ();
719 @pods = ();
720
721 opendir(DIR, $dir) ||
722 die "$0: error opening directory $dir: $!\n";
723 while (defined($_ = readdir(DIR))) {
724 if (-d "$dir/$_" && $_ ne "." && $_ ne "..") { # directory
725 $pages{$_} = "" unless defined $pages{$_};
726 $pages{$_} .= "$dir/$_:";
727 push(@subdirs, $_);
728 } elsif (/\.pod$/) { # .pod
729 s/\.pod$//;
730 $pages{$_} = "" unless defined $pages{$_};
731 $pages{$_} .= "$dir/$_.pod:";
732 push(@pods, "$dir/$_.pod");
733 } elsif (/\.pm$/) { # .pm
734 s/\.pm$//;
735 $pages{$_} = "" unless defined $pages{$_};
736 $pages{$_} .= "$dir/$_.pm:";
737 push(@pods, "$dir/$_.pm");
738 }
739 }
740 closedir(DIR);
741
742 # recurse on the subdirectories if necessary
743 if ($recurse) {
744 foreach my $subdir (@subdirs) {
745 scan_dir("$dir/$subdir", $recurse);
746 }
747 }
748}
749
750#
751# scan_headings - scan a pod file for head[1-6] tags, note the tags, and
752# build an index.
753#
754sub scan_headings {
755 my($sections, @data) = @_;
756 my($tag, $which_head, $title, $listdepth, $index);
757
be173d55 758 # here we need local $ignore = 0;
759 # unfortunately, we can't have it, because $ignore is lexical
760 $ignore = 0;
761
54310121 762 $listdepth = 0;
763 $index = "";
764
765 # scan for =head directives, note their name, and build an index
766 # pointing to each of them.
767 foreach my $line (@data) {
bb9460ed 768 if ($line =~ /^=(head)([1-6])\s+(.*)/) {
54310121 769 ($tag,$which_head, $title) = ($1,$2,$3);
770 chomp($title);
771 $$sections{htmlify(0,$title)} = 1;
772
102c538a 773 while ($which_head != $listdepth) {
774 if ($which_head > $listdepth) {
775 $index .= "\n" . ("\t" x $listdepth) . "<UL>\n";
776 $listdepth++;
777 } elsif ($which_head < $listdepth) {
778 $listdepth--;
779 $index .= "\n" . ("\t" x $listdepth) . "</UL>\n";
780 }
54310121 781 }
54310121 782
783 $index .= "\n" . ("\t" x $listdepth) . "<LI>" .
be173d55 784 "<A HREF=\"#" . htmlify(0,$title) . "\">" .
785 process_text(\$title, 0) . "</A>";
54310121 786 }
787 }
788
789 # finish off the lists
790 while ($listdepth--) {
791 $index .= "\n" . ("\t" x $listdepth) . "</UL>\n";
792 }
793
794 # get rid of bogus lists
795 $index =~ s,\t*<UL>\s*</UL>\n,,g;
796
bb9460ed 797 $ignore = 1; # restore old value;
be173d55 798
54310121 799 return $index;
800}
801
802#
803# scan_items - scans the pod specified by $pod for =item directives. we
804# will use this information later on in resolving C<> links.
805#
806sub scan_items {
807 my($pod, @poddata) = @_;
808 my($i, $item);
809 local $_;
810
811 $pod =~ s/\.pod$//;
812 $pod .= ".html" if $pod;
813
814 foreach $i (0..$#poddata) {
815 $_ = $poddata[$i];
816
817 # remove any formatting instructions
818 s,[A-Z]<([^<>]*)>,$1,g;
819
820 # figure out what kind of item it is and get the first word of
821 # it's name.
822 if (/^=item\s+(\w*)\s*.*$/s) {
823 if ($1 eq "*") { # bullet list
824 /\A=item\s+\*\s*(.*?)\s*\Z/s;
825 $item = $1;
826 } elsif ($1 =~ /^[0-9]+/) { # numbered list
827 /\A=item\s+[0-9]+\.?(.*?)\s*\Z/s;
828 $item = $1;
829 } else {
830# /\A=item\s+(.*?)\s*\Z/s;
831 /\A=item\s+(\w*)/s;
832 $item = $1;
833 }
834
835 $items{$item} = "$pod" if $item;
836 }
837 }
838}
839
840#
841# process_head - convert a pod head[1-6] tag and convert it to HTML format.
842#
843sub process_head {
844 my($tag, $heading) = @_;
845 my $firstword;
846
847 # figure out the level of the =head
848 $tag =~ /head([1-6])/;
849 my $level = $1;
850
851 # can't have a heading full of spaces and speechmarks and so on
852 $firstword = $heading; $firstword =~ s/\s*(\w+)\s.*/$1/;
853
854 print HTML "<P>\n" unless $listlevel;
855 print HTML "<HR>\n" unless $listlevel || $top;
856 print HTML "<H$level>"; # unless $listlevel;
857 #print HTML "<H$level>" unless $listlevel;
be173d55 858 my $convert = $heading; process_text(\$convert, 0);
54310121 859 print HTML '<A NAME="' . htmlify(0,$heading) . "\">$convert</A>";
860 print HTML "</H$level>"; # unless $listlevel;
861 print HTML "\n";
862}
863
864#
865# process_item - convert a pod item tag and convert it to HTML format.
866#
867sub process_item {
868 my $text = $_[0];
869 my($i, $quote, $name);
870
871 my $need_preamble = 0;
872 my $this_entry;
873
874
875 # lots of documents start a list without doing an =over. this is
876 # bad! but, the proper thing to do seems to be to just assume
877 # they did do an =over. so warn them once and then continue.
878 warn "$0: $podfile: unexpected =item directive in paragraph $paragraph. ignoring.\n"
879 unless $listlevel;
880 process_over() unless $listlevel;
881
882 return unless $listlevel;
883
884 # remove formatting instructions from the text
885 1 while $text =~ s/[A-Z]<([^<>]*)>/$1/g;
886 pre_escape(\$text);
887
888 $need_preamble = $items_seen[$listlevel]++ == 0;
889
890 # check if this is the first =item after an =over
891 $i = $listlevel - 1;
892 my $need_new = $listlevel >= @listitem;
893
894 if ($text =~ /\A\*/) { # bullet
895
896 if ($need_preamble) {
897 push(@listend, "</UL>");
898 print HTML "<UL>\n";
899 }
900
901 print HTML "<LI><STRONG>";
902 $text =~ /\A\*\s*(.*)\Z/s;
903 print HTML "<A NAME=\"item_" . htmlify(1,$1) . "\">" if $1 && !$items_named{$1}++;
904 $quote = 1;
905 #print HTML process_puretext($1, \$quote);
906 print HTML $1;
907 print HTML "</A>" if $1;
908 print HTML "</STRONG>";
909
910 } elsif ($text =~ /\A[0-9#]+/) { # numbered list
911
912 if ($need_preamble) {
913 push(@listend, "</OL>");
914 print HTML "<OL>\n";
915 }
916
917 print HTML "<LI><STRONG>";
918 $text =~ /\A[0-9]+\.?(.*)\Z/s;
919 print HTML "<A NAME=\"item_" . htmlify(0,$1) . "\">" if $1;
920 $quote = 1;
921 #print HTML process_puretext($1, \$quote);
922 print HTML $1 if $1;
923 print HTML "</A>" if $1;
924 print HTML "</STRONG>";
925
926 } else { # all others
927
928 if ($need_preamble) {
929 push(@listend, '</DL>');
930 print HTML "<DL>\n";
931 }
932
933 print HTML "<DT><STRONG>";
934 print HTML "<A NAME=\"item_" . htmlify(1,$text) . "\">"
935 if $text && !$items_named{($text =~ /(\S+)/)[0]}++;
936 # preceding craziness so that the duplicate leading bits in
937 # perlfunc work to find just the first one. otherwise
938 # open etc would have many names
939 $quote = 1;
940 #print HTML process_puretext($text, \$quote);
941 print HTML $text;
942 print HTML "</A>" if $text;
943 print HTML "</STRONG>";
944
945 print HTML '<DD>';
946 }
947
948 print HTML "\n";
949}
950
951#
952# process_over - process a pod over tag and start a corresponding HTML
953# list.
954#
955sub process_over {
956 # start a new list
957 $listlevel++;
958}
959
960#
961# process_back - process a pod back tag and convert it to HTML format.
962#
963sub process_back {
2ceaccd7 964 warn "$0: $podfile: unexpected =back directive in paragraph $paragraph. ignoring.\n"
54310121 965 unless $listlevel;
966 return unless $listlevel;
967
968 # close off the list. note, I check to see if $listend[$listlevel] is
969 # defined because an =item directive may have never appeared and thus
970 # $listend[$listlevel] may have never been initialized.
971 $listlevel--;
972 print HTML $listend[$listlevel] if defined $listend[$listlevel];
973 print HTML "\n";
974
975 # don't need the corresponding perl code anymore
976 pop(@listitem);
977 pop(@listdata);
978 pop(@listend);
979
980 pop(@items_seen);
981}
982
983#
984# process_cut - process a pod cut tag, thus stop ignoring pod directives.
985#
986sub process_cut {
987 $ignore = 1;
988}
989
990#
991# process_pod - process a pod pod tag, thus ignore pod directives until we see a
992# corresponding cut.
993#
994sub process_pod {
995 # no need to set $ignore to 0 cause the main loop did it
996}
997
998#
999# process_for - process a =for pod tag. if it's for html, split
1000# it out verbatim, otherwise ignore it.
1001#
1002sub process_for {
1003 my($whom, $text) = @_;
1004 if ( $whom =~ /^(pod2)?html$/i) {
1005 print HTML $text;
1006 }
1007}
1008
1009#
1010# process_begin - process a =begin pod tag. this pushes
1011# whom we're beginning on the begin stack. if there's a
1012# begin stack, we only print if it us.
1013#
1014sub process_begin {
1015 my($whom, $text) = @_;
1016 $whom = lc($whom);
1017 push (@begin_stack, $whom);
1018 if ( $whom =~ /^(pod2)?html$/) {
1019 print HTML $text if $text;
1020 }
1021}
1022
1023#
1024# process_end - process a =end pod tag. pop the
1025# begin stack. die if we're mismatched.
1026#
1027sub process_end {
1028 my($whom, $text) = @_;
1029 $whom = lc($whom);
1030 if ($begin_stack[-1] ne $whom ) {
1031 die "Unmatched begin/end at chunk $paragraph\n"
1032 }
1033 pop @begin_stack;
1034}
1035
1036#
1037# process_text - handles plaintext that appears in the input pod file.
1038# there may be pod commands embedded within the text so those must be
1039# converted to html commands.
1040#
1041sub process_text {
1042 my($text, $escapeQuotes) = @_;
1043 my($result, $rest, $s1, $s2, $s3, $s4, $match, $bf);
1044 my($podcommand, $params, $tag, $quote);
1045
1046 return if $ignore;
1047
1048 $quote = 0; # status of double-quote conversion
1049 $result = "";
1050 $rest = $$text;
1051
1052 if ($rest =~ /^\s+/) { # preformatted text, no pod directives
be173d55 1053 $rest =~ s/\n+\Z//;
1054 $rest =~ s#.*#
1055 my $line = $&;
1056 1 while $line =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;
1057 $line;
1058 #eg;
54310121 1059
1060 $rest =~ s/&/&amp;/g;
1061 $rest =~ s/</&lt;/g;
1062 $rest =~ s/>/&gt;/g;
1063 $rest =~ s/"/&quot;/g;
1064
1065 # try and create links for all occurrences of perl.* within
1066 # the preformatted text.
1067 $rest =~ s{
1068 (\s*)(perl\w+)
1069 }{
1070 if (defined $pages{$2}) { # is a link
1071 qq($1<A HREF="$htmlroot/$pages{$2}">$2</A>);
39e571d4 1072 } elsif (defined $pages{dosify($2)}) { # is a link
1073 qq($1<A HREF="$htmlroot/$pages{dosify($2)}">$2</A>);
54310121 1074 } else {
1075 "$1$2";
1076 }
1077 }xeg;
1078 $rest =~ s/(<A HREF=)([^>:]*:)?([^>:]*)\.pod:([^>:]*:)?/$1$3.html/g;
1079
1080 my $urls = '(' . join ('|', qw{
1081 http
1082 telnet
1083 mailto
1084 news
1085 gopher
1086 file
1087 wais
1088 ftp
1089 } )
1090 . ')';
1091
1092 my $ltrs = '\w';
1093 my $gunk = '/#~:.?+=&%@!\-';
1094 my $punc = '.:?\-';
1095 my $any = "${ltrs}${gunk}${punc}";
1096
1097 $rest =~ s{
1098 \b # start at word boundary
1099 ( # begin $1 {
1100 $urls : # need resource and a colon
1101 [$any] +? # followed by on or more
1102 # of any valid character, but
1103 # be conservative and take only
1104 # what you need to....
1105 ) # end $1 }
1106 (?= # look-ahead non-consumptive assertion
1107 [$punc]* # either 0 or more puntuation
1108 [^$any] # followed by a non-url char
1109 | # or else
1110 $ # then end of the string
1111 )
1112 }{<A HREF="$1">$1</A>}igox;
1113
1114 $result = "<PRE>" # text should be as it is (verbatim)
1115 . "$rest\n"
1116 . "</PRE>\n";
1117 } else { # formatted text
1118 # parse through the string, stopping each time we find a
1119 # pod-escape. once the string has been throughly processed
1120 # we can output it.
ec978fad 1121 while (length $rest) {
54310121 1122 # check to see if there are any possible pod directives in
1123 # the remaining part of the text.
1124 if ($rest =~ m/[BCEIFLSZ]</) {
1125 warn "\$rest\t= $rest\n" unless
1126 $rest =~ /\A
1127 ([^<]*?)
1128 ([BCEIFLSZ]?)
1129 <
1130 (.*)\Z/xs;
1131
1132 $s1 = $1; # pure text
1133 $s2 = $2; # the type of pod-escape that follows
1134 $s3 = '<'; # '<'
1135 $s4 = $3; # the rest of the string
1136 } else {
1137 $s1 = $rest;
1138 $s2 = "";
1139 $s3 = "";
1140 $s4 = "";
1141 }
1142
1143 if ($s3 eq '<' && $s2) { # a pod-escape
1144 $result .= ($escapeQuotes ? process_puretext($s1, \$quote) : $s1);
1145 $podcommand = "$s2<";
1146 $rest = $s4;
1147
1148 # find the matching '>'
1149 $match = 1;
1150 $bf = 0;
1151 while ($match && !$bf) {
1152 $bf = 1;
1153 if ($rest =~ /\A([^<>]*[BCEIFLSZ]<)(.*)\Z/s) {
1154 $bf = 0;
1155 $match++;
1156 $podcommand .= $1;
1157 $rest = $2;
1158 } elsif ($rest =~ /\A([^>]*>)(.*)\Z/s) {
1159 $bf = 0;
1160 $match--;
1161 $podcommand .= $1;
1162 $rest = $2;
1163 }
1164 }
1165
1166 if ($match != 0) {
1167 warn <<WARN;
1168$0: $podfile: cannot find matching > for $s2 in paragraph $paragraph.
1169WARN
1170 $result .= substr $podcommand, 0, 2;
1171 $rest = substr($podcommand, 2) . $rest;
1172 next;
1173 }
1174
1175 # pull out the parameters to the pod-escape
1176 $podcommand =~ /^([BCFEILSZ]?)<(.*)>$/s;
1177 $tag = $1;
1178 $params = $2;
1179
1180 # process the text within the pod-escape so that any escapes
1181 # which must occur do.
1182 process_text(\$params, 0) unless $tag eq 'L';
1183
1184 $s1 = $params;
1185 if (!$tag || $tag eq " ") { # <> : no tag
1186 $s1 = "&lt;$params&gt;";
1187 } elsif ($tag eq "L") { # L<> : link
1188 $s1 = process_L($params);
1189 } elsif ($tag eq "I" || # I<> : italicize text
1190 $tag eq "B" || # B<> : bold text
1191 $tag eq "F") { # F<> : file specification
1192 $s1 = process_BFI($tag, $params);
1193 } elsif ($tag eq "C") { # C<> : literal code
1194 $s1 = process_C($params, 1);
1195 } elsif ($tag eq "E") { # E<> : escape
1196 $s1 = process_E($params);
1197 } elsif ($tag eq "Z") { # Z<> : zero-width character
1198 $s1 = process_Z($params);
1199 } elsif ($tag eq "S") { # S<> : non-breaking space
1200 $s1 = process_S($params);
1201 } elsif ($tag eq "X") { # S<> : non-breaking space
1202 $s1 = process_X($params);
1203 } else {
1204 warn "$0: $podfile: unhandled tag '$tag' in paragraph $paragraph\n";
1205 }
1206
1207 $result .= "$s1";
1208 } else {
1209 # for pure text we must deal with implicit links and
1210 # double-quotes among other things.
1211 $result .= ($escapeQuotes ? process_puretext("$s1$s2$s3", \$quote) : "$s1$s2$s3");
1212 $rest = $s4;
1213 }
1214 }
1215 }
1216 $$text = $result;
1217}
1218
1219sub html_escape {
1220 my $rest = $_[0];
1221 $rest =~ s/&/&amp;/g;
1222 $rest =~ s/</&lt;/g;
1223 $rest =~ s/>/&gt;/g;
1224 $rest =~ s/"/&quot;/g;
1225 return $rest;
1226}
1227
1228#
1229# process_puretext - process pure text (without pod-escapes) converting
1230# double-quotes and handling implicit C<> links.
1231#
1232sub process_puretext {
1233 my($text, $quote) = @_;
1234 my(@words, $result, $rest, $lead, $trail);
1235
1236 # convert double-quotes to single-quotes
1237 $text =~ s/\A([^"]*)"/$1''/s if $$quote;
1238 while ($text =~ s/\A([^"]*)["]([^"]*)["]/$1``$2''/sg) {}
1239
1240 $$quote = ($text =~ m/"/ ? 1 : 0);
1241 $text =~ s/\A([^"]*)"/$1``/s if $$quote;
1242
1243 # keep track of leading and trailing white-space
1244 $lead = ($text =~ /\A(\s*)/s ? $1 : "");
1245 $trail = ($text =~ /(\s*)\Z/s ? $1 : "");
1246
1247 # collapse all white space into a single space
1248 $text =~ s/\s+/ /g;
1249 @words = split(" ", $text);
1250
1251 # process each word individually
1252 foreach my $word (@words) {
1253 # see if we can infer a link
1254 if ($word =~ /^\w+\(/) {
1255 # has parenthesis so should have been a C<> ref
1256 $word = process_C($word);
1257# $word =~ /^[^()]*]\(/;
1258# if (defined $items{$1} && $items{$1}) {
1259# $word = "\n<CODE><A HREF=\"$htmlroot/$items{$1}#item_"
1260# . htmlify(0,$word)
1261# . "\">$word</A></CODE>";
1262# } elsif (defined $items{$word} && $items{$word}) {
1263# $word = "\n<CODE><A HREF=\"$htmlroot/$items{$word}#item_"
1264# . htmlify(0,$word)
1265# . "\">$word</A></CODE>";
1266# } else {
1267# $word = "\n<CODE><A HREF=\"#item_"
1268# . htmlify(0,$word)
1269# . "\">$word</A></CODE>";
1270# }
1271 } elsif ($word =~ /^[\$\@%&*]+\w+$/) {
1272 # perl variables, should be a C<> ref
1273 $word = process_C($word, 1);
1274 } elsif ($word =~ m,^\w+://\w,) {
1275 # looks like a URL
1276 $word = qq(<A HREF="$word">$word</A>);
1277 } elsif ($word =~ /[\w.-]+\@\w+\.\w/) {
1278 # looks like an e-mail address
1279 $word = qq(<A HREF="MAILTO:$word">$word</A>);
1280 } elsif ($word !~ /[a-z]/ && $word =~ /[A-Z]/) { # all uppercase?
1281 $word = html_escape($word) if $word =~ /[&<>]/;
1282 $word = "\n<FONT SIZE=-1>$word</FONT>" if $netscape;
1283 } else {
1284 $word = html_escape($word) if $word =~ /[&<>]/;
1285 }
1286 }
1287
1288 # build a new string based upon our conversion
1289 $result = "";
1290 $rest = join(" ", @words);
1291 while (length($rest) > 75) {
1292 if ( $rest =~ m/^(.{0,75})\s(.*?)$/o ||
1293 $rest =~ m/^(\S*)\s(.*?)$/o) {
1294
1295 $result .= "$1\n";
1296 $rest = $2;
1297 } else {
1298 $result .= "$rest\n";
1299 $rest = "";
1300 }
1301 }
1302 $result .= $rest if $rest;
1303
1304 # restore the leading and trailing white-space
1305 $result = "$lead$result$trail";
1306
1307 return $result;
1308}
1309
1310#
1311# pre_escape - convert & in text to $amp;
1312#
1313sub pre_escape {
1314 my($str) = @_;
1315
1316 $$str =~ s,&,&amp;,g;
1317}
1318
1319#
39e571d4 1320# dosify - convert filenames to 8.3
1321#
1322sub dosify {
1323 my($str) = @_;
1324 if ($Is83) {
1325 $str = lc $str;
1326 $str =~ s/(\.\w+)/substr ($1,0,4)/ge;
1327 $str =~ s/(\w+)/substr ($1,0,8)/ge;
1328 }
1329 return $str;
1330}
1331
1332#
54310121 1333# process_L - convert a pod L<> directive to a corresponding HTML link.
1334# most of the links made are inferred rather than known about directly
1335# (i.e it's not known whether the =head\d section exists in the target file,
1336# or whether a .pod file exists in the case of split files). however, the
1337# guessing usually works.
1338#
1339# Unlike the other directives, this should be called with an unprocessed
1340# string, else tags in the link won't be matched.
1341#
1342sub process_L {
1343 my($str) = @_;
39e571d4 1344 my($s1, $s2, $linktext, $page, $page83, $section, $link); # work strings
54310121 1345
1346 $str =~ s/\n/ /g; # undo word-wrapped tags
1347 $s1 = $str;
1348 for ($s1) {
b74bceb9 1349 # LREF: a la HREF L<show this text|man/section>
1350 $linktext = $1 if s:^([^|]+)\|::;
1351
54310121 1352 # a :: acts like a /
1353 s,::,/,;
1354
1355 # make sure sections start with a /
1356 s,^",/",g;
1357 s,^,/,g if (!m,/, && / /);
1358
1359 # check if there's a section specified
1360 if (m,^(.*?)/"?(.*?)"?$,) { # yes
1361 ($page, $section) = ($1, $2);
1362 } else { # no
1363 ($page, $section) = ($str, "");
1364 }
1365
1366 # check if we know that this is a section in this page
1367 if (!defined $pages{$page} && defined $sections{$page}) {
1368 $section = $page;
1369 $page = "";
1370 }
1371 }
1372
39e571d4 1373 $page83=dosify($page);
1374 $page=$page83 if (defined $pages{$page83});
54310121 1375 if ($page eq "") {
1376 $link = "#" . htmlify(0,$section);
b74bceb9 1377 $linktext = $section unless defined($linktext);
54310121 1378 } elsif (!defined $pages{$page}) {
1379 warn "$0: $podfile: cannot resolve L<$str> in paragraph $paragraph: no such page '$page'\n";
1380 $link = "";
b74bceb9 1381 $linktext = $page unless defined($linktext);
54310121 1382 } else {
b74bceb9 1383 $linktext = ($section ? "$section" : "the $page manpage") unless defined($linktext);
54310121 1384 $section = htmlify(0,$section) if $section ne "";
1385
1386 # if there is a directory by the name of the page, then assume that an
1387 # appropriate section will exist in the subdirectory
1388 if ($section ne "" && $pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) {
1389 $link = "$htmlroot/$1/$section.html";
1390
1391 # since there is no directory by the name of the page, the section will
1392 # have to exist within a .html of the same name. thus, make sure there
1393 # is a .pod or .pm that might become that .html
1394 } else {
1395 $section = "#$section";
1396 # check if there is a .pod with the page name
1397 if ($pages{$page} =~ /([^:]*)\.pod:/) {
1398 $link = "$htmlroot/$1.html$section";
1399 } elsif ($pages{$page} =~ /([^:]*)\.pm:/) {
1400 $link = "$htmlroot/$1.html$section";
1401 } else {
1402 warn "$0: $podfile: cannot resolve L$str in paragraph $paragraph: ".
1403 "no .pod or .pm found\n";
1404 $link = "";
b74bceb9 1405 $linktext = $section unless defined($linktext);
54310121 1406 }
1407 }
1408 }
1409
1410 process_text(\$linktext, 0);
1411 if ($link) {
1412 $s1 = "<A HREF=\"$link\">$linktext</A>";
1413 } else {
1414 $s1 = "<EM>$linktext</EM>";
1415 }
1416 return $s1;
1417}
1418
1419#
1420# process_BFI - process any of the B<>, F<>, or I<> pod-escapes and
1421# convert them to corresponding HTML directives.
1422#
1423sub process_BFI {
1424 my($tag, $str) = @_;
1425 my($s1); # work string
1426 my(%repltext) = ( 'B' => 'STRONG',
1427 'F' => 'EM',
1428 'I' => 'EM');
1429
1430 # extract the modified text and convert to HTML
1431 $s1 = "<$repltext{$tag}>$str</$repltext{$tag}>";
1432 return $s1;
1433}
1434
1435#
1436# process_C - process the C<> pod-escape.
1437#
1438sub process_C {
1439 my($str, $doref) = @_;
1440 my($s1, $s2);
1441
1442 $s1 = $str;
1443 $s1 =~ s/\([^()]*\)//g; # delete parentheses
be173d55 1444 $s2 = $s1;
54310121 1445 $s1 =~ s/\W//g; # delete bogus characters
1446
1447 # if there was a pod file that we found earlier with an appropriate
1448 # =item directive, then create a link to that page.
1449 if ($doref && defined $items{$s1}) {
1450 $s1 = ($items{$s1} ?
1451 "<A HREF=\"$htmlroot/$items{$s1}#item_" . htmlify(0,$s2) . "\">$str</A>" :
1452 "<A HREF=\"#item_" . htmlify(0,$s2) . "\">$str</A>");
1453 $s1 =~ s,(perl\w+/(\S+)\.html)#item_\2\b,$1,;
1454 confess "s1 has space: $s1" if $s1 =~ /HREF="[^"]*\s[^"]*"/;
1455 } else {
1456 $s1 = "<CODE>$str</CODE>";
1457 # warn "$0: $podfile: cannot resolve C<$str> in paragraph $paragraph\n" if $verbose
1458 }
1459
1460
1461 return $s1;
1462}
1463
1464#
1465# process_E - process the E<> pod directive which seems to escape a character.
1466#
1467sub process_E {
1468 my($str) = @_;
1469
1470 for ($str) {
1471 s,([^/].*),\&$1\;,g;
1472 }
1473
1474 return $str;
1475}
1476
1477#
1478# process_Z - process the Z<> pod directive which really just amounts to
1479# ignoring it. this allows someone to start a paragraph with an =
1480#
1481sub process_Z {
1482 my($str) = @_;
1483
1484 # there is no equivalent in HTML for this so just ignore it.
1485 $str = "";
1486 return $str;
1487}
1488
1489#
1490# process_S - process the S<> pod directive which means to convert all
1491# spaces in the string to non-breaking spaces (in HTML-eze).
1492#
1493sub process_S {
1494 my($str) = @_;
1495
1496 # convert all spaces in the text to non-breaking spaces in HTML.
1497 $str =~ s/ /&nbsp;/g;
1498 return $str;
1499}
1500
1501#
1502# process_X - this is supposed to make an index entry. we'll just
1503# ignore it.
1504#
1505sub process_X {
1506 return '';
1507}
1508
1509
1510#
1511# finish_list - finish off any pending HTML lists. this should be called
1512# after the entire pod file has been read and converted.
1513#
1514sub finish_list {
1515 while ($listlevel >= 0) {
1516 print HTML "</DL>\n";
1517 $listlevel--;
1518 }
1519}
1520
1521#
1522# htmlify - converts a pod section specification to a suitable section
1523# specification for HTML. if first arg is 1, only takes 1st word.
1524#
1525sub htmlify {
1526 my($compact, $heading) = @_;
1527
1528 if ($compact) {
1529 $heading =~ /^(\w+)/;
1530 $heading = $1;
1531 }
1532
1533 # $heading = lc($heading);
1534 $heading =~ s/[^\w\s]/_/g;
1535 $heading =~ s/(\s+)/ /g;
1536 $heading =~ s/^\s*(.*?)\s*$/$1/s;
1537 $heading =~ s/ /_/g;
1538 $heading =~ s/\A(.{32}).*\Z/$1/s;
1539 $heading =~ s/\s+\Z//;
1540 $heading =~ s/_{2,}/_/g;
1541
1542 return $heading;
1543}
1544
1545BEGIN {
1546}
1547
15481;
1549
Unnamed repository; edit this file to name it for gitweb.