#!/usr/bin/env perl

# Copyright (C) 2006  Joshua Hoblitt
#
# $Id: dsleech,v 1.2 2006-08-31 23:04:53 jhoblitt Exp $

use strict;
use warnings FATAL => qw( all );

use vars qw( $VERSION );
$VERSION = '0.01';

use DataStore;
use File::Spec;

use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt );
use Pod::Usage qw( pod2usage );

my ($dir, $uri, $last_fileset, $verbose);

GetOptions(
    'dir|d=s'           => \$dir,
    'uri|u=s'           => \$uri,
    'last_fileset|l=s'  => \$last_fileset,
    'verbose|v'           => \$verbose,
) or pod2usage( 2 );

pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;
pod2usage(
    -msg => "Required options: --uri",
    -exitval => 3,
) unless defined $uri;

my %p = (
    uri     => $uri,
);

$p{last_fileset} = $last_fileset if defined $last_fileset; 

my $response = DataStore::Product->new(%p)->request;
unless (defined $response->is_success) {
    die "request failed: ", $response->status_line;
}

# file retreival succeed

my $filesets = $response->data;
unless ($filesets) {
    warn "no filesets found";
    exit(0);
}

process_filesets($filesets, $dir, $verbose) or die "failed to process filesets";

sub process_filesets
{
    my ($filsets, $dir, $verbose) = @_;

    foreach my $fileset (@$filesets) {
        my $response = $fileset->request;
        unless (defined $response->is_success) {
            warn "request failed: ", $response->status_line;
            return;
        }

        my $files = $response->data;
        unless (@$files) {
            print "no files in fileset ", $fileset->set, "\n" if $verbose;
            next;
        }

        if (!process_files($files, $dir, $verbose)) {
            warn "failed to process files";
            return;
        }
    }

    return 1;
}

sub process_files
{
    my ($files, $dir, $vebose) = @_;

    foreach my $file (@$files) {
        # generate the filename to downloda too
        my $filename;
        if (defined $dir) {
            if (!-e $dir) {
                print "creating dir $dir\n" if $verbose;
                mkdir $dir or die "can't create dir: $!";
            }
            if (!-d $dir) {
                warn "$dir is not a directory";
                return;
            }

            $filename = File::Spec->catfile($dir, $file->fileid);
        } else {
            $filename = $file->fileid;
        }

        # make sure that filename doesn't already exist
        if (-e $filename) {
            warn "file $filename already exists, skipping...";
            next;
        }

        # use the short version of the filename (with out the path) 
        print "fetching ", $file->fileid, "..." if $verbose;

        my $response = $file->request( filename => $filename );
        unless (defined $response->is_success) {
            warn "request failed: ", $response->status_line;
            return;
        }

        unless ($response->data) {
            warn "there was a problem retreiving ", $file->fileid;
            return;
        }

        print "    ok\n" if $verbose;
    }

    return 1;
}

__END__

=pod

=head1 NAME

dsleech - batch retrieve files from a DataStore server product

=head1 SYNOPSIS

    dsproductls --uri <uri> [--dir <dir>] [--last_fileset <filesetid>]
                [--verbose]

=head1 DESCRIPTION

=head1 OPTIONS

=over 4

=item * --uri|-u <uri>

The URI of the DataStore product to retrive files from.

=item * --dir|-d <dir>

This flag is optional.

The directory to download retrived files into.  The default is to fetch files into the current directory.

=item * --last_fileset|-l <filesetid>

The FileSet ID of the last FileSet that you've seen.  Only filesets registered after C<filesetid> will be polled for files to retreive.

This flag is optional.

=item * --verbose|-v

Be more verbose in reporting actions.

This flag is optional.

=back

=head1 CREDITS

Just me, myself, and I.

=head1 SUPPORT

Please contact the author directly via e-mail.

=head1 AUTHOR

Joshua Hoblitt <jhoblitt@cpan.org>

=head1 COPYRIGHT

Copyright (C) 2006  Joshua Hoblitt.  All rights reserved.

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version.

This program is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.  See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place - Suite 330, Boston, MA  02111-1307, USA.

The full text of the license can be found in the L<perlgpl> Pod as supplied
with Perl 5.8.1 and later.

=head1 SEE ALSO

L<dsproductls>, L<dsfilesetls>, L<dsget>, L<DataStore>

=cut
