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.240';
4              
5 7     7   52 use Moo;
  7         14  
  7         53  
6 7     7   2625 use IO::File;
  7         16  
  7         1105  
7 7     7   49 use File::Copy;
  7         17  
  7         368  
8 7     7   43 use Path::Tiny qw();
  7         21  
  7         4003  
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 58 my ($class,$filename,$handle) = @_;
16              
17 19 100       113 if (ref($handle) eq '') {
    100          
    50          
18 8         27 return $class->from_string($filename,$handle);
19             }
20             elsif (ref($handle) =~ /^IO/) {
21 10         42 return $class->from_io($filename,$handle);
22             }
23             elsif (ref($handle) eq 'CODE') {
24 1         5 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 33 my ($class,$filename,$io) = @_;
33              
34 10         68 my $tempfile = Path::Tiny->tempfile(UNLINK => 0);
35              
36 10         6404 copy($io, $tempfile);
37              
38 10         5140 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         3410 $inst->{is_new} = 1;
43              
44 10         87 return $inst;
45             }
46              
47             sub from_string {
48 8     8 0 20 my ($class,$filename,$str) = @_;
49              
50 8         51 my $tempfile = Path::Tiny->tempfile(UNLINK => 0);
51              
52 8         5134 Path::Tiny::path($tempfile)->spew_utf8($str);
53              
54 8         4774 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         1688 $inst->{is_new} = 1;
59              
60 8         57 return $inst;
61             }
62              
63             sub from_callback {
64 1     1 0 4 my ($class,$filename,$callback) = @_;
65              
66 1         6 my $tempfile = Path::Tiny->tempfile(UNLINK => 0);
67              
68 1   50     484 my $fh = IO::File->new(">$tempfile") || die "failed to open $tempfile for writing";
69              
70 1         99 $callback->($fh);
71              
72 1         79 $fh->close;
73              
74 1         72 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         54 $inst->{is_new} = 1;
79              
80 1         6 return $inst;
81             }
82              
83             sub open {
84 106     106 0 3139 my $self = shift;
85 106   50     600 return IO::File->new($self->path) || die "failed to open `" . $self->path . "` for reading: $!";
86             }
87              
88             sub is_new {
89 14     14 0 35 my $self = shift;
90              
91 14         54 $self->{is_new};
92             }
93              
94             1;
95              
96             __END__