mogfetch

   1 #!/usr/bin/perl
   2
   3 =head1 NAME
   4
   5 mogfetch -- Fetch data from a MogileFS installation
   6
   7 =head1 SYNOPSIS
   8
   9     $ mogfetch [options]
  10     $ mogfetch [options] --file="-" > filename
  11
  12     $ mogfetch --trackers=host --domain=foo \
  13                --key="/hello.jpg" --file="output.jpg"
  14
  15 =head1 OPTIONS
  16
  17 =over
  18
  19 =item --trackers=host1:7001,host2:7001
  20
  21 Use these MogileFS trackers to negotiate with.
  22
  23 =item --domain=<domain>
  24
  25 Set the MogileFS domain to use.
  26
  27 =item --key="<key>"
  28
  29 The key to locate the data with. Can be an arbitrary string.
  30
  31 =item --file="<filename|->"
  32
  33 A local destination file. If '-', data is written to STDOUT instead.
  34
  35 =back
  36
  37 =head1 AUTHOR
  38
  39 Dormando E<lt>L<dormando@rydia.net>E<gt>
  40
  41 =head1 BUGS
  42
  43 None known.
  44
  45 =head1 LICENSE
  46
  47 Licensed for use and redistribution under the same terms as Perl itself.
  48
  49 =cut
  50
  51 use strict;
  52 use warnings;
  53
  54 use lib './lib';
  55 use MogileFS::Utils;
  56
  57 my $util = MogileFS::Utils->new;
  58 my $usage = "--trackers=host --domain=foo --key='/hello.jpg' --file='./output'";
  59 my $c = $util->getopts($usage, qw/key=s file=s/);
  60
  61 my $mogc = $util->client;
  62
  63 # Default to noverify, don't hang up the tracker. We'll try all paths.
  64 my @paths = $mogc->get_paths($c->{key}, { noverify => 1 });
  65 if ($mogc->errcode) {
  66     die "Error fetching paths: " . $mogc->errstr;
  67 }
  68
  69 die "No paths found or key does not exist" unless @paths;
  70
  71 my $filename = $c->{file};
  72 my @resses;
  73 for my $path (@paths) {
  74     next unless $path; # overparanoid?
  75     my $ua = LWP::UserAgent->new;
  76     $ua->timeout(10);
  77
  78     my $file;
  79     if ($filename eq '-') {
  80         $file = *STDOUT;
  81     } else {
  82         open($file, "> $filename") or die "Could not open " . $filename;
  83     }
  84
  85     my $writeout = sub {
  86         print $file $_[0];
  87     };
  88     my $res = $ua->get($path, ':content_cb' => $writeout,
  89         ':read_size_hint' => 32768);
  90
  91     if ($res->is_success) {
  92         last;
  93     } else {
  94         # print all the errors to be the most helpful
  95         push(@resses, $res);
  96         next;
  97     }
  98 }
  99
 100 if (@resses) {
 101     for my $res (@resses) {
 102         print STDERR "Got errors while trying to fetch:\n";
 103         print STDERR $res->status_line, "\n";
 104     }
 105     exit 1;
 106 }