The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

=head1 NAME

moglistfids -- Iterate fid/key data from a MogileFS installation

=head1 DESCRIPTION

Example utility for pulling all file data out of a MogileFS installation.
Utilities like this can be built on for creating backup systems,
Mogile<->Mogile syncronization systems, or Mogile->S3 syncronization.

This method is only a way of pulling new files which have existed since the
last time it was checked, as there's no logging of deleted files.

=head1 OPTIONS

=over

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

Use these MogileFS trackers to negotiate with.

=item --fromfid=<fid>

The highest numbered fid fetched the last time this utility was run.

=item --count=<count>

Numer of fids to inspect and return.

=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 MogileFS::Admin;
use lib './lib';
use MogileFS::Utils;

my $util = MogileFS::Utils->new;
my $usage = "--trackers=host --fromfid=123 --count=5000";
my $c = $util->getopts($usage, qw/fromfid=i count=i/);

my $moga = MogileFS::Admin->new(hosts => $c->{trackers});

my $fromfid = $c->{fromfid} || 0;
my $count   = $c->{count} || 100;

while ($count) {
    # Try to fetch the max, but we will likely get less.
    my $fids_chunk = $moga->list_fids($fromfid, $count);
    if ($moga->errcode) {
        die "Error listing fids: ", $moga->errstr, "\n";
    }
    my @fids = sort { $a <=> $b } keys %$fids_chunk;
    last unless @fids;
    $fromfid = $fids[-1];
    $count  -= @fids;
    for my $fid (@fids) {
        my $file = $fids_chunk->{$fid};
        print "fid ", $fid, "\n";
        for my $key (sort keys %$file) {
            my $val = $file->{$key};
            $val = _escape_url_string($val) if $key eq 'dkey';
            print $key, " ", $val, "\n";
        }
        print "\n";
    }
}

sub _escape_url_string {
    my $str = shift;
    $str =~ s/([^a-zA-Z0-9_\,\-.\/\\\: ])/uc sprintf("%%%02x",ord($1))/eg;
    $str =~ tr/ /+/;
    return $str;
}