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     13   191274 use strict;
  13         30  
  13         293  
4 13     13   52 use warnings;
  13         25  
  13         236  
5 13     13   159 use 5.008004;
  13         39  
6 13     13   64 use Carp ();
  13         25  
  13         193  
7 13     13   2825 use FFI::Temp;
  13         29  
  13         314  
8 13     13   77 use File::Basename ();
  13         23  
  13         205  
9 13     13   4124 use FFI::Build::Platform;
  13         44  
  13         343  
10 13     13   2046 use FFI::Build::PluginData;
  13         26  
  13         823  
11 13     13   74 use overload '""' => sub { $_[0]->path }, bool => sub { 1 }, fallback => 1;
  13     100   22  
  13         141  
  71         7246  
  141         800  
12              
13             # ABSTRACT: Base class for File::Build files
14             our $VERSION = '2.07'; # VERSION
15              
16              
17             sub new
18             {
19 176     176 1 37825 my($class, $content, %config) = @_;
20              
21 176   50     707 my $base = $config{base} || 'ffi_build_';
22 176         278 my $dir = $config{dir};
23 176         237 my $build = $config{build};
24 176   66     476 my $platform = $config{platform} || FFI::Build::Platform->new;
25              
26 176         640 my $self = bless {
27             platform => $platform,
28             build => $build,
29             }, $class;
30              
31 176 100       690 if(!defined $content)
    100          
    100          
    50          
32             {
33 1         157 Carp::croak("content is required");
34             }
35             elsif(ref($content) eq 'ARRAY')
36             {
37 79         1585 $self->{path} = File::Spec->catfile(@$content);
38             }
39             elsif(ref($content) eq 'SCALAR')
40             {
41 18         63 my %args;
42 18         78 $args{TEMPLATE} = "${base}XXXXXX";
43 18 100       72 $args{DIR} = $dir if $dir;
44 18         385 $args{SUFFIX} = $self->default_suffix;
45 18         43 $args{UNLINK} = 0;
46              
47 18         192 my $fh = $self->{fh} = FFI::Temp->new(%args);
48              
49 18         7717 binmode( $fh, $self->default_encoding );
50 18         230 print $fh $$content;
51 18         633 close $fh;
52              
53 18         108 $self->{path} = $fh->filename;
54 18         253 $self->{temp} = 1;
55             }
56             elsif(ref($content) eq '')
57             {
58 78         267 $self->{path} = $content;
59             }
60              
61 175 50       798 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         749 $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 8684 sub path { shift->{path} }
77 38     38 1 3278 sub basename { File::Basename::basename shift->{path} }
78 107     107 1 11589 sub dirname { File::Basename::dirname shift->{path} }
79 3     3 1 13 sub is_temp { shift->{temp} }
80 383     383 1 1379 sub platform { shift->{platform} }
81 304     304 1 2821 sub build { shift->{build} }
82              
83              
84             sub native {
85 2     2 1 334 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 674 my($self) = @_;
95 4         4 my $fh;
96 4 50       15 open($fh, '<', $self->path) || Carp::croak "Error opening @{[ $self->path ]} for read $!";
  0         0  
97 4         28 binmode($fh, $self->default_encoding);
98 4         7 my $content = do { local $/; <$fh> };
  4         13  
  4         118  
99 4         39 close $fh;
100 4         29 $content;
101             }
102              
103              
104             sub keep
105             {
106 1     1 1 9 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 199 return undef;
136             }
137              
138             sub DESTROY
139             {
140 61     61   12237 my($self) = @_;
141              
142 61 100       1684 if($self->{temp})
143             {
144 9         78 unlink($self->path);
145             }
146             }
147              
148             1;
149              
150             __END__