Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
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 (Deacon) 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 drinking their drinks and smoking their pipes about the Monastery: (12)
As of 2014-07-25 18:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (174 votes), past polls