File Coverage

blib/lib/Net/AmazonS3/Simple/Object/File.pm
Criterion Covered Total %
statement 28 28 100.0
branch 4 6 66.6
condition 3 5 60.0
subroutine 7 7 100.0
pod 2 3 66.6
total 44 49 89.8


line stmt bran cond sub pod time code
1             package Net::AmazonS3::Simple::Object::File;
2 1     1   612 use strict;
  1         2  
  1         36  
3 1     1   9 use warnings;
  1         3  
  1         30  
4              
5 1     1   235 use parent 'Net::AmazonS3::Simple::Object';
  1         230  
  1         6  
6              
7 1     1   43 use Class::Tiny qw(file_path);
  1         2  
  1         3  
8              
9             =head1 NAME
10              
11             Net::AmazonS3::Simple::Object::File - S3 object in file
12              
13             =head1 SYNOPSIS
14              
15             Net::AmazonS3::Simple::Object::File->create_from_response(
16             response => $response,
17             file_path => path(...),
18             );
19              
20             =head1 DESCRIPTION
21              
22             =head1 METHODS
23              
24             =head2 new(%attributes)
25              
26             =head3 %attributes
27              
28             attributes from L
29              
30             =head4 file_path
31              
32             =cut
33              
34             sub BUILD {
35 2     2 0 28 my ($self) = @_;
36              
37 2         5 foreach my $req ( qw/file_path/ ) {
38 2 50       38 die "$req attribute required" if! defined $self->$req;
39             }
40              
41 2         50 my $content_md5 = uc $self->file_path->digest('MD5');
42 2         1589 my $expected_md5 = uc $self->etag;
43              
44 2 100 66     52 if ($self->validate && $content_md5 ne $expected_md5) {
45 1         21 die sprintf
46             'Object content %s (md5:%s) isn\'t expected ETag (md5:%s)',
47             $self->file_path,
48             $content_md5,
49             $expected_md5;
50             }
51             }
52              
53             =head2 create_from_response(%options)
54              
55             =head3 %options
56              
57             =head4 validate
58              
59             =head4 response
60              
61             =head4 file_path
62              
63             =cut
64              
65             sub create_from_response {
66 2     2 1 19412 my ($class, %options) = @_;
67              
68 2         8 foreach my $req (qw/validate response file_path/) {
69 6 50       24 die "$req parameter required" unless defined $options{$req};
70             }
71              
72 2         22 my $etag = $options{response}->header('ETag');
73 2         158 $etag =~ s/"//g;
74              
75 2   50     19 my $content_encoding = $options{response}->content_encoding() || undef;
76              
77             return $class->new(
78             validate => $options{validate},
79             etag => $etag,
80             content_encoding => $content_encoding,
81             content_type => $options{response}->content_type(),
82             content_length => $options{response}->content_length(),
83             last_modified => $options{response}->last_modified(),
84             file_path => $options{file_path},
85 2         139 );
86             }
87              
88             =head2 content
89              
90             return content of response
91              
92             =cut
93              
94             sub content {
95 1     1 1 2989 my ($self) = @_;
96              
97 1         29 return $self->file_path->slurp();
98             }
99              
100             =head1 LICENSE
101              
102             Copyright (C) Avast Software.
103              
104             This library is free software; you can redistribute it and/or modify
105             it under the same terms as Perl itself.
106              
107             =head1 AUTHOR
108              
109             Jan Seidl Eseidl@avast.comE
110              
111             =cut
112              
113             1;
114