File Coverage

blib/lib/Data/Embed/File.pm
Criterion Covered Total %
statement 40 42 95.2
branch 8 12 66.6
condition 3 9 33.3
subroutine 9 10 90.0
pod 4 4 100.0
total 64 77 83.1


line stmt bran cond sub pod time code
1             package Data::Embed::File;
2             {
3             $Data::Embed::File::VERSION = '0.21';
4             }
5              
6             # ABSTRACT: embed arbitrary data in a file
7              
8 8     8   43 use strict;
  8         14  
  8         378  
9 8     8   44 use warnings;
  8         13  
  8         309  
10 8     8   38 use English qw< -no_match_vars >;
  8         150  
  8         53  
11 8     8   7360 use IO::Slice;
  8         30947  
  8         304  
12 8     8   69 use Fcntl qw< :seek >;
  8         13  
  8         1191  
13 8     8   49 use Log::Log4perl::Tiny qw< :easy >;
  8         13  
  8         43  
14              
15              
16             sub new {
17 8     8 1 19 my $package = shift;
18 8 50 33     50 my $self = {(scalar(@_) && ref($_[0])) ? %{$_[0]} : @_};
  0         0  
19 8         14 for my $feature (qw< offset length >) {
20 16 50 33     138 LOGCROAK "$package new(): missing required field $feature"
21             unless defined($self->{$feature})
22             && $self->{$feature} =~ m{\A\d+\z}mxs;
23             }
24 8 50 33     26 LOGDIE "$package new(): either filename or fh are required"
25             unless defined($self->{fh}) || defined($self->{filename});
26 8         44 return bless $self, $package;
27             } ## end sub new
28              
29              
30             sub fh {
31 6     6 1 1570 my $self = shift;
32 6 50       25 if (!exists $self->{slicefh}) {
33 24         47 my %args = map { $_ => $self->{$_} }
  24         46  
34 6         10 grep { defined $self->{$_} } qw< fh filename offset length >;
35 6         47 $self->{slicefh} = IO::Slice->new(%args);
36             }
37 6         406 return $self->{slicefh};
38             } ## end sub fh
39              
40              
41             sub contents {
42 5     5 1 2262 my $self = shift;
43 5         21 my $fh = $self->fh();
44 5         20 my $current = tell $fh;
45 5         27 seek $fh, 0, SEEK_SET;
46              
47 5 100       121 local $/ = wantarray() ? $/ : undef;
48 5         18 my @retval = <$fh>;
49 5         271 seek $fh, $current, SEEK_SET;
50 5 100       77 return @retval if wantarray();
51 1         6 return $retval[0];
52             } ## end sub contents
53              
54              
55 0     0 1   sub name { return shift->{name}; }
56              
57             1;
58              
59             __END__