use strict;
use warnings;
use List::Util 'first';
use Config;
use Cache::FileCache;

sub cached_current_perl_source_file {
    my $filename = shift;
    my $cache = Cache::FileCache->new( { namespace => 'perl-source' } 
+);
    my $contents = $cache->get( "$Config{'version'}/$filename" );

    if ( not defined $contents ) {
        $contents = current_perl_source_file( $filename );
        $cache->set( "$Config{'version'}/$filename" => $contents, "nev
+er" );
    }

    $contents;
}

sub current_perl_source_file {
    my $filename = shift;
    require WWW::Mechanize;
    
    my $w = current_perl_source();
    $w->follow_link( text => $filename );
    $w->content;
}

sub current_perl_source {
    my $w = current_perl_page();
    require WWW::Mechanize;
    
    $w->follow_link( text_regex => qr/Browse/ );
    $w;
}

sub WWW::Mechanize::to_text {
    require HTML::FormatText;
    
    HTML::FormatText->new->format_string( $_[0]->content );
}

sub find_url_option {
    require Carp;
    
    defined $_[0] or Carp::confess "Undefined form";
    $_[0]->find_input( qw[ url option ] );
}

sub current_perl_page {
    my $w = latest_perl_page();
    my $form_number = other_releases_form( $w ) ;
    my $value_name =
        do { 
            my $form = ( $w->forms )[ $form_number - 1 ];
            my $o = find_url_option( $form );
            my %values;
            @values{$o->value_names} = $o->possible_values;
            $values{ List::Util::first { /$Config{'version'}/o }
                     keys %values } };

    $w->form_number( $form_number );
    $w->set_visible( [ option => $value_name ] );
    $w->click;
    $w;
}                 
                 
sub other_releases_form {
    my $w = shift;
    
    my @forms = $w->forms;
    for my $form_ix ( 0 .. $#forms ) {
        if ( find_url_option( $forms[$form_ix] ) ) {
            return 1 + $form_ix;
        }
    }
    die "Couldn't find Other Releases on " . $w->url;
}

sub latest_perl_page {
    require WWW::Mechanize;

    my $w = WWW::Mechanize->new;
    $w->get( 'http://search.cpan.org' );
    $w->set_visible( "perl",
                     [ qw[ option dist ] ] );
    $w->submit_form;
    
    # Page through CPAN's search results until I hit the end or find t
+he right
    # page.
    while ( 1 ) {
        $w->follow_link( text_regex => qr/^perl-\d+/ )
            and return $w;
        
        $w->follow_link( text_regex => qr/^Next /i )
            or
            die "Couldn't find perl on http://search.cpan.org";
    }
}
[download]