Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Tree: 285332adf2
Fetching contributors…

Cannot retrieve contributors at this time

executable file 106 lines (71 sloc) 2.126 kB
#!/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";
}
}
Jump to Line
Something went wrong with that request. Please try again.