use strict;
use 5.6.0;
use HTML::Stream;
use Pod::Tree;
use Pod::Tree::HTML;
use Pod::Tree::PerlUtil;
package Pod::Tree::PerlLib;
use base qw(Pod::Tree::PerlUtil);
use constant COLUMN_WIDTH => 30;
sub new
{
my %defaults = (col_width => COLUMN_WIDTH,
bgcolor => '#ffffff',
text => '#000000');
my($class, $perl_dir, $html_dir, $link_map, %options) = @_;
my $options = { %defaults, %options, link_map => $link_map };
my %stop_files = map { $_ => 1 } qw(perllocal.pod);
my $perl_lib = { perl_dir => $perl_dir,
html_dir => $html_dir,
lib_dir => 'lib',
top_page => 'lib.html',
stop_files => \%stop_files,
options => $options };
bless $perl_lib, $class
}
sub scan
{
my($perl_lib, @dirs) = @_;
$perl_lib->report1("scan");
# Don't try to install PODs for modules on relative paths in @INC
# (Typically `.')
@dirs = grep { m(^/) } @dirs;
$perl_lib->_stop_dirs(@dirs);
for my $dir (@dirs)
{
$perl_lib->{find_dir} = $dir;
File::Find::find({wanted => sub {$perl_lib->_scan}, # Closures rock!
no_chdir => 1 },
$dir);
}
}
sub _stop_dirs
{
my($perl_lib, @dirs) = @_;
for my $dir (@dirs)
{
for my $stop_dir (@dirs)
{
$stop_dir =~ /^$dir./ and
$perl_lib->{stop_dir}{$dir}{$stop_dir} = 1;
}
}
}
sub _scan
{
my $perl_lib = shift;
my $source = $File::Find::name;
-d $source and $perl_lib->_scan_dir ($source);
-f $source and $perl_lib->_scan_file($source);
}
sub _scan_dir
{
my($perl_lib, $dir) = @_;
my $find_dir = $perl_lib->{find_dir};
if ($perl_lib->{stop_dir}{$find_dir}{$dir} or $dir =~ /pod$/)
{
$File::Find::prune = 1;
return;
}
my $html_dir = $perl_lib->{html_dir};
my $lib_dir = $perl_lib->{lib_dir};
$dir =~ s(^$find_dir)($html_dir/$lib_dir);
$perl_lib->mkdir($dir);
}
sub _scan_file
{
my($perl_lib, $source) = @_;
$source =~ m(\. (?: pl | pm | pod ) $ )x or return;
my $file = (split m(/), $source)[-1];
$perl_lib->{stop_files}{$file} and return;
my $module = $source;
my $find_dir = $perl_lib->{find_dir};
$module =~ s(^$find_dir/)();
$module =~ s( \.\w+$ )()x; # Foo/Bar
my $html_dir = $perl_lib->{html_dir};
my $lib_dir = $perl_lib->{lib_dir};
my $dest = "$html_dir/$lib_dir/$module.html";
my($name, $description) = $perl_lib->get_name($source);
$name or return;
$perl_lib->report2($name);
my $href = "$module.html";
my $link = "$lib_dir/$module";
my $entry = { source => $source, # .../Foo/Bar.pm
dest => $dest, # .../html/lib/Foo/Bar.html
href => $href, # Foo/Bar.html
description => $description };
$perl_lib->{index}{$name} = $entry;
$perl_lib->{options}{link_map}->add_page($name, $link);
}
sub index
{
my $perl_lib = shift;
$perl_lib->report1("index");
my $html_dir = $perl_lib->{html_dir};
my $top_page = $perl_lib->{top_page};
my $dest = "$html_dir/$top_page";
my $fh = new IO::File ">$dest";
defined $fh or die "Pod::Tree::PerlLib::index: Can't open $dest: $!\n";
my $stream = new HTML::Stream $fh;
my $options = $perl_lib->{options};
my $bgcolor = $options->{bgcolor};
my $text = $options->{text};
my $title = "Perl Modules";
$stream-> HTML->HEAD;
$stream-> TITLE->text($title)->_TITLE;
$stream->_HEAD
-> BODY(BGCOLOR => $bgcolor, TEXT => $text);
$stream->H1->t($title)->_H1;
$perl_lib->_emit_entries($stream);
$stream->_BODY->_HTML;
}
sub get_top_entry
{
my $perl_lib = shift;
+{ URL => $perl_lib->{top_page},
description => 'Modules' }
}
sub _emit_entries
{
my($perl_lib, $stream) = @_;
my $lib_dir = $perl_lib->{lib_dir};
my $index = $perl_lib->{index};
my $options = $perl_lib->{options};
my $col_width = $options->{col_width};
$stream->PRE;
for my $name (sort keys %$index)
{
my $entry = $index->{$name};
my $href = $entry->{href};
my $desc = $entry->{description};
my $pad = $col_width - length $name;
$stream->A(HREF => "$lib_dir/$href")->t($name)->_A;
$pad < 1 and do
{
$stream->nl;
$pad = $col_width;
};
$stream->t(' ' x $pad, $desc)->nl;
}
$stream->_PRE;
}
sub translate
{
my $perl_lib = shift;
$perl_lib->report1("translate");
my $index = $perl_lib->{index};
my $options = $perl_lib->{options};
for my $name (sort keys %$index)
{
$perl_lib->report2($name);
my @path = split m(::), $name;
my $depth = @path; # no -1 because they are all under /lib/
$options->{link_map}->set_depth($depth);
my $entry = $index->{$name};
my $source = $entry->{source};
my $dest = $entry->{dest};
my $html = new Pod::Tree::HTML $source, $dest, %$options;
$html->translate;
}
}
1
__END__
=head1 NAME
Pod::Tree::PerlLib - translate module PODs to HTML
=head1 SYNOPSIS
$perl_map = new Pod::Tree::PerlMap;
$perl_lib = new Pod::Tree::PerlLib $perl_dir, $HTML_dir, $perl_map, %opts;
$perl_lib->scan(@INC);
$perl_lib->index;
$perl_lib->translate;
$top = $perl_lib->get_top_entry;
=head1 DESCRIPTION
C translates module PODs to HTML.
It does a recursive subdirectory search through a list of
directories (typically C<@INC>) to find PODs.
C generates a top-level index of all the PODs
that it finds, and writes it to IC.
C generates and uses an index of the PODs
that it finds to construct HTML links.
Other modules can also use this index.
=head1 METHODS
=over 4
=item I<$perl_lib> = C C I<$perl_dir>,
I<$HTML_dir>, I<$perl_map>, I<%options>
Creates and returns a new C object.
I<$HTML_dir> is the directory where HTML files will be written.
I<$perl_map> maps module names to URLs.
I<%options> are passed through to C.
The I<$perl_dir> argument is included for consistency with the
other C modules, but is currently unused.
=item I<$perl_lib>->C(I<@INC>)
Does a recursive subdirectory search through I<@INC> to locate module PODs.
Each module that is identified is entered into I<$perl_map>.
=item I<$perl_lib>->C
Generates a top-level index of all the modules.
The index is written to IC.
=item I<$perl_lib>->C
Translates each module POD found by C to HTML.
The HTML pages are written to IC,
in a subdirectory hierarchy that maps the module names.
=item I<$perl_lib>->C
Returns a hash reference of the form
{ URL => $URL,
description => $description }
C uses this to build a top-level index of all the Perl PODs.
=back
=head1 LINKING
C expects the second paragraph of the POD to have the form
Foo::Bar - description
and enters I into I<$perl_map>.
To link to a module POD, write
L
=head1 REQUIRES
5.005;
HTML::Stream;
Pod::Tree;
Pod::Tree::HTML;
Pod::Tree::PerlUtil;
=head1 EXPORTS
Nothing.
=head1 SEE ALSO
L>, L>
=head1 AUTHOR
Steven McDougall, swmcd@world.std.com
=head1 COPYRIGHT
Copyright (c) 2000 by Steven McDougall. This module is free software;
you can redistribute it and/or modify it under the same terms as Perl.