Save as perldeltas.pl, run, then open pod/perldeltas.html
#!/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
Needs autodie LWP LWP::Simple Getopt::Long::Descriptive Pod::Parser Pod::ParseLink Pod::Simple::HTMLLegacy
Re: perldeltas - every perl*delta in one file
by Anonymous Monk on Apr 26, 2011 at 11:18 UTC
|
Example generated
Fri Apr 15 20:36:15 2011 GMT
| [reply] |
Re: perldeltas - every perl*delta in one file
by Anonymous Monk on Dec 06, 2011 at 11:03 UTC
|
LOL, LOGIC BUG, Getopt::Long::Descriptive::Opts offers only accessors not mutators
It works on first run, but the switches (refresh , force) don't. For updates, simply delete output directory before running.
What perldeltas does is rewrite the links and headers, to add the perl version name, so the links work. Example from L</NAME> to L</p5136-NAME>.
| [reply] [d/l] [select] |
Re: perldeltas - every perl*delta in one file (pod.lst)
by Anonymous Monk on Apr 11, 2013 at 02:51 UTC
|
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
| [reply] [d/l] |
A reply falls below the community's threshold of quality. You may see it by logging in. |
|
|