Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 397 lines (298 sloc) 14.1 KB
#! /usr/bin/perl
use strict;
use warnings;
use Config;
use Data::Dumper;
use File::Basename;
use File::Path;
use File::Spec::Functions;
use FindBin qw/$Bin/;
use Getopt::Long;
use Template;
use lib "$Bin/lib";
use Perldoc::Config;
use constant TRUE => 1;
use constant FALSE => 0;
use vars qw/$processing_state/;
use vars qw/%manpage_pods/;
use vars qw/%core_modules/;
#--Set options for Template::Toolkit---------------------------------------
use constant TT_INCLUDE_PATH => "$Bin/templates";
#--Set config options------------------------------------------------------
my %specifiers = (
'output-path' => '=s',
'download' => '!',
'pdf' => '!',
'perl' => '=s',
);
my %options;
GetOptions( \%options, optionspec(%specifiers) );
#--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";
}
}
#--Check the output path exists--------------------------------------------
unless (-d $options{output_path}) {
die "Output path '$options{output_path}' does not exist!\n";
}
%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);
}
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 $@;
#--Compute link addresses for core modules & pragmas-----------------------
foreach my $module (grep {/^[A-Z]/ && exists($Perldoc::Page::CoreList{$_})} Perldoc::Page::list()) {
my $link = $module;
$link =~ s!::!/!g;
$link .= '.html';
$core_modules{$module} = $link;
}
foreach my $section (Perldoc::Section::list()) {
next unless $section eq 'pragmas';
foreach my $pragma (Perldoc::Section::pages($section)) {
my $link = $pragma;
$link =~ s!::!/!g;
$link .= '.html';
$core_modules{$pragma} = $link;
}
}
my @module_az_links;
foreach my $module_index ('A'..'Z') {
my $link;
if (grep {/^$module_index/ && exists($Perldoc::Page::CoreList{$_})} Perldoc::Page::list()) {
$link = "index-modules-$module_index.html";
}
push @module_az_links, {letter=>$module_index, link=>$link};
}
#--Set 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;
$Perldoc::Config::option{last_update} = "$date $month $year";
#--Create index pages------------------------------------------------------
foreach my $section (Perldoc::Section::list()) {
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('default.tt',{%Perldoc::Config::option, %index_data},$htmlfile) || die $template->error;
# For every index page, create the corresponding man pages
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";
$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});
check_filepath($filename);
$template->process('default.tt',{%Perldoc::Config::option, %page_data},$filename) || die "Failed processing $page\n".$template->error;
}
}
#--------------------------------------------------------------------------
#--Perl core modules-------------------------------------------------------
#--------------------------------------------------------------------------
foreach my $module_index ('A'..'Z') {
my %page_data;
my $template = Template->new(INCLUDE_PATH => TT_INCLUDE_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/ && exists($Perldoc::Page::CoreList{$_})} sort {uc $a cmp uc $b} Perldoc::Page::list()) {
(my $module_link = $module) =~ s/::/\//g;
$module_link .= '.html';
push @{$page_data{module_links}}, {name=>$module, title=>Perldoc::Page::title($module), url=>$module_link};
}
my $filename = catfile($Perldoc::Config::option{output_path},$page_data{pageaddress});
check_filepath($filename);
$template->process('default.tt',{%Perldoc::Config::option, %page_data},$filename) || die $template->error;
foreach my $module (grep {/^$module_index/ && exists($Perldoc::Page::CoreList{$_})} Perldoc::Page::list()) {
my %module_data;
(my $module_link = $module) =~ s/::/\//g;
$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=>"Core modules ($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;
$module_data{pod_html} = Perldoc::Page::Convert::html($module);
$module_data{page_index} = Perldoc::Page::Convert::index($module);
my $filename = catfile($Perldoc::Config::option{output_path},$module_data{pageaddress});
check_filepath($filename);
$template->process('default.tt',{%Perldoc::Config::option, %module_data},$filename) || die "Failed processing $module\n".$template->error;
}
}
#--------------------------------------------------------------------------
#--Perl glossary-----------------------------------------------------------
#--------------------------------------------------------------------------
# Not implemented yet :-(
#--------------------------------------------------------------------------
#--Perl functions----------------------------------------------------------
#--------------------------------------------------------------------------
#--Generic variables-------------------------------------------------------
my %function_data;
my $function_template = Template->new(INCLUDE_PATH => TT_INCLUDE_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} = \@module_az_links;
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($Perldoc::Config::option{output_path},$function_data{pageaddress});
check_filepath($filename);
$function_template->process('default.tt',{%Perldoc::Config::option, %function_data},$filename) || 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($Perldoc::Config::option{output_path},$function_data{pageaddress});
check_filepath($filename);
$function_template->process('default.tt',{%Perldoc::Config::option, %function_data},$filename) || 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($Perldoc::Config::option{output_path},$function_data{pageaddress});
check_filepath($filename);
$function_template->process('default.tt',{%Perldoc::Config::option, %function_data},$filename) || 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----------------------------------------
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($Perldoc::Config::option{output_path},$function_data{pageaddress});
check_filepath($filename);
$function_template->process('default.tt',{%Perldoc::Config::option, %function_data},$filename) || die "Failed processing perlfunc\n".$function_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;
}