Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

perldeltas - every perl*delta in one file

by Anonymous Monk
on Feb 12, 2011 at 23:14 UTC ( #887804=CUFP: print w/ replies, xml ) Need Help??

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

Comment on perldeltas - every perl*delta in one file
Download Code
Re: perldeltas - every perl*delta in one file
by vkon (Curate) on Feb 13, 2011 at 09:48 UTC
      No explanations why I need this f*ed piece of code, no nothing, commented "use" statements, etc. Deserves downvoting

      You've heard of perldelta haven't you? Is "every perl*delta in one file" somehow cryptic?

      Satelite falls on your house or something?

        indeed, why this code beter than just
        tar cjf archive-where-all-deltas-in-one-file.tbz ./pod/perl*delta.pod
        - it is also "every perl*delta in one file"

        ... some HTML conversion inside... some unexplained parameters...

        very, very crappy code.

Re: perldeltas - every perl*delta in one file
by Anonymous Monk on Apr 26, 2011 at 11:18 UTC
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>.

Re: perldeltas - every perl*delta in one file (pod.lst)
by Anonymous Monk on Apr 11, 2013 at 02:51 UTC

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://887804]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (6)
As of 2015-07-07 07:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (87 votes), past polls