view release on metacpan or  search on metacpan

lib/App/Glacier/Command.pm  view on Meta::CPAN

package App::Glacier::Command;

use strict;
use warnings;
use Carp;
use App::Glacier::Core;
use parent 'App::Glacier::Core';
use File::Basename;
use File::Spec;
use App::Glacier::EclatCreds;
use App::Glacier::Config;
use App::Glacier::Bre;
use App::Glacier::Timestamp;
use App::Glacier::Directory;
use App::Glacier::Roster;

use Digest::SHA qw(sha256_hex);
use File::Path qw(make_path);

use constant MB => 1024*1024;

sub ck_number {
    my ($vref) = @_;
    return "not a number"
        unless $$vref =~ /^\d+/;
    return undef;
}

sub ck_size {
    my ($vref) = @_;
    if ($$vref =~ /^(\d+)\s*([kKmMgG])?$/) {
	my $size = $1;
	if ($2) {
	    my $suf = lc $2;
	    foreach my $m (qw(k m g)) {
		$size *= 1024;
		last if $m eq $suf;
	    }
	}
	$$vref = $size;
    } else {
	return 'invalid size specification';
    }
}

my %parameters = (
    glacier => {
	section => {
	    credentials => 1,
	    access => 1,
	    secret => 1,
	    region => 1,
	}
    },
    transfer => {
	section => {
	    'single-part-size' => { default => 100*MB, check => \&ck_size },
	    'jobs' => { default => 16, check => \&ck_number },
	    'retries' => { default => 10, check => \&ck_number },
	    upload => {
		section => {
		    'single-part-size' => { check => \&ck_size },
		    'jobs' => { check => \&ck_number },
		    'retries' => { check => \&ck_number },
		}
	    }, 
	    download => {
		section => {
		    'single-part-size' => { check => \&ck_size },
		    'jobs' => { check => \&ck_number },
		    'retries' => { check => \&ck_number },
		    'cachedir' => { default => '/var/lib/glacier/cache' }	
		}
	    }
	}
    },
    database => {
	section => {
	    job => {
		section => {
		    backend => { default => 'GDBM' },
		    '*' => '*'
		},
	    },
	    inv => {
		section => {
		    backend => { default => 'GDBM' },
		    '*' => '*'
		}
	    }
	}
    }
);

sub new {
    my $class = shift;
    my $argref = shift;
    local %_ = @_;

    my $config_file = delete $_{config} || $ENV{GLACIER_CONF};
    unless ($config_file) {
	$config_file = -f '/etc/glacier.conf'
	                ? '/etc/glacier.conf' : '/dev/null';
    }
    my $account = delete $_{account};
    my $region = delete $_{region};

    my $debug = delete $_{debug};
    my $dry_run = delete $_{dry_run};
    my $progname = delete $_{progname};
    
    my $self = $class->SUPER::new($argref, %_);

    $self->{_debug} = $debug if $debug;
    $self->{_dry_run} = $dry_run if $dry_run;
    $self->progname($progname) if $progname;
    
    $self->{_config} = new App::Glacier::Config($config_file,
						debug => $self->{_debug},
						parameters => \%parameters);