Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Re: perldeltas - every perl*delta in one file (pod.lst)

by Anonymous Monk
on Apr 11, 2013 at 02:51 UTC ( #1028070=note: print w/replies, xml ) Need Help??


in reply to perldeltas - every perl*delta in one file

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

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1028070]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (4)
As of 2022-09-29 21:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    I prefer my indexes to start at:




    Results (125 votes). Check out past polls.

    Notices?