#!/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 ';
## 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;
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/missin
+g deltas"
],
[ 'force|f', "force download everything" ],
[ '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->refresh(1);
}
if ( $opt->refresh or $opt->force ) {
$opt->refresh(1);
GetMirrorDeltas( $opt->force );
}
my $infile = 'pod/perldeltas.pod';
my $outfile = 'pod/perldeltas.html';
if ( $opt->refresh ) {
my $pd = GetDeltas();
#~ use DDS; Dump($pd);
WritePerldeltas( $pd, $infile, $outfile, );
} ## end if ( $opt->refresh )
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 - every";
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' };
eval { $ua->remove_handler("response_done"); };
GetOrMirrorDeltas(@_);
} ## end sub GetDeltas
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->messa
+ge, "\n";
return;
}
);
GetOrMirrorDeltas(@_);
} ## end sub GetMirrorDeltas
sub GetOrMirrorDeltas {
my ($Override) = @_;
MirUrlFile( 'pod.lst', 'pod/pod.lst' );
my @del;
open my ($lst), 'pod/pod.lst';
while (<$lst>) {
if (/^(d)?\s+(perl(\d+)delta)\b/) {
my $d = $3;
my $file = sprintf( 'pod/%s.pod', $2 );
if ($1) {
MirUrlFile( 'pod/perldelta.pod', $file );
} else {
$Override || !-f $file and MirUrlFile( $file, $file );
}
push @del, [ $file, $d ];
} ## end if (/^(d)?\s+(perl(\d+)delta)\b/)
} ## end while (<$lst>)
return \@del;
} ## end sub GetOrMirrorDeltas
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 ( $section and not ...)
} ## end if ( $type eq 'pod' )
} ## end if ( $seq_cmd eq 'L' )
return $raw;
} ## end sub interior_sequence
$INC{'PodLinkHeadPrefixer.pm'} = __FILE__; # true
} ## end BEGIN