since pod.lst is no longer available, updated to work with MANIFEST and perl.pod . Code in spoiler tags.
#!/usr/bin/perl --
use strict;
use warnings;
use File::Spec;
use File::Basename qw' dirname ';
use autodie qw' chdir mkdir open close ';
use LWP 5.837;
use LWP::Simple 5.835 qw' mirror $ua ';
use Getopt::Long::Descriptive qw' describe_options ';
use Data::Dump qw/ dd pp /;
## pick your poison, HTMLLegacy is better
#~ use Pod::Html qw' pod2html ';
use Pod::Simple::HTMLLegacy;
BEGIN { *pod2html = *Pod::Simple::HTMLLegacy::pod2html; }
our @MIRRORS = ( # only $MIRRORS[0] is used
'http://perl5.git.perl.org/perl.git/blob_plain/blead:/%s',
'https://github.com/mirrors/perl/raw/blead/%s',
);
Main( dirname( File::Spec->rel2abs( __FILE__ ) ), @ARGV );
exit( 0 );
sub Main {
chdir shift;
#~ dd DeltasOrder();
Rmain( @_ );
}
sub Rmain {
$| = 1;
local @ARGV = @_;
my( $opt, $usage ) = describe_options(
"$0\n" . "$0 [-r] [-f] [-h] \n", [
'refresh|r',
"downloads pod.lst/perldelta.pod and any new/missing delta
+s"
],
[ 'force|f', "force download everything" ],
[ 'pdeltaforce|p', "write pod/perldeltas.* for sure" ],
[ 'help|h', "print usage message and exit" ],
);
print( $usage->text ), exit if $opt->help;
print TimeD(), "\n";
if( not( -d 'pod' and -w _ ) ) {
mkdir 'pod';
$opt->mu( 'refresh', 1 );
}
if( $opt->refresh or $opt->force ) {
$opt->mu( 'refresh', 1 );
GetMirrorDeltas( $opt->force );
}
my $infile = 'pod/perldeltas.pod';
my $outfile = 'pod/perldeltas.html';
if( $opt->refresh or $opt->pdeltaforce ) {
my $pd = GetDeltas();
#~ use DDS; Dump($pd);
WritePerldeltas( $pd, $infile, $outfile, );
}
print "
see every perl*delta in one file
SEE $infile
SEE $outfile
";
} ## end sub Rmain
sub WritePerldeltas {
my( $pd, $infile, $outfile ) = @_;
print TimeD(), "\n";
print "\n";
{
open my $out, '>:encoding(UTF-8)', $infile;
print $out "=encoding utf8\n\n=head1 NAME\n\nperldeltas - ever
+y";
print $out " perl*delta in one file\n\n=cut\n\n\n";
for my $p ( @$pd ) {
my( $file, $d ) = @$p;
print "\rprocessing $file ";
my $parser = PodLinkHeadPrefixer->new( __prefix => "p$d-"
+);
$parser->parse_from_file( $file, $out );
undef $parser;
print $out "\n\n";
} ## end for my $p (@$pd)
print "\r" . ( ' ' x 78 ) . "\n";
close $out;
}
print TimeD(), "\n";
print "pod2html --infile=$infile --outfile=$outfile\n";
pod2html(
"--infile=$infile",
"--outfile=$outfile",
'--title=perldeltas - every perl*delta in one file',
);
print TimeD(), "\n";
} ## end sub WritePerldeltas
sub GetDeltas {
local $MIRRORS[0] =
#~ do { $ua->timeout(0.00001); 'http://127.6.6.6:666666666/%s' };
do { $ua->timeout( 0.00000001 ); 'file:%s' };
eval { $ua->remove_handler( "response_done" ); };
GetOrMirrorDeltas( @_ );
}
sub GetMirrorDeltas {
eval { $ua->remove_handler( "response_done" ); };
$ua->add_handler(
"response_done",
sub {
my( $res ) = @_;
my $request = $res->request;
print $request->method, 'ing ', $request->uri, ': ', $res-
+>message,
"\n";
return;
}
);
GetOrMirrorDeltas( @_ );
} ## end sub GetMirrorDeltas
sub MirUrlFile {
my( $urlfile, $file ) = @_;
mirror( sprintf( $MIRRORS[0], $urlfile ), $file );
}
sub TimeD {
return scalar localtime;
return scalar gmtime;
return time - $^T;
}
BEGIN {
package PodLinkHeadPrefixer;
use parent qw' Pod::Parser ';
sub command {
my( $self, $cmd, $text, $line_num, $pod_para ) = @_;
my $d = $self->{__prefix};
if( ( $cmd =~ /^head/ )
or( $cmd eq 'item' and $text !~ /^(?:\s*\*|\s*\d+\.)/ ) )
{
$pod_para->text( "$d$text" );
}
## Just treat this like a textblock
$self->textblock( $pod_para->raw_text(), $line_num, $pod_para
+);
} ## end sub command
sub interior_sequence {
my( $self, $seq_cmd, $seq_arg, $pod_seq ) = @_;
my $raw = $pod_seq->raw_text;
if( $seq_cmd eq 'L' ) {
use Pod::ParseLink qw' parselink ';
my( $text, $inferred, $name, $section, $type ) =
parselink( $seq_arg );
my $d = $self->{__prefix};
if( $type eq 'pod' ) {
if( $name ) { # localize
if( $name =~ m!^perl(\d+)delta(?:.pod)?$! ) {
$section = "p${1}-" . ( $section || 'NAME' );
$name = "";
}
} else { # local link
$section = "$d$section";
}
if( $section and not $name ) {
$raw = 'L'
. $pod_seq->left_delimiter
. ( $text ? "$text|" : "" )
. ( $name || "" )
. ( $section ? qq!/"$section"! : "" )
. $pod_seq->right_delimiter;
}
} ## end if( $type eq 'pod' )
} ## end if( $seq_cmd eq 'L' )
return $raw;
} ## end sub interior_sequence
$INC{'PodLinkHeadPrefixer.pm'} = __FILE__; # true
} ## end BEGIN
sub GetOrMirrorDeltas {
my( $Override ) = @_;
MirUrlFile( 'MANIFEST', 'pod/MANIFEST' );
MirUrlFile( 'pod/perl.pod', 'pod/perl.pod' );
open my( $lst ), 'pod/MANIFEST';
while( <$lst> ) {
if( m{^(pod/perl(\d*)delta\.pod)\b} ) {
my( $file, $d ) = ( $1, $2 );
$Override || !-f $file and MirUrlFile( $file, $file );
}
}
return DeltasOrder();
} ## end sub GetOrMirrorDeltas
sub Getopt::Long::Descriptive::Opts::mu {
package Getopt::Long::Descriptive::Opts;
my( $self, $opt, @newval ) = @_;
$self->can( $opt ) or Carp::croak "unrecognized $opt ";
my $currval = $self->$opt;
if( @newval ) {
$self->{$opt} = @newval == 1 ? $newval[0] : \@newval;
}
return $currval;
} ## end sub Getopt::Long::Descriptive::Opts::mu
sub DeltasOrder {
my @del;
open my( $in ), '<', 'pod/perl.pod';
while( <$in> ) {
/^\s+(perl(\d+)delta)\b/
and push @del, [ 'pod/' . $1 . '.pod', $2 ];
}
close $in;
open $in, '<', 'pod/perldelta.pod';
while( <$in> ) {
if( /^perldelta - what is new for perl v(\S+)\s*$/m ) {
my $first = $1;
$first =~ s/\D//g;
unshift @del, [ 'pod/perldelta.pod', $first ];
}
}
return \@del;
} ## end sub DeltasOrder