App-Glacier
17 results

 view release on metacpan or  search on metacpan

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

68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
        $self->usage_error("unrecognized command");
    } elsif ($#v > 0) {
        $self->usage_error("ambiguous command: ".join(', ', @v));
    }
    return $self->getcom($v[0]);
}

sub new {
    my ($class, $argref) = shift;
 
    my $self = $class->SUPER::new(
        $argref,
        optmap => {
        'config-file|f=s' => 'config',
        'account=s' => 'account',
        'region=s' => 'region'
    });
 
    my $com = shift @{$self->argv}
        or $self->usage_error("no command name");
    &{$self->getcom($com)}($self->argv,

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

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
        or return $class->new_failed('availability region not supplied');
    my $access = delete $opts{access};
    my ($secret,$token);
    if (defined($access)) {
        $secret = delete $opts{secret}
                or $class->new_failed('secret not supplied');
    } else {
        ($access, $secret, $token) = _get_instore_creds()
            or return $class->new_failed('no credentials supplied');
    }
    my $self = $class->SUPER::new($region, $access, $secret);
    if ($token) {
        # Overwrite the 'sig' attribute.
        # FIXME: The attribute itself is not documented, so this 
        # method may fail if the internals of the base class change
        # in its future releases.
        # This approach works with Net::Amazon::Glacier 0.15
        $self->{sig} = new App::Glacier::Signature($self->{sig}, $token);
    }
    return $self;
}

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

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
    $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);
exit(EX_CONFIG) unless $self->{_config}->parse();

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

148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
        $self->abend(EX_CONFIG, $self->{_glacier}->last_error_message);
    }
    return $self;
}
 
# Produce a semi-flat clone of $orig, blessing it into $class.
# The clone is semi-flat, because it shares the parsed configuration and
# the glacier object with the $orig.
sub clone {
    my ($class, $orig) = @_;
    my $self = $class->SUPER::clone($orig);
    $self->{_config} = $orig->config; 
    $self->{_glacier} = $orig->{_glacier};
    $self->{_jobdb} = $orig->{_jobdb};
    $self
}
 
