Net::Parliament::UserAgent - a caching user agent

Net-Parliament documentation Contained in the Net-Parliament distribution.

Index

Code Index:

NAME

Top

Net::Parliament::UserAgent - a caching user agent

VERSION

Top

Version 0.01

SYNOPSIS

Top

This module will cache GET requests to disk. It otherwise behaves the same as LWP::UserAgent.

AUTHOR

Top

Luke Closs, <cpan at 5thplane.com>

BUGS

Top

Please report any bugs or feature requests to bug-net-parliament at rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-Parliament. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

SUPPORT

Top

You can find documentation for this module with the perldoc command.

    perldoc Net::Parliament::UserAgent

You can also look for information at:

* RT: CPAN's request tracker

http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-Parliament

* AnnoCPAN: Annotated CPAN documentation

http://annocpan.org/dist/Net-Parliament

* CPAN Ratings

http://cpanratings.perl.org/d/Net-Parliament

* Search CPAN

http://search.cpan.org/dist/Net-Parliament/

ACKNOWLEDGEMENTS

Top

Thanks to parl.gc.ca for the parts of their site in XML format.

COPYRIGHT & LICENSE

Top

Copyright 2009 Luke Closs, all rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Net-Parliament documentation Contained in the Net-Parliament distribution. 
package Net::Parliament::UserAgent;
use Moose;
extends 'LWP::UserAgent';
use IO::All;
use Digest::MD5 qw/md5_hex/;
use File::Path qw/mkpath/;
use Fatal qw/mkpath/;


our $VERSION = '0.01';


has 'cache_dir' => (
    is         => 'ro',
    isa        => 'Str',
    lazy_build => 1,
);

sub _build_cache_dir {
    my $self = shift;
    my $dir  = "cache";

    if (!-d $dir) {
        mkpath($dir);
    }
    return $dir;
}

around 'get' => sub {
    my $orig = shift;
    my $self = shift;
    my $url  = shift;

    my $file = $self->_url_to_file($url);
    if (-e $file) {
        print "Returning $url from $file\n";
        return io($file)->all();
    }

    my $resp = $orig->($self, $url);
    my $html = $resp->content;
    io($file)->print($html);
    print "Saved $url to $file\n";

    return $html;
};

sub _url_to_file {
    my $self = shift;
    my $cd   = $self->cache_dir;
    return join '/', $cd, md5_hex(shift);
}


1;