mogfetch

#!/usr/bin/perl

=head1 NAME

mogfetch -- Fetch data from a MogileFS installation

=head1 SYNOPSIS

    $ mogfetch [options]
    $ mogfetch [options] --file="-" > filename

    $ mogfetch --trackers=host --domain=foo \
               --key="/hello.jpg" --file="output.jpg"

=head1 OPTIONS

=over

=item --trackers=host1:7001,host2:7001

Use these MogileFS trackers to negotiate with.

=item --domain=<domain>

Set the MogileFS domain to use.

=item --key="<key>"

The key to locate the data with. Can be an arbitrary string.

=item --file="<filename|->"

A local destination file. If '-', data is written to STDOUT instead.

=back

=head1 AUTHOR

Dormando E<lt>L<dormando@rydia.net>E<gt>

=head1 BUGS

None known.

=head1 LICENSE

Licensed for use and redistribution under the same terms as Perl itself.

=cut

use strict;
use warnings;

use lib './lib';
use MogileFS::Utils;

my $util = MogileFS::Utils->new;
my $usage = "--trackers=host --domain=foo --key='/hello.jpg' --file='./output'";
my $c = $util->getopts($usage, qw/key=s file=s/);

my $mogc = $util->client;

# Default to noverify, don't hang up the tracker. We'll try all paths.
my @paths = $mogc->get_paths($c->{key}, { noverify => 1 });
if ($mogc->errcode) {
    die "Error fetching paths: " . $mogc->errstr;
}

die "No paths found or key does not exist" unless @paths;

my $filename = $c->{file};
my @resses;
for my $path (@paths) {
    next unless $path; # overparanoid?
    my $ua = LWP::UserAgent->new;
    $ua->timeout(10);

    my $file;
    if ($filename eq '-') {
        $file = *STDOUT;
    } else {
        open($file, "> $filename") or die "Could not open " . $filename;
    }

    my $writeout = sub {
        print $file $_[0];
    };
    my $res = $ua->get($path, ':content_cb' => $writeout,
        ':read_size_hint' => 32768);

    if ($res->is_success) {
        last;
    } else {
        # print all the errors to be the most helpful
        push(@resses, $res);
        next;
    }
}

if (@resses) {
    for my $res (@resses) {
        print STDERR "Got errors while trying to fetch:\n";
        print STDERR $res->status_line, "\n";
    }
}