File Coverage

blib/lib/Catmandu/BagIt/Payload.pm
Criterion Covered Total %
statement 41 42 97.6
branch 5 6 83.3
condition 2 4 50.0
subroutine 10 10 100.0
pod 0 6 0.0
total 58 68 85.2


line stmt bran cond sub pod time code
1             package Catmandu::BagIt::Payload;
2              
3             our $VERSION = '0.250';
4              
5 7     7   55 use Moo;
  7         16  
  7         66  
6 7     7   2858 use IO::File;
  7         23  
  7         1070  
7 7     7   55 use File::Copy;
  7         15  
  7         392  
8 7     7   58 use Path::Tiny qw();
  7         38  
  7         4126  
9              
10             has 'filename' => (is => 'ro');
11             has 'path' => (is => 'ro');
12             has 'flag' => (is => 'rw', default => 0);
13              
14             sub from_any {
15 19     19 0 56 my ($class,$filename,$handle) = @_;
16              
17 19 100       105 if (ref($handle) eq '') {
    100          
    50          
18 8         38 return $class->from_string($filename,$handle);
19             }
20             elsif (ref($handle) =~ /^IO/) {
21 10         39 return $class->from_io($filename,$handle);
22             }
23             elsif (ref($handle) eq 'CODE') {
24 1         4 return $class->from_callback($filename,$handle);
25             }
26             else {
27 0         0 die "unknown handle type `" . ref($handle) . "`";
28             }
29             }
30              
31             sub from_io {
32 10     10 0 29 my ($class,$filename,$io) = @_;
33              
34 10         64 my $tempfile = Path::Tiny->tempfile(UNLINK => 0);
35              
36 10         6098 copy($io, $tempfile);
37              
38 10         4976 my $inst = $class->new(filename => $filename, path => "$tempfile");
39              
40             # Flag the file as new so that we know the temporary files need
41             # to be moved to a new location later
42 10         3202 $inst->{is_new} = 1;
43              
44 10         84 return $inst;
45             }
46              
47             sub from_string {
48 8     8 0 20 my ($class,$filename,$str) = @_;
49              
50 8         52 my $tempfile = Path::Tiny->tempfile(UNLINK => 0);
51              
52 8         5306 Path::Tiny::path($tempfile)->spew_utf8($str);
53              
54 8         5200 my $inst = $class->new(filename => $filename, path => "$tempfile");
55              
56             # Flag the file as new so that we know the temporary files need
57             # to be moved to a new location later
58 8         1922 $inst->{is_new} = 1;
59              
60 8         42 return $inst;
61             }
62              
63             sub from_callback {
64 1     1 0 4 my ($class,$filename,$callback) = @_;
65              
66 1         5 my $tempfile = Path::Tiny->tempfile(UNLINK => 0);
67              
68 1   50     495 my $fh = IO::File->new(">$tempfile") || die "failed to open $tempfile for writing";
69              
70 1         118 $callback->($fh);
71              
72 1         82 $fh->close;
73              
74 1         71 my $inst = $class->new(filename => $filename, path => "$tempfile");
75              
76             # Flag the file as new so that we know the temporary files need
77             # to be moved to a new location later
78 1         53 $inst->{is_new} = 1;
79              
80 1         6 return $inst;
81             }
82              
83             sub open {
84 106     106 0 3170 my $self = shift;
85 106   50     568 return IO::File->new($self->path) || die "failed to open `" . $self->path . "` for reading: $!";
86             }
87              
88             sub is_new {
89 14     14 0 33 my $self = shift;
90              
91 14         117 $self->{is_new};
92             }
93              
94             1;
95              
96             __END__