File Coverage

blib/lib/Data/Mirror.pm

Criterion	Covered	Total	%
statement	103	112	91.9
branch	16	30	53.3
condition	2	6	33.3
subroutine	31	32	96.8
pod	7	10	70.0
total	159	190	83.6

package Data::Mirror;
# ABSTRACT: a simple way to efficiently retrieve data from the World Wide Web.
use Carp;
use Digest::SHA qw(sha256_hex);
use Encode;
use File::Basename qw(basename);
use File::Slurp;
use File::Spec;
use File::stat;
use HTTP::Date;
use JSON::XS;
use List::Util qw(any max);
use LWP::UserAgent;
use POSIX qw(getlogin);
use Text::CSV_XS qw(csv);
use XML::LibXML;
use YAML::XS;
use IO::File;
use base qw(Exporter);
use open qw(:std :utf8);
use strict;
use utf8;
use vars qw($VERSION %EXPORT_TAGS $TTL_SECONDS $UA $JSON $CSV);

$VERSION = '0.07';

$EXPORT_TAGS{'all'} = [qw(
    mirror_str
    mirror_csv
    mirror_fh
    mirror_file
    mirror_json
    mirror_xml
    mirror_yaml
)];

Exporter::export_ok_tags('all');


#
# global TTL, used if the $ttl method argument to the mirror_* methods isn't
# specified
#
$TTL_SECONDS = 300;


$UA = LWP::UserAgent->new('agent' => sprintf(
    '%s/%s, LWP::UserAgent %s, Perl %s',
    __PACKAGE__, $VERSION || 'dev',
    $LWP::UserAgent::VERSION,
    $^V,
));


$JSON = JSON::XS->new->utf8;


$CSV = Text::CSV_XS->new ({
    'binary' => 1,
});


sub mirror_file {
    my ($url, $ttl) = @_;

    $ttl = $TTL_SECONDS unless (defined($ttl));

    my $file = filename($url);

    return $file unless (stale($url));

    #
    # update the local file
    #
    my $result = $UA->mirror($url, $file);

    if (any { $_ == $result->code } (304, 200)) {
        #
        # if the response had the Expires: header, use that, otherwise use
        # the later of the current mtime or now
        #
        my $expires = str2time($result->header('expires')) || max(stat($file)->mtime, time());

        utime($expires, $expires, $file) if (-e $file);
    }

    carp($result->status_line) if ($result->code >= 400);

    if (-e $file) {
        chmod(0600, $file);
        return $file;
    }

    return undef;
}


sub mirror_str {

    my $file = mirror_file(@_);

    if ($file) {
        return encode('UTF-8', read_file($file, 'binmode' => ':utf8'));
    }

    return undef;
}


sub mirror_fh {

    my $file = mirror_file(@_);

    if ($file) {
        my $fh = IO::File->new($file);

        $fh->binmode(':utf8');

        return $fh;
    }

    return undef;
}


sub mirror_xml {

    my $file = mirror_file(@_);

    return XML::LibXML->load_xml('location' => $file) if ($file);

    return undef;
}


sub mirror_json {

    my $str = mirror_str(@_);

    return $JSON->decode($str) if ($str);

    return undef;
}


sub mirror_yaml {

    my $file = mirror_file(@_);

    return YAML::XS::LoadFile($file) if ($file);

    return undef;
}


sub mirror_csv {

    my $fh = mirror_fh(@_);

    if ($fh) {
        my @rows;

        while (my $row = $CSV->getline($fh)) {
            push(@rows, $row);
        }

        $fh->close;

        return \@rows;
    }

    return undef;
}


sub filename {
    my $url = shift;

    #
    # the local filename is based on the hash of the URL, salted by the user's
    # login
    #
    return File::Spec->catfile(
        File::Spec->tmpdir,
        join('.', (
            __PACKAGE__,
            sha256_hex(
                getlogin(),
                ':',
                ($url->isa('URI') ? $url->canonical->as_string : $url),
            ),
            'dat'
        ))
    );
}


sub mirrored { -e filename(@_) }


sub stale {
    my ($url, $ttl) = @_;

    my $file = filename($url);

    return 1 unless (-e $file);

    return 1 unless stat($file)->mtime > time() - ($ttl || $TTL_SECONDS);

    return undef;
}


1;

__END__