File Coverage

blib/lib/FFI/Build/File/Base.pm
Criterion Covered Total %
statement 73 88 82.9
branch 14 24 58.3
condition 3 5 60.0
subroutine 22 27 81.4
pod 16 16 100.0
total 128 160 80.0


line stmt bran cond sub pod time code
1             package FFI::Build::File::Base;
2              
3 13     17   239145 use strict;
  13         40  
  13         379  
4 13     13   75 use warnings;
  13         29  
  13         286  
5 13     13   208 use 5.008004;
  13         49  
6 13     13   96 use Carp ();
  13         23  
  13         264  
7 13     13   3549 use FFI::Temp;
  13         35  
  13         394  
8 13     13   97 use File::Basename ();
  13         33  
  13         273  
9 13     13   5056 use FFI::Build::Platform;
  13         37  
  13         428  
10 13     13   2538 use FFI::Build::PluginData;
  13         37  
  13         1028  
11 13     13   90 use overload '""' => sub { $_[0]->path }, bool => sub { 1 }, fallback => 1;
  13     91   29  
  13         133  
  71         11195  
  141         1435  
12              
13             # ABSTRACT: Base class for File::Build files
14             our $VERSION = '2.08'; # VERSION
15              
16              
17             sub new
18             {
19 176     176 1 45816 my($class, $content, %config) = @_;
20              
21 176   50     1055 my $base = $config{base} || 'ffi_build_';
22 176         404 my $dir = $config{dir};
23 176         308 my $build = $config{build};
24 176   66     604 my $platform = $config{platform} || FFI::Build::Platform->new;
25              
26 176         791 my $self = bless {
27             platform => $platform,
28             build => $build,
29             }, $class;
30              
31 176 100       960 if(!defined $content)
    100          
    100          
    50          
32             {
33 1         191 Carp::croak("content is required");
34             }
35             elsif(ref($content) eq 'ARRAY')
36             {
37 79         2001 $self->{path} = File::Spec->catfile(@$content);
38             }
39             elsif(ref($content) eq 'SCALAR')
40             {
41 18         40 my %args;
42 18         106 $args{TEMPLATE} = "${base}XXXXXX";
43 18 100       194 $args{DIR} = $dir if $dir;
44 18         251 $args{SUFFIX} = $self->default_suffix;
45 18         59 $args{UNLINK} = 0;
46              
47 18         303 my $fh = $self->{fh} = FFI::Temp->new(%args);
48              
49 18         9425 binmode( $fh, $self->default_encoding );
50 18         320 print $fh $$content;
51 18         790 close $fh;
52              
53 18         148 $self->{path} = $fh->filename;
54 18         331 $self->{temp} = 1;
55             }
56             elsif(ref($content) eq '')
57             {
58 78         424 $self->{path} = $content;
59             }
60              
61 175 50       1056 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 175         1085 $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 352     352 1 10921 sub path { shift->{path} }
77 38     38 1 4125 sub basename { File::Basename::basename shift->{path} }
78 107     107 1 16410 sub dirname { File::Basename::dirname shift->{path} }
79 3     3 1 21 sub is_temp { shift->{temp} }
80 383     383 1 1992 sub platform { shift->{platform} }
81 304     304 1 3219 sub build { shift->{build} }
82              
83              
84             sub native {
85 2     2 1 423 my($self) = @_;
86             $self->platform->osname eq 'MSWin32'
87             ? $self->{native}
88 2 50       4 : $self->{path};
89             }
90              
91              
92             sub slurp
93             {
94 4     4 1 877 my($self) = @_;
95 4         6 my $fh;
96 4 50       16 open($fh, '<', $self->path) || Carp::croak "Error opening @{[ $self->path ]} for read $!";
  0         0  
97 4         31 binmode($fh, $self->default_encoding);
98 4         6 my $content = do { local $/; <$fh> };
  4         15  
  4         155  
99 4         46 close $fh;
100 4         41 $content;
101             }
102              
103              
104             sub keep
105             {
106 1     1 1 12 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 0     0 1 0 my($self, @source) = @_;
119             # if the target doesn't exist, then we definitely
120             # need a rebuild.
121 0 0       0 return 1 unless -f $self->path;
122 0         0 my $target_time = [stat $self->path]->[9];
123 0         0 foreach my $source (@source)
124             {
125 0         0 my $source_time = [stat "$source"]->[9];
126 0 0       0 return 1 if ! defined $source_time;
127 0 0       0 return 1 if $source_time > $target_time;
128             }
129 0         0 return 0;
130             }
131              
132              
133             sub ld
134             {
135 52     52 1 294 return undef;
136             }
137              
138             sub DESTROY
139             {
140 61     61   15209 my($self) = @_;
141              
142 61 100       2055 if($self->{temp})
143             {
144 9         114 unlink($self->path);
145             }
146             }
147              
148             1;
149              
150             __END__