File Coverage

lib/FFI/Build/File/Base.pm
Criterion Covered Total %
statement 80 88 90.9
branch 17 24 70.8
condition 3 5 60.0
subroutine 23 27 85.1
pod 16 16 100.0
total 139 160 86.8


line stmt bran cond sub pod time code
1             package FFI::Build::File::Base;
2              
3 15     15   223339 use strict;
  15         41  
  15         533  
4 15     15   74 use warnings;
  15         29  
  15         673  
5 15     15   255 use 5.008004;
  15         56  
6 15     15   80 use Carp ();
  15         52  
  15         459  
7 15     15   5314 use FFI::Temp;
  15         86  
  15         532  
8 15     15   103 use File::Basename ();
  15         141  
  15         296  
9 15     15   6499 use FFI::Build::Platform;
  15         146  
  15         613  
10 15     15   4180 use FFI::Build::PluginData;
  15         37  
  15         1357  
11 15     15   132 use overload '""' => sub { $_[0]->path }, bool => sub { 1 }, fallback => 1;
  15     164   28  
  15         190  
  91         8820  
  185         955  
12              
13             # ABSTRACT: Base class for File::Build files
14             our $VERSION = '2.11'; # VERSION
15              
16              
17             sub new
18             {
19 232     232 1 492101 my($class, $content, %config) = @_;
20              
21 232   50     1598 my $base = $config{base} || 'ffi_build_';
22 232         445 my $dir = $config{dir};
23 232         434 my $build = $config{build};
24 232   66     949 my $platform = $config{platform} || FFI::Build::Platform->new;
25              
26 232         972 my $self = bless {
27             platform => $platform,
28             build => $build,
29             }, $class;
30              
31 232 100       1201 if(!defined $content)
    100          
    100          
    50          
32             {
33 1         181 Carp::croak("content is required");
34             }
35             elsif(ref($content) eq 'ARRAY')
36             {
37 105         3963 $self->{path} = File::Spec->catfile(@$content);
38             }
39             elsif(ref($content) eq 'SCALAR')
40             {
41 18         36 my %args;
42 18         228 $args{TEMPLATE} = "${base}XXXXXX";
43 18 100       73 $args{DIR} = $dir if $dir;
44 18         192 $args{SUFFIX} = $self->default_suffix;
45 18         66 $args{UNLINK} = 0;
46              
47 18         230 my $fh = $self->{fh} = FFI::Temp->new(%args);
48              
49 18         11763 binmode( $fh, $self->default_encoding );
50 18         278 print $fh $$content;
51 18         991 close $fh;
52              
53 18         119 $self->{path} = $fh->filename;
54 18         343 $self->{temp} = 1;
55             }
56             elsif(ref($content) eq '')
57             {
58 108         440 $self->{path} = $content;
59             }
60              
61 231 50       1230 if($self->platform->osname eq 'MSWin32')
62             {
63 0         0 $self->{native} = File::Spec->catfile($self->{path});
64 0         0 $self->{path} =~ s{\\}{/}g;
65             }
66              
67 231         1121 $self;
68             }
69              
70              
71 0     0 1 0 sub default_suffix { die "must define a default extension in subclass" }
72 0     0 1 0 sub default_encoding { die "must define an encoding" }
73 0     0 1 0 sub accept_suffix { () }
74              
75              
76 562     562 1 19347 sub path { shift->{path} }
77 68     68 1 8205 sub basename { File::Basename::basename shift->{path} }
78 163     163 1 25117 sub dirname { File::Basename::dirname shift->{path} }
79 3     3 1 21 sub is_temp { shift->{temp} }
80 617     617 1 3551 sub platform { shift->{platform} }
81 640     640 1 5531 sub build { shift->{build} }
82              
83              
84             sub native {
85 2     2 1 542 my($self) = @_;
86             $self->platform->osname eq 'MSWin32'
87             ? $self->{native}
88 2 50       25 : $self->{path};
89             }
90              
91              
92             sub slurp
93             {
94 4     4 1 1122 my($self) = @_;
95 4         7 my $fh;
96 4 50       23 open($fh, '<', $self->path) || Carp::croak "Error opening @{[ $self->path ]} for read $!";
  0         0  
97 4         31 binmode($fh, $self->default_encoding);
98 4         9 my $content = do { local $/; <$fh> };
  4         20  
  4         175  
99 4         51 close $fh;
100 4         44 $content;
101             }
102              
103              
104             sub keep
105             {
106 1     1 1 14 delete shift->{temp};
107             }
108              
109              
110             sub build_item
111             {
112 0     0 1 0 Carp::croak("Not implemented!");
113             }
114              
115              
116             sub needs_rebuild
117             {
118 3     3 1 24 my($self, @source) = @_;
119             # if the target doesn't exist, then we definitely
120             # need a rebuild.
121 3 50       24 return 1 unless -f $self->path;
122 3         13 my $target_time = [stat $self->path]->[9];
123 3         29 foreach my $source (@source)
124             {
125 3         33 my $source_time = [stat "$source"]->[9];
126 3 50       14 return 1 if ! defined $source_time;
127 3 50       56 return 1 if $source_time > $target_time;
128             }
129 0         0 return 0;
130             }
131              
132              
133             sub ld
134             {
135 114     114 1 517 return undef;
136             }
137              
138             sub DESTROY
139             {
140 86     86   10649 my($self) = @_;
141              
142 86 100       1872 if($self->{temp})
143             {
144 9         102 unlink($self->path);
145             }
146             }
147              
148             1;
149              
150             __END__