package Pod::Site; use strict; use warnings; use File::Spec; use Carp; use Pod::Simple '3.12'; use HTML::Entities; use File::Path; use Object::Tiny qw( module_roots doc_root base_uri index_file css_path favicon_uri js_path versioned_title replace_css replace_js label verbose mod_files bin_files ); our $VERSION = '0.56'; sub go { my $class = shift; $class->new( $class->_config )->build; } sub new { my ( $class, $params ) = @_; my $self = bless { index_file => 'index.html', verbose => 0, js_path => '', css_path => '', %{ $params || {} } } => $class; if (my @req = grep { !$self->{$_} } qw(doc_root base_uri module_roots)) { my $pl = @req > 1 ? 's' : ''; my $last = pop @req; my $disp = @req ? join(', ', @req) . (@req > 1 ? ',' : '') . " and $last" : $last; croak "Missing required parameters $disp"; } my $roots = ref $self->{module_roots} eq 'ARRAY' ? $self->{module_roots} : ( $self->{module_roots} = [$self->{module_roots}] ); for my $path (@{ $roots }) { croak "The module root $path does not exist\n" unless -e $path; } $self->{base_uri} = [$self->{base_uri}] unless ref $self->{base_uri}; return $self; } sub build { my $self = shift; File::Path::mkpath($self->{doc_root}, 0, 0755); $self->batch_html; # The index file is the home page. my $idx_file = File::Spec->catfile( $self->doc_root, $self->index_file ); open my $idx_fh, '>', $idx_file or die qq{Cannot open "$idx_file": $!\n}; # The TOC file has the table of contents for all modules and programs in # the distribution. my $toc_file = File::Spec->catfile( $self->{doc_root}, 'toc.html' ); open my $toc_fh, '>', $toc_file or die qq{Cannot open "$toc_file": $!\n}; # Set things up. $self->{toc_fh} = $toc_fh; $self->{seen} = {}; $self->{indent} = 1; $self->{base_space} = ' '; $self->{spacer} = ' '; $self->{uri} = ''; # Make it so! $self->sort_files; $self->start_nav($idx_fh); $self->start_toc($toc_fh); $self->output($idx_fh, $self->mod_files); $self->output_bin($idx_fh); $self->finish_nav($idx_fh); $self->finish_toc($toc_fh); $self->copy_etc; # Close up shop. close $idx_fh or die qq{Could not close "$idx_file": $!\n}; close $toc_fh or die qq{Could not close "$toc_file": $!\n}; } sub sort_files { my $self = shift; # Let's see what the search has found. my $stuff = Pod::Site::Search->instance->name2path; # Sort the modules from the scripts. my (%mods, %bins); while (my ($name, $path) = each %{ $stuff }) { if ($name =~ /[.]p(?:m|od)$/) { # Likely a module. _set_mod(\%mods, $name, $stuff->{$name}); } elsif ($name =~ /[.](?:plx?|bat)$/) { # Likely a script. (my $script = $name) =~ s{::}{/}g; $bins{$script} = $stuff->{$name}; } else { # Look for a shebang line. if (open my $fh, '<', $path) { my $shebang = <$fh>; close $fh; if ($shebang && $shebang =~ /^#!.*\bperl/) { # Likely a script. (my $script = $name) =~ s{::}{/}g; $bins{$script} = $stuff->{$name}; } else { # Likely a module. _set_mod(\%mods, $name, $stuff->{$name}); } } else { # Who knows? Default to module. _set_mod(\%mods, $name, $stuff->{$name}); } } } # Save our findings. $self->{mod_files} = \%mods; $self->{bin_files} = \%bins; } sub start_nav { my ($self, $fh) = @_; my $class = ref $self; my $version = __PACKAGE__->VERSION; my $title = encode_entities $self->title; my $head = encode_entities $self->nav_header; print STDERR "Starting site navigation file\n" if $self->verbose > 1; my $base = join "\n ", map { qq{} } @{ $self->{base_uri} }; my $favicon = ''; if (my $uri = $self->{favicon_uri}) { my $type = $uri; $type =~ s/.*\.([^.]+)/$1/; $favicon = qq(); } print $fh _udent( <<" EOF" ); $title $base $favicon
EOF } sub finish_toc { my ($self, $fh) = @_; print STDERR "finishing browser TOC file\n" if $self->verbose > 1; print $fh _udent( <<" EOF" ); EOF } sub batch_html { my $self = shift; require Pod::Simple::HTMLBatch; print STDERR "Creating HTML with Pod::Simple::XHTML\n" if $self->verbose > 1; my $batchconv = Pod::Simple::HTMLBatch->new; $batchconv->index(1); $batchconv->verbose($self->verbose); $batchconv->contents_file( undef ); $batchconv->css_flurry(0); $batchconv->javascript_flurry(0); $batchconv->html_render_class('Pod::Site::XHTML'); $batchconv->search_class('Pod::Site::Search'); our $BASE_URI; local $BASE_URI = $self->base_uri->[0]; $batchconv->batch_convert( $self->module_roots, $self->{doc_root} ); return 1; } sub copy_etc { my $self = shift; require File::Copy; (my $from = __FILE__) =~ s/[.]pm$//; for my $ext (qw(css js)) { my $dest = File::Spec->catfile($self->{doc_root}, "podsite.$ext"); File::Copy::copy( File::Spec->catfile( $from, "podsite.$ext" ), $self->{doc_root} ) unless -e $dest && !$self->{"replace_$ext"}; } } sub get_desc { my ($self, $what, $file) = @_; open my $fh, '<', $file or die "Cannot open $file: $!\n"; my ($desc, $encoding); local $_; # Cribbed from Module::Build::PodParser. while (not ($desc and $encoding) and $_ = <$fh>) { next unless /^=(?!cut)/ .. /^=cut/; # in POD ($desc) = /^ (?: [a-z0-9:]+ \s+ - \s+ ) (.*\S) /ix unless $desc; ($encoding) = /^=encoding\s+(.*\S)/ unless $encoding; } Encode::from_to($desc, $encoding, 'UTF-8') if $desc && $encoding; close $fh or die "Cannot close $file: $!\n"; print "$what has no POD or no description in a =head1 NAME section\n" if $self->{verbose} && !$desc; return $desc || ''; } sub sample_module { my $self = shift; $self->{sample_module} ||= $self->main_module; } sub main_module { my $self = shift; $self->{main_module} ||= $self->_find_module; } sub name { my $self = shift; $self->{name} || $self->main_module; } sub title { my $self = shift; return $self->{title} ||= join ' ', $self->name, ( $self->versioned_title ? $self->version : () ), ( $self->label ? $self->label : () ); } sub nav_header { my $self = shift; $self->name . ($self->versioned_title ? ' ' . $self->version : ''); } sub version { my $self = shift; return $self->{version} if $self->{version}; require Module::Metadata; my $mod = $self->main_module; my $file = Pod::Site::Search->instance->name2path->{$mod} or die "Could not find $mod\n"; my $info = Module::Metadata->new_from_file( $file ) or die "Could not find $file\n"; return $self->{version} ||= $info->version; } sub _pod2usage { shift; require Pod::Usage; Pod::Usage::pod2usage( '-verbose' => 99, '-sections' => '(?i:(Usage|Options))', '-exitval' => 1, '-input' => __FILE__, @_ ); } sub _config { my $self = shift; require Getopt::Long; Getopt::Long::Configure( qw(bundling) ); my %opts = ( verbose => 0, css_path => '', js_path => '', index_file => 'index.html', base_uri => undef, ); Getopt::Long::GetOptions( 'name|n=s' => \$opts{name}, 'doc-root|d=s' => \$opts{doc_root}, 'base-uri|u=s@' => \$opts{base_uri}, 'favicon-uri=s' => \$opts{favicon_uri}, 'sample-module|s=s' => \$opts{sample_module}, 'main-module|m=s' => \$opts{main_module}, 'versioned-title|t!' => \$opts{versioned_title}, 'label|l=s' => \$opts{label}, 'index-file|i=s' => \$opts{index_file}, 'css-path|c=s' => \$opts{css_path}, 'js-path|j=s' => \$opts{js_path}, 'replace-css' => \$opts{replace_css}, 'replace-js' => \$opts{replace_js}, 'verbose|V+' => \$opts{verbose}, 'help|h' => \$opts{help}, 'man|M' => \$opts{man}, 'version|v' => \$opts{version}, ) or $self->_pod2usage; # Handle documentation requests. $self->_pod2usage( ( $opts{man} ? ( '-sections' => '.+' ) : ()), '-exitval' => 0, ) if $opts{help} or $opts{man}; # Handle version request. if ($opts{version}) { require File::Basename; print File::Basename::basename($0), ' (', __PACKAGE__, ') ', __PACKAGE__->VERSION, $/; exit; } # Check required options. if (my @missing = map { ( my $opt = $_ ) =~ s/_/-/g; "--$opt"; } grep { !$opts{$_} } qw(doc_root base_uri)) { my $pl = @missing > 1 ? 's' : ''; my $last = pop @missing; my $disp = @missing ? join(', ', @missing) . (@missing > 1 ? ',' : '') . " and $last" : $last; $self->_pod2usage( '-message' => "Missing required $disp option$pl" ); } # Check for one or more module roots. $self->_pod2usage( '-message' => "Missing path to module root" ) unless @ARGV; $opts{module_roots} = \@ARGV; # Modify options and set defaults as appropriate. for (@{ $opts{base_uri} }) { $_ .= '/' unless m{/$}; } return \%opts; } sub _set_mod { my ($mods, $mod, $file) = @_; if ($mod =~ /::/) { my @names = split /::/ => $mod; my $data = $mods->{shift @names} ||= {}; my $lln = pop @names; for (@names) { $data = $data->{$_} ||= {} } $data->{"$lln.pm"} = $file; } else { $mods->{"$mod.pm"} = $file; } } sub _udent { my $string = shift; $string =~ s/^[ ]{4}//gm; return $string; } sub _output_navlink { my ($self, $fh, $key, $fn, $class, $no_link, $desc) = @_; $desc ||= $self->get_desc($class, $fn); $desc = "—$desc" if $desc; # Output the Tree Browser Link. print "Outputting $class nav link\n" if $self->{verbose} > 2; print $fh $self->{base_space}, $self->{spacer} x $self->{indent}, qq{
  • $key
  • \n} unless $no_link; # Output the TOC link. print "Outputting $class TOC link\n" if $self->{verbose} > 2; print {$self->{toc_fh}} $self->{base_space}, $self->{spacer}, qq{
  • $class$desc
  • \n}; return 1; } sub _find_module { my $self = shift; my $search = Pod::Site::Search->instance or return; my $bins = $self->bin_files || {}; for my $mod (sort { lc $a cmp lc $b } keys %{ $search->instance->name2path }) { return $mod unless $bins->{$mod}; } } ############################################################################## package Pod::Site::Search; use base 'Pod::Simple::Search'; use strict; use warnings; our $VERSION = '0.56'; my $instance; sub instance { $instance } sub new { my $self = shift->SUPER::new(@_); $self->laborious(1); $self->inc(0); $instance = $self; return $self; } ############################################################################## package Pod::Site::XHTML; use strict; use base 'Pod::Simple::XHTML'; our $VERSION = '0.56'; sub new { my $self = shift->SUPER::new; $self->index(1); # Strip leading spaces from verbatim blocks equivalent to the indent of # the first line. $self->strip_verbatim_indent(sub { my $lines = shift; (my $indent = $lines->[0]) =~ s/\S.*//; return $indent; }); return $self; } sub start_L { my ($self, $flags) = @_; my $search = Pod::Site::Search->instance or return $self->SUPER::start_L($self); my $to = $flags->{to} || ''; my $url = $to && $search->name2path->{$to} ? $Pod::Site::BASE_URI . join('/', split /::/ => $to) . '.html' : ''; my $id = $flags->{section}; return $self->SUPER::start_L($flags) unless $url || ($id && !$to); my $rel = $id ? 'subsection' : 'section'; $url .= '#' . $self->idify($id, 1) if $id; $to ||= $self->title || $self->default_title || ''; $self->{scratch} .= qq{}; } sub html_header { my $self = shift; my $title = $self->force_title || $self->title || $self->default_title || ''; my $version = Pod::Site->VERSION; return qq{ $title }; } 1; __END__ =head1 Name Pod::Site - Build browsable HTML documentation for your app =head1 Synopsis use Pod::Site; Pod::Site->go; =head1 Usage podsite --name App \ --doc-root /path/to/output/html \ --base-uri /browser/base/uri \ /path/to/perl/libs \ /path/to/perl/bins =head1 Description This program searches a list of directories and generates a L-powered documentation site from all of the POD files it finds. It was originally designed for the L project but is has evolved for general use. Have a look at the L to see a sample documentation site in action. The generated documentation site supports Safari, Firefox, and IE7 and up. =head2 Configuration Sites generated by Pod::Site are static HTML sites with all interactivity powered by CSS and jQuery. It does its best to create links to documents within the site, and for Pod outside the site it links to L. You can specify links directly to a specific document on your site by simply adding a module name to the URL after a question mark. An example: http://www.example.com/docs/?MooseX::Declare There is one server configuration that you'll want to make to allow links without the question-mark: http://www.example.com/docs/MooseX::Declare Getting this to work is simple: Just have your Web server send 404s to the index page. If your base URI is F, for example, in Apache's F you can just do this: ErrorDocument 404 /docs/current/api/index.html =head1 Options -d --doc-root DIRECTORY Browser document root -u --base-uri URI Browser base URI -n --name NAME Site name -t --versioned-title Include main module version number in title -l --label LABEL Label to append to site title -m --main-module MODULE Primary module for the documentation -s --sample-module MODULE Module to use for sample links -i --index-file FILENAME File name for index file -c --css-path PATH Path to CSS file -j --js-path PATH Path to CSS file --replace-css Replace existing CSS file --replace-js Replace existing JavaScript file --favicon-uri URI Add a favicon linking to the given URI -V --verbose Incremental verbose mode. -h --help Print a usage statement and exit. -M --man Print the complete documentation and exit. -v --version Print the version number and exit. =head1 Class Interface =head2 Class Method =head3 C Pod::Site->go; Called from C, this class method parses command-line options in C<@ARGV>, passes them to the constructor, and builds the site. =head2 Constructor =head3 C my $ps = Pod::Site->new(\%params); Constructs and returns a Pod::Site object. The supported parameters are: =over =item C An array reference of directories to search for Pod files, or for the paths of Pod files themselves. These files and directories will be searched for the Pod documentation to build the browser. =item C Path to a directory to use as the site document root. This directory will be created if it does not already exist. =item C Base URI for the Pod site. For example, if your documentation will be served from F, then that would be the base URI for the site. May be an array reference of base URIs. This is useful if your Pod site will be served from more than one URL. This is common for versioned documentation, where you might have docs in F and a symlink to that directory from F. This parameter is important to get links from one page to another within the site to work properly. =item C The name of the site. Defaults to the name of the main module. =item C If true, the version of the main module will be included in the site title. =item C