Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

comment on

( [id://3333]=superdoc: 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

In reply to perldeltas - every perl*delta in one file by Anonymous Monk

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others exploiting the Monastery: (5)
As of 2024-03-19 09:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found