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.260';
4              
5 7     7   58 use Moo;
  7         13  
  7         61  
6 7     7   2688 use IO::File;
  7         17  
  7         1068  
7 7     7   53 use File::Copy;
  7         14  
  7         428  
8 7     7   44 use Path::Tiny qw();
  7         24  
  7         4369  
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 74 my ($class,$filename,$handle) = @_;
16              
17 19 100       112 if (ref($handle) eq '') {
    100          
    50          
18 8         27 return $class->from_string($filename,$handle);
19             }
20             elsif (ref($handle) =~ /^IO/) {
21 10         41 return $class->from_io($filename,$handle);
22             }
23             elsif (ref($handle) eq 'CODE') {
24 1         6 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 41 my ($class,$filename,$io) = @_;
33              
34 10         63 my $tempfile = Path::Tiny->tempfile(UNLINK => 0);
35              
36 10         7123 copy($io, $tempfile);
37              
38 10         5485 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         3381 $inst->{is_new} = 1;
43              
44 10         89 return $inst;
45             }
46              
47             sub from_string {
48 8     8 0 17 my ($class,$filename,$str) = @_;
49              
50 8         49 my $tempfile = Path::Tiny->tempfile(UNLINK => 0);
51              
52 8         5372 Path::Tiny::path($tempfile)->spew_utf8($str);
53              
54 8         5722 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         2057 $inst->{is_new} = 1;
59              
60 8         38 return $inst;
61             }
62              
63             sub from_callback {
64 1     1 0 5 my ($class,$filename,$callback) = @_;
65              
66 1         7 my $tempfile = Path::Tiny->tempfile(UNLINK => 0);
67              
68 1   50     690 my $fh = IO::File->new(">$tempfile") || die "failed to open $tempfile for writing";
69              
70 1         115 $callback->($fh);
71              
72 1         83 $fh->close;
73              
74 1         88 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         57 $inst->{is_new} = 1;
79              
80 1         6 return $inst;
81             }
82              
83             sub open {
84 106     106 0 3402 my $self = shift;
85 106   50     635 return IO::File->new($self->path) || die "failed to open `" . $self->path . "` for reading: $!";
86             }
87              
88             sub is_new {
89 14     14 0 29 my $self = shift;
90              
91 14         108 $self->{is_new};
92             }
93              
94             1;
95              
96             __END__