sub option {
    my ($self, $opt, $val) = @_;
    if (defined($val)) {
        $self->{_options}{$opt} = $val;

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

82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
=cut
 
use constant {
    IFEXISTS_OVERWRITE => 0,
    IFEXISTS_KEEP => 1,
    IFEXISTS_ASK => 2,
};
     
sub new {
    my ($class, $argref, %opts) = @_;
    my $self = $class->SUPER::new(
        $argref,
        optmap => {
            'interactive|i' => sub {
                $_[0]->{_options}{ifexists} = IFEXISTS_ASK
            },
            'force|f' => sub {
                $_[0]->{_options}{ifexists} = IFEXISTS_OVERWRITE
            },
            'no-clobber|keep|k' => sub {
                $_[0]->{_options}{ifexists} = IFEXISTS_KEEP

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

89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
 
=head1 SEE ALSO
 
B<glacier>(1),    
B<strftime>(3).
     
=cut    
 
sub new {
    my ($class, $argref, %opts) = @_;
    $class->SUPER::new(
        $argref,
        optmap => {
            'time-style=s' => sub { $_[0]->set_time_style_option($_[2]) },
            'long|l+' => 'long',
            'cached|c' => 'cached',
        },
        %opts);
}
 
sub run {

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

166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
    },
    time => sub {
        my ($a, $b) = @_;
        $a->{CreationDate}->epoch <=> $b->{CreationDate}->epoch;
    },
    size => sub {
        my ($a, $b) = @_;
        $a->{Size} <=> $b->{Size}
    }
);
my $self = $class->SUPER::new(
    $argref,
    optmap => {
        'cached|c' => 'cached',
        'directory|d' => 'd',
        'l' => 'l',
        'sort=s' => 'sort',
        't' => sub { $_[0]->{_options}{sort} = 'time' },
        'S' => sub { $_[0]->{_options}{sort} = 'size' },
        'U' => sub { $_[0]->{_options}{sort} = 'none' },
        'human-readable|h' => 'h',

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

37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
=back
     
=head1 SEE ALSO
 
B<glacier>(1).    
     
=cut
 
sub new {
    my ($class, $argref, %opts) = @_;
    my $self = $class->SUPER::new(
        $argref,
        optmap => {
            'interactive|i' => 'interactive',
            'force|f' => sub { $_[0]->{_options}{interactive} = 0 }
        },
        %opts);
    $self->{_options}{interactive} //= 1;
    $self
}       
    

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

65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
=back    
 
=head1 SEE ALSO
 
B<glacier>(1).
     
=cut    
 
sub new {
    my ($class, $argref, %opts) = @_;
    $class->SUPER::new(
        $argref,
        optmap => {
            'jobs|j=i' => 'jobs',
            'quiet|q' => 'quiet',
            'rename|r' => 'rename'
        }, %opts);
}
 
sub run {
    my $self = shift;

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

43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
=back
 
=head1 SEE ALSO
 
B<glacier>(1).    
     
=cut
 
sub new {
    my ($class, $argref, %opts) = @_;
    $class->SUPER::new(
        $argref,
        optmap => {
            'force|f' => 'force',
            'delete|d' => 'delete'
        },
        %opts);
}
 
sub run {
    my $self = shift;

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

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
use warnings;
use parent 'https://metacpan.org/pod/DateTime">DateTime';
 
use Carp;
use DateTime;
 
sub new {
    my ($class, @opts) = shift;
    unless (@opts) {
        my ($second, $minute, $hour, $day, $month, $year) = gmtime;
        return $class->SUPER::new(year => 1900 + $year,
                                  month => $month + 1,
                                  day => $day,
                                  hour => $hour,
                                  minute => $minute,
                                  second => $second);
    }
    return $class->SUPER::new(@_);
}
 
sub strftime {
    my $self = shift;
    if (@_ > 1) {
        return map { $self->strftime($_) } @_;
    } else {
        my $fmt = shift;
        # DateTime::strftime misinterprets %c. so handle it separately
        $fmt =~ s{(?<!%)%c}

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

35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
                                  $self->day,
                                  $self->month - 1,
                                  $self->year - 1900,
                                  -1,
                                  -1,
                                  $self->is_dst())}gex;
        if ($fmt !~ /(?<!%)%/) {
            return $fmt;
        } else {
#           print "FMT ".$self->year."-".$self->month."-".$self->day."-".$self->hour.';'.$self->minute."\n";
            return $self->SUPER::strftime($fmt)
        }
    }
}

sub _fmt_default {
    my ($dt) = @_;
    my $now = new App::Glacier::DateTime;
    $dt = $dt->epoch;
    $now = $now->epoch;
    if ($dt < $now && $now - $dt < 6*31*86400) {

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

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
our @EXPORT_OK = qw(DIR_UPTODATE DIR_PENDING DIR_OUTDATED);
our %EXPORT_TAGS = ( status => [ qw(DIR_UPTODATE DIR_PENDING DIR_OUTDATED) ] );
 
use constant DB_INFO_KEY => ';00INFO';
 
sub new {
    my ($class, $backend, $vault, $glacier, %opts) = @_;
    (my $vault_name = $vault) =~
        s/([^A-Za-z_0-9\.-])/sprintf("%%%02X", ord($1))/gex;
    map { $opts{$_} =~ s/\$(?:vault|\{vault\})/$vault_name/g } keys %opts;
    my $self = $class->SUPER::new($backend,
                                  %opts,
                       create => sub { $glacier->describe_vault($vault_name) },
    );
    if ($self) {
        $self->{_vault} = $vault;
        $self->{_glacier} = $glacier;
    }
    return $self;
}
 
sub vault { shift->{_vault} }
sub glacier { shift->{_glacier} }
 
# locate(FILE, VERSION)
sub locate {
    my ($self, $file, $version) = @_;
    $version = 1 unless defined $version;
    my $rec = $self->SUPER::retrieve($file);
    return undef unless defined $rec || $version-1 > $#{$rec};
    return wantarray ? ($rec->[$version-1], $version) : $rec->[$version-1];
}
 
sub info {
    my ($self, $key) = @_;
    my $rec = $self->retrieve(DB_INFO_KEY);
    return undef unless defined($rec);
    return $rec->{$key};
}
 
sub set_info {
    my ($self, $key, $val) = @_;
    my $rec = $self->retrieve(DB_INFO_KEY) || {};
    $rec->{$key} = $val;
    $self->SUPER::store(DB_INFO_KEY, $rec);
}
 
sub last_sync_time {
    my ($self) = @_;
    return $self->info('SyncTimeStamp');
}
 
sub update_sync_time {
    my ($self) = @_;
    $self->set_info('SyncTimeStamp', time);
}
 
sub foreach {
    my ($self, $code) = @_;
    $self->SUPER::foreach(sub {
                              my ($k, $v) = @_;
                              &{$code}($k, $v) unless $k eq DB_INFO_KEY;
                          });
}
             
sub add_version {
    my ($self, $file_name, $val) = @_;
    my $rec = $self->retrieve($file_name);
    my $i;
    if ($rec) {
        my $t = $val->{CreationDate}->epoch;
        for ($i = 0; $i <= $#{$rec}; $i++) {
            last if $t >= $rec->[$i]{CreationDate}->epoch;
        }
        splice(@{$rec}, $i, 0, $val);
    } else {
        $i = 0;
        $rec = [ $val ];
    }
    $self->SUPER::store($file_name, $rec);
    return $i + 1;
}
 
sub delete_version {
    my ($self, $file_name, $ver) = @_;
    $ver--;
    my $rec = $self->retrieve($file_name);
    if ($rec && $ver <= $#{$rec}) {
        splice(@{$rec}, $ver, 1);
        if (@{$rec}) {
            $self->SUPER::store($file_name, $rec);
        } else {
            $self->delete($file_name);
        }
    } else {
        ++$ver;
        croak "can't remove $file_name;$ver: no such version";
    }
}
 
sub tempname {

lib/App/Glacier/Directory/GDBM.pm  view on Meta::CPAN 

1
2
3
4
5
6
7
8
9
10
11
12
package App::Glacier::Directory::GDBM;
use parent 'https://metacpan.org/pod/App::Glacier::DB::GDBM">App::Glacier::DB::GDBM';
 
sub configtest {
    my ($class, $cfg, @path) = @_;
    unless ($cfg->isset(@path, 'file')) {
        $cfg->set(@path, 'file', '/var/lib/glacier/inv/$vault.db');
    }
    $class->SUPER::configtest($cfg, @path);
}
 
1;

lib/App/Glacier/Job/ArchiveRetrieval.pm  view on Meta::CPAN 

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
use parent qw(https://metacpan.org/pod/App::Glacier::Job">App::Glacier::Job);
use App::Glacier::Core;
use Carp;
 
# new(CMD, VAULT, ARCHIVE[, description => DESCR, OPTS...])
sub new {
    croak "bad number of arguments" if $#_ < 3;
    my ($class, $cmd, $vault, $archive, %opts) = @_;
    my $descr = delete $opts{description};
    my $self = $class->SUPER::new(
        $cmd,
        $vault,
        $vault . ':' . $archive,
        %opts
        );
    $self->{_archive} = $archive;
    $self->{_descr} = $descr;
    return $self;
}

lib/App/Glacier/Job/FileRetrieval.pm  view on Meta::CPAN 

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
                    "nothing is known about vault $vault; please get directory listing first");
    }
    my $archive;
    ($archive, $version) = $dir->locate($file, $version);
    unless ($archive) {
        $version = 1 unless defined $version;
        $cmd->abend(EX_NOINPUT,
                    "$vault:$file;$version not found; make sure directory listing is up-to-date");
    }
     
    my $self = $class->SUPER::new($cmd, $vault, $archive->{ArchiveId},
                                  description => "Retrieval of $file;$version",
                                  ttl => $cmd->cfget(qw(database job ttl)));
    $self->{_filename} = $file;
    $self->{_fileversion} = $version;
    return $self;
}
 
sub file_name {
    my ($self, $full) = @_;
    if ($full) {

lib/App/Glacier/Job/InventoryRetrieval.pm  view on Meta::CPAN 

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
use warnings;
 
use parent qw(https://metacpan.org/pod/App::Glacier::Job">App::Glacier::Job);
use App::Glacier::Core;
use Carp;
 
# new(CMD, VAULT)
sub new {
    croak "bad number of arguments" unless $#_ >= 2;
    my ($class, $cmd, $vault, %opts) = @_;
    return $class->SUPER::new(
        $cmd, $vault, $vault,
        ttl => $cmd->cfget(qw(database inv ttl)),
        %opts);
}
 
sub init {
    my $self = shift;
    my $jid = $self->glacier->Initiate_inventory_retrieval(
                          $self->vault,
                          'JSON',

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

1
2
3
4
5
6
7
8
9
10
11
12
13
package App::Glacier::Roster;
use parent 'https://metacpan.org/pod/App::Glacier::DB">App::Glacier::DB';
 
sub foreach {
    my ($self, $fun) = @_;
    $self->SUPER::foreach(sub {
        my ($key, $descr) = @_;
        (my $vault = $descr->{VaultARN}) =~ s{.*:vaults/}{};
        &{$fun}($key, $descr, $vault);
    });
}       
 
1;

lib/App/Glacier/Roster/GDBM.pm  view on Meta::CPAN 

1
2
3
4
5
6
7
8
9
10
11
12
package App::Glacier::Roster::GDBM;
use parent 'https://metacpan.org/pod/App::Glacier::DB::GDBM">App::Glacier::DB::GDBM';
 
sub configtest {
    my ($class, $cfg, @path) = @_;
    unless ($cfg->isset(@path, 'file')) {
        $cfg->set(@path, 'file', '/var/lib/glacier/job.db');
    }
    $class->SUPER::configtest($cfg, @path);
}
 
1;



( run in 0.451 second using v1.01-cache-2.11-cpan-94b05bcf43c )