Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 692 lines (524 sloc) 22.3 KB
#!/usr/bin/env perl
#
# Generate project-wide html documentation from pod
#
use strict;
use warnings;
use feature 'say';
use Config;
use Data::Dumper;
use File::Basename;
use File::Find;
use File::Path;
use Shell ();
use File::Spec::Functions;
use FindBin qw/$Bin/;
use lib './lib';
use Getopt::Long;
use Template;
use Perldoc::Config;
use constant TRUE => 1;
use constant FALSE => 0;
use vars qw/$processing_state/;
use vars qw/%manpage_pods/;
eval <<EOT;
use Perldoc::Convert::html;
use Perldoc::Function;
use Perldoc::Function::Category;
use Perldoc::Page;
use Perldoc::Page::Convert;
use Perldoc::Section;
EOT
die $@ if $@;
my %opt = parse_options();
# Get list of project modules
$opt{scan_dirs} ||= '';
my @dirs = split ':' => $opt{scan_dirs};
my @modules = find_modules(@dirs);
debug("Found " . scalar(@modules) . " modules");
# Generate js, static and html files
generate_javascript_files (\%opt, @modules);
generate_static_files (\%opt, @modules);
generate_html_files (\%opt, @modules);
generate_perlfunc_files (\%opt, @modules);
say "Done!";
exit 0;
sub modules_az_links {
my (@module_list) = @_;
my @module_az_links;
foreach my $module_index ('A'..'Z') {
my $link;
if (grep {/^$module_index/} @module_list) {
$link = "index-modules-$module_index.html";
}
push @module_az_links, {letter=>$module_index, link=>$link};
}
return @module_az_links;
}
sub generate_html_files {
my ($opt, @module_list) = @_;
# XXX Rename to module_links
my %core_modules;
#--Compute link addresses -----------------------
foreach my $module (grep {/^[A-Z]/} @module_list) {
my $link = $module;
$link =~ s!::!/!g;
$link .= '.html';
$core_modules{$module} = $link;
}
debug("Core modules list generated (" . scalar(keys(%core_modules)) . " modules found).");
my @module_az_links = modules_az_links(@module_list);
$opt->{last_update} = last_update_timestamp();
=cut
#--Create index pages------------------------------------------------------
foreach my $section (Perldoc::Section::list()) {
debug("Generating documentation section $section");
my %index_data;
my $template = Template->new(INCLUDE_PATH => TT_INCLUDE_PATH);
$index_data{pagedepth} = 0;
$index_data{path} = '../' x $index_data{pagedepth};
$index_data{pagename} = Perldoc::Section::name($section);
$index_data{pageaddress} = "index-$section.html";
$index_data{content_tt} = 'section_index.tt';
$index_data{module_az} = \@module_az_links;
foreach my $page (Perldoc::Section::pages($section)) {
(my $page_link = $page) =~ s/::/\//g;
push @{$index_data{section_pages}},{name=>$page, link=>"$page_link.html",title=>Perldoc::Page::title($page)};
}
my $htmlfile = catfile($Perldoc::Config::option{output_path},$index_data{pageaddress});
check_filepath($htmlfile);
$template->process($tmpl_file, {%Perldoc::Config::option, %index_data},$htmlfile) || die $template->error;
# For every index page, create the corresponding man pages
debug('Section pages: (' . join(', ', Perldoc::Section::pages($section)) . ')');
foreach my $page (Perldoc::Section::pages($section)) {
next if ($page eq 'perlfunc'); # 'perlfunc' will be created later
my %page_data;
(my $page_link = $page) =~ s/::/\//g;
$page_data{pagedepth} = 0 + $page =~ s/::/::/g;
$page_data{path} = '../' x $page_data{pagedepth};
$page_data{pagename} = $page;
$page_data{pageaddress} = "$page_link.html";
$page_data{contentpage} = 1;
$page_data{module_az} = \@module_az_links;
$page_data{breadcrumbs} = [ {name=>Perldoc::Section::name($section), url=>"index-$section.html"} ];
$page_data{content_tt} = 'page.tt';
$page_data{pdf_link} = "$page_link.pdf";
debug(" - Before convert::html $page");
# 're' causes the script to silently abort for no apparent reason
next if $page eq 're' || $page eq 'instmodsh';
$page_data{pod_html} = Perldoc::Page::Convert::html($page);
$page_data{pod_html} =~ s!<(pre class="verbatim")>(.+?)<(/pre)>!autolink($1,$2,$3,$page_data{path})!sge if ($page eq 'perl');
$page_data{page_index} = Perldoc::Page::Convert::index($page);
my $filename = catfile($Perldoc::Config::option{output_path},$page_data{pageaddress});
debug(" - Generating page $page ($filename)");
check_filepath($filename);
$template->process($tmpl_file,{%Perldoc::Config::option, %page_data},$filename) || die "Failed processing $page\n".$template->error;
}
}
=cut
# ----------------------------------------------------
debug("Generating modules index...");
foreach my $module_index ('A'..'Z') {
my %page_data;
my $template = Template->new(INCLUDE_PATH => $opt->{template_path});
$page_data{pagedepth} = 0;
$page_data{path} = '../' x $page_data{pagedepth};
$page_data{pagename} = qq{Core modules ($module_index)};
$page_data{pageaddress} = "index-modules-$module_index.html";
$page_data{breadcrumbs} = [ ];
$page_data{content_tt} = 'module_index.tt';
$page_data{module_az} = \@module_az_links;
foreach my $module (grep {/^$module_index/} sort {uc $a cmp uc $b} @module_list) {
(my $module_link = $module) =~ s/::/\//g;
$module_link .= '.html';
my $title;
eval { $title = Perldoc::Page::title($module) };
push @{$page_data{module_links}}, {
name=>$module,
title=>$title,
url=>$module_link
};
}
my $filename = catfile($opt->{output_path}, $page_data{pageaddress});
debug("Generating modules index $module_index ($filename)");
check_filepath($filename);
$template->process($opt->{template}, {%$opt, %page_data},$filename)
or die $template->error;
my $section_title = $opt->{title} || 'Untitled project';
foreach my $module (grep {/^$module_index/} @module_list) {
my %module_data;
(my $module_link = $module) =~ s/::/\//g;
#warn " - module $module\n";
$module_data{pageaddress} = "$module_link.html";
$module_data{contentpage} = 1;
$module_data{pagename} = $module;
$module_data{pagedepth} = 0 + $module =~ s/::/::/g;
$module_data{path} = '../' x $module_data{pagedepth};
$module_data{breadcrumbs} = [ {
name => "$section_title ($module_index)",
url => "index-modules-$module_index.html"
} ];
$module_data{content_tt} = 'page.tt';
$module_data{pdf_link} = "$module_link.pdf";
$module_data{module_az} = \@module_az_links;
eval {
$module_data{pod_html} = Perldoc::Page::Convert::html($module);
$module_data{page_index} = Perldoc::Page::Convert::index($module);
} or do {
warn "FAILED CONVERTING $module: $@\n";
};
my $filename = catfile($opt->{output_path}, $module_data{pageaddress});
check_filepath($filename);
$template->process($opt->{template}, {
%$opt, %module_data
}, $filename) || die "Failed processing $module\n".$template->error;
}
}
return;
}
sub generate_perlfunc_files {
my ($opt, @module_list) = @_;
#--------------------------------------------------------------------------
#--Perl functions----------------------------------------------------------
#--------------------------------------------------------------------------
#--Generic variables-------------------------------------------------------
my %function_data;
my $function_template = Template->new(INCLUDE_PATH => $opt->{template_path});
#--Index variables---------------------------------------------------------
$function_data{pagedepth} = 0;
$function_data{path} = '../' x $function_data{pagedepth};
#--Create A-Z index page---------------------------------------------------
$function_data{pageaddress} = 'index-functions.html';
$function_data{pagename} = 'Perl functions A-Z';
$function_data{breadcrumbs} = [ {name=>'Language reference', url=>'index-language.html'} ];
$function_data{content_tt} = 'function_index.tt';
$function_data{module_az} = [ modules_az_links(@module_list) ];
debug("Generating documentation for functions...");
foreach my $letter ('A'..'Z') {
my ($link,@functions);
if (my @function_list = grep {/^[^a-z]*$letter/i} sort (Perldoc::Function::list())) {
$link = "#$letter";
foreach my $function (@function_list) {
(my $url = $function) =~ s/[^\w-].*//i;
$url .= '.html';
my $description = Perldoc::Function::description($function);
push @functions,{name=>$function, url=>$url, description=>$description};
}
}
push @{$function_data{function_az}}, {letter=>$letter, link=>$link, functions=>\@functions};
}
my $filename = catfile($opt->{output_path},$function_data{pageaddress});
check_filepath($filename);
$function_template->process($opt->{template}, {%$opt, %function_data},$filename)
or die "Failed processing function A-Z\n".$function_template->error;
#--Create 'functions by category' index page-------------------------------
$function_data{pageaddress} = 'index-functions-by-cat.html';
$function_data{pagename} = 'Perl functions by category';
$function_data{content_tt} = 'function_bycat.tt';
foreach my $category (Perldoc::Function::Category::list()) {
my $name = Perldoc::Function::Category::description($category);
(my $link = $name) =~ tr/ /-/;
my @functions;
foreach my $function (sort (Perldoc::Function::Category::functions($category))) {
(my $url = $function) =~ s/[^\w-].*//i;
$url .= '.html';
my $description = Perldoc::Function::description($function);
push @functions,{name=>$function, url=>$url, description=>$description};
}
push @{$function_data{function_cat}},{name=>$name, link=>$link, functions=>\@functions};
}
$filename = catfile($opt->{output_path},$function_data{pageaddress});
check_filepath($filename);
$function_template->process($opt->{template}, {%$opt, %function_data}, $filename)
or die "Failed processing functions by category\n".$function_template->error;
#--Create 'perlfunc' page--------------------------------------------------
$function_data{pageaddress} = 'perlfunc.html';
$function_data{contentpage} = 1;
$function_data{pagename} = 'perlfunc';
$function_data{content_tt} = 'function_page.tt';
$function_data{pdf_link} = "perlfunc.pdf";
$function_data{pod_html} = Perldoc::Page::Convert::html('perlfunc');
$filename = catfile($opt->{output_path},$function_data{pageaddress});
check_filepath($filename);
$function_template->process($opt->{template},{%$opt, %function_data}, $filename)
or die "Failed processing perlfunc\n".$function_template->error;
#--Function variables------------------------------------------------------
undef $function_data{pdf_link};
$function_data{pagedepth} = 1;
$function_data{path} = '../' x $function_data{pagedepth};
#--Create individual function pages----------------------------------------
debug("Generating perlfunc documentation...");
foreach my $function (Perldoc::Function::list()) {
local $processing_state = 'functions';
my $function_pod = Perldoc::Function::pod($function);
$function =~ s/[^\w-].*//i;
warn ("No Pod for function '$function'\n") unless ($function_pod);
chomp $function_pod;
$function_data{pageaddress} = "functions/$function.html";
$function_data{pagename} = $function;
$function_data{breadcrumbs} = [ {name=>'Language reference', url=>'index-language.html'},
{name=>'Functions', url=>'index-functions.html'} ];
$function_data{pod_html} = Perldoc::Convert::html::convert('function::',$function_pod);
$function_data{pod_html} =~ s!(<a href=")#(\w+)(">)!Perldoc::Function::exists($2) ? "$1../functions/$2.html$3" : "$1#$2$3"!ge;
$filename = catfile($opt->{output_path},$function_data{pageaddress});
check_filepath($filename);
$function_template->process($opt->{template},{%$opt, %function_data},$filename)
or die "Failed processing perlfunc\n".$function_template->error;
}
}
sub find_modules {
my (@dirs) = @_;
my $dirs = join(' ', map { q(') . $_ . q(') } @dirs);
my @modules = `grep -r '^package .*;' $dirs | awk '{ print \$2 }' 2>/dev/null | egrep '[A-Z]' | sort | uniq | perl -ple 's/;\$//'`;
chomp for @modules;
return @modules;
}
sub extract_title {
my ($page) = @_;
my $title;
eval {
$title = Perldoc::Page::title($page) || "Untitled module $page";
} or do {
return "No pod for $page !!";
};
$title =~ s/\\/\\\\/g;
$title =~ s/"/\\"/g;
$title =~ s/C<(.*?)>/$1/g;
$title =~ s/\n//sg;
return $title;
}
sub generate_javascript_files {
my ($opt, @module_list) = @_;
#--Create indexPod.js------------------------------------------------------
my @pods;
for my $page (@module_list) {
push @pods,{
name => $page,
description => extract_title($page)
};
}
my $jsfile = catfile($opt->{output_path},'static','indexPod.js');
my $template = Template->new(INCLUDE_PATH => $opt->{template_path});
$template->process('indexpod-js.tt',{
%{ $opt },
pods=>\@pods
}, $jsfile)
or die $template->error;
#--Create indexModules.js--------------------------------------------------
my @modules;
foreach my $page (@module_list) {
if (my $title = extract_title($page)) {
push @modules,{name=>$page, description=>$title};
}
}
$jsfile = catfile($opt->{output_path}, 'static', 'indexModules.js');
$template->process('indexmodules-js.tt', {
%{ $opt },
modules => \@modules
}, $jsfile)
or die $template->error;
=cut
#--Create indexFunctions.js------------------------------------------------
my @functions;
foreach my $function (Perldoc::Function::list()) {
my $description = Perldoc::Function::description($function) || warn "No description for $function";
$description =~ s/\\/\\\\/g;
$description =~ s/"/\\"/g;
$description =~ s/C<(.*?)>/$1/g;
$description =~ s/\n//sg;
push @functions,{name=>$function, description=>$description};
}
$jsfile = catfile($Perldoc::Config::option{output_path},'static','indexFunctions.js');
$template->process('indexfunctions-js.tt',{%Perldoc::Config::option, functions=>\@functions},$jsfile) || die $template->error;
#--Create indexFAQs.js-----------------------------------------------------
my @faqs;
foreach my $section (1..9) {
my $pod = Perldoc::Page::pod("perlfaq$section");
my $parser = Pod::POM->new();
my $pom = $parser->parse_text($pod);
foreach my $head1 ($pom->head1) {
foreach my $head2 ($head1->head2) {
my $title = $head2->title->present('Pod::POM::View::Text');
$title =~ s/\n/ /g;
$title =~ s/\\/\\\\/g;
$title =~ s/"/\\"/g;
push @faqs,{section=>$section,name=>$title};
}
}
}
$jsfile = catfile($Perldoc::Config::option{output_path},'static','indexFAQs.js');
$template->process('indexfaqs-js.tt',{%Perldoc::Config::option, faqs=>\@faqs},$jsfile) || die $template->error;
=cut
return;
}
sub parse_options {
#--Set config options------------------------------------------------------
my %specifiers = (
'output-path' => '=s',
'template' => '=s',
'template-path'=>'=s',
'pdf' => '!',
'perl' => '=s',
'project' => '=s',
'title' => '=s',
'scan-dirs' => '=s',
);
my %options;
GetOptions( \%options, optionspec(%specifiers) );
# Used in the templates to generate relative links
$options{download} = 1;
#--Check mandatory options have been given---------------------------------
my @mandatory_options = qw(output-path);
foreach (@mandatory_options) {
(my $option = $_) =~ tr/-/_/;
unless ($options{$option}) {
die "Option '$_' must be specified!\n";
}
}
my $tmpl_path = $options{template_path} ||= './docs/templates';
my $tmpl_file = $options{template} ||= 'default.tt';
#--Create output path folder if it doesn't exist---------------------------
unless (-d $options{output_path}) {
mkpath($options{output_path}, 0, 0755);
}
%Perldoc::Config::option = (%Perldoc::Config::option, %options);
#--Check if we are using a different perl----------------------------------
if ($options{perl}) {
#warn "Setting perl to $options{perl}\n";
my $version_cmd = 'printf("%vd",$^V)';
my $perl_version = `$options{perl} -e '$version_cmd'`;
my $inc_cmd = 'print "$_\n" foreach @INC';
my $perl_inc = `$options{perl} -e '$inc_cmd'`;
my $bin_cmd = 'use Config; print $Config{bin}';
my $perl_bin = `$options{perl} -e '$bin_cmd'`;
$Perldoc::Config::option{perl_version} = $perl_version;
$Perldoc::Config::option{perl5_version} = substr($perl_version,2);
$Perldoc::Config::option{inc} = [split /\n/,$perl_inc];
$Perldoc::Config::option{bin} = $perl_bin;
#warn Dumper(\%Perldoc::Config::option);
}
return %Perldoc::Config::option;
}
sub generate_static_files {
my ($opt, @module_list) = @_;
$opt->{last_update} = last_update_timestamp();
#--Copy static files------------------------------------------------------
my $static_path = catdir($opt->{output_path}, 'static');
mkpath($static_path) unless -d $static_path;
my $tmpl_path = $opt->{template_path};
Shell::cp('-r', "$tmpl_path/static/*", $static_path);
Shell::cp('-r', "$tmpl_path/javascript/*", $static_path);
#--Process static html files with template--------------------------------
my @module_az_links;
foreach my $module_index ('A'..'Z') {
my $link;
if (grep {/^$module_index/} @module_list) {
$link = "index-modules-$module_index.html";
}
push @module_az_links, {letter=>$module_index, link=>$link};
}
my $process = create_template_function(
#templatefile => $templatefile,
opt => $opt,
variables => {
module_az => \@module_az_links,
%{ $opt }
},
);
warn "Searching in $tmpl_path/static-html";
find( {wanted=>$process, no_chdir=>1}, "$tmpl_path/static-html" );
#-------------------------------------------------------------------------
}
sub last_update_timestamp {
my $date = sprintf("%02d",(localtime(time))[3]);
my $month = qw/
January
February
March
April
May
June
July
August
September
October
November
December /[(localtime(time))[4]];
my $year = (localtime(time))[5] + 1900;
return "$date $month $year";
}
sub create_template_function {
my %args = @_;
my $opt = $args{opt};
my $title = $args{variables}->{title};
return sub {
#warn "Process called: $_";
return unless (/(\w+)\.html$/);
my $page = $1;
local $/ = undef;
my $template = Template->new(
INCLUDE_PATH => [$opt->{template_path}, '.'],
#ABSOLUTE => 1,
RELATIVE => 1,
);
my $depth = () = m/\//g;
my %titles = (
index => $title || 'Untitled project documention',
search => 'Search results',
preferences => 'Preferences',
);
my %breadcrumbs = (
index => 'Home',
search => '<a href="index.html">Home</a> &gt; Search results',
preferences => '<a href="index.html">Home</a> &gt; Preferences',
);
my %variables = %{$args{variables}};
$depth--;
$variables{path} = '../' x ($depth - 1);
$variables{pagedepth} = $depth - 1;
$variables{pagename} = $titles{$page} || $page;
$variables{breadcrumb} = $breadcrumbs{$page} || $page;
$variables{content_tt} = $File::Find::name;
my $output_filename = catfile($opt->{output_path}, basename($_));
#my $cwd = Cwd::cwd();
#warn "Writing $output_filename (output_path: $opt->{output_path}, cwd: $cwd, template: $opt->{template})";
$template->process(
$opt->{template}, {
%{ $opt },
%variables
},
$output_filename
) or die "!! Failed processing $page\n" . $template->error;
}
}
#--------------------------------------------------------------------------
sub autolink {
my ($start,$txt,$end,$linkpath) = @_;
$txt =~ s!\b(perl\w+)\b!(Perldoc::Page::exists($1))?qq(<a href="$linkpath$1.html">$1</a>):$1!sge;
return "<$start>$txt<$end>";
}
sub check_filepath {
my $filename = shift;
my $directory = dirname($filename);
mkpath $directory unless (-d $directory);
}
sub escape {
my $data = shift;
$data =~ s/([^a-z0-9])/sprintf("%%%02x",ord($1))/egi;
return $data;
}
sub optionspec {
my %option_specs = @_;
my @getopt_list;
while (my ($option_name,$spec) = each %option_specs) {
(my $variable_name = $option_name) =~ tr/-/_/;
(my $nospace_name = $option_name) =~ s/-//g;
my $getopt_name = ($variable_name ne $option_name) ? "$variable_name|$option_name|$nospace_name" : $option_name;
push @getopt_list,"$getopt_name$spec";
}
return @getopt_list;
}
sub debug {
my $verbose = 1;
print STDERR @_, "\n" if $verbose;
}