1package FFI::Build::File::Base;
2
3use strict;
4use warnings;
5use 5.008004;
6use Carp ();
7use FFI::Temp;
8use File::Basename ();
9use FFI::Build::Platform;
10use overload '""' => sub { $_[0]->path }, bool => sub { 1 }, fallback => 1;
11
12# ABSTRACT: Base class for File::Build files
13our $VERSION = '1.56'; # VERSION
14
15
16sub new
17{
18  my($class, $content, %config) = @_;
19
20  my $base     = $config{base} || 'ffi_build_';
21  my $dir      = $config{dir};
22  my $build    = $config{build};
23  my $platform = $config{platform} || FFI::Build::Platform->new;
24
25  my $self = bless {
26    platform => $platform,
27    build    => $build,
28  }, $class;
29
30  if(!defined $content)
31  {
32    Carp::croak("content is required");
33  }
34  elsif(ref($content) eq 'ARRAY')
35  {
36    $self->{path} = File::Spec->catfile(@$content);
37  }
38  elsif(ref($content) eq 'SCALAR')
39  {
40    my %args;
41    $args{TEMPLATE} = "${base}XXXXXX";
42    $args{DIR}      = $dir if $dir;
43    $args{SUFFIX}   = $self->default_suffix;
44    $args{UNLINK}   = 0;
45
46    my $fh = $self->{fh} = FFI::Temp->new(%args);
47
48    binmode( $fh, $self->default_encoding );
49    print $fh $$content;
50    close $fh;
51
52    $self->{path} = $fh->filename;
53    $self->{temp} = 1;
54  }
55  elsif(ref($content) eq '')
56  {
57    $self->{path} = $content;
58  }
59
60  if($self->platform->osname eq 'MSWin32')
61  {
62    $self->{native} = File::Spec->catfile($self->{path});
63    $self->{path} =~ s{\\}{/}g;
64  }
65
66  $self;
67}
68
69
70sub default_suffix    { die "must define a default extension in subclass" }
71sub default_encoding  { die "must define an encoding" }
72sub accept_suffix     { () }
73
74
75sub path      { shift->{path}                          }
76sub basename  { File::Basename::basename shift->{path} }
77sub dirname   { File::Basename::dirname  shift->{path} }
78sub is_temp   { shift->{temp}                          }
79sub platform  { shift->{platform}                      }
80sub build     { shift->{build}                         }
81
82
83sub native {
84  my($self) = @_;
85  $self->platform->osname eq 'MSWin32'
86    ? $self->{native}
87    : $self->{path};
88}
89
90
91sub slurp
92{
93  my($self) = @_;
94  my $fh;
95  open($fh, '<', $self->path) || Carp::croak "Error opening @{[ $self->path ]} for read $!";
96  binmode($fh, $self->default_encoding);
97  my $content = do { local $/; <$fh> };
98  close $fh;
99  $content;
100}
101
102
103sub keep
104{
105  delete shift->{temp};
106}
107
108
109sub build_item
110{
111  Carp::croak("Not implemented!");
112}
113
114
115sub needs_rebuild
116{
117  my($self, @source) = @_;
118  # if the target doesn't exist, then we definitely
119  # need a rebuild.
120  return 1 unless -f $self->path;
121  my $target_time = [stat $self->path]->[9];
122  foreach my $source (@source)
123  {
124    my $source_time = [stat "$source"]->[9];
125    return 1 if ! defined $source_time;
126    return 1 if $source_time > $target_time;
127  }
128  return 0;
129}
130
131
132sub ld
133{
134  return undef;
135}
136
137sub DESTROY
138{
139  my($self) = @_;
140
141  if($self->{temp})
142  {
143    unlink($self->path);
144  }
145}
146
1471;
148
149__END__
150
151=pod
152
153=encoding UTF-8
154
155=head1 NAME
156
157FFI::Build::File::Base - Base class for File::Build files
158
159=head1 VERSION
160
161version 1.56
162
163=head1 SYNOPSIS
164
165Create your own file class
166
167 package FFI::Build::File::Foo;
168 use parent qw( FFI::Build::File::Base );
169 use constant default_suffix => '.foo';
170 use constant default_encoding => ':utf8';
171
172Use it:
173
174 # use an existing file in the filesystem
175 my $file = FFI::Build::File::Foo->new('src/myfile.foo');
176
177 # generate a temp file with provided content
178 # file will be deletd when $file falls out of scope.
179 my $file = FFI::Build::File::Foo->new(\'content for a temp foo');
180
181=head1 DESCRIPTION
182
183This class is the base class for other L<FFI::Build::File> classes.
184
185=head1 CONSTRUCTOR
186
187=head2 new
188
189 my $file = FFI::Build::File::Base->new(\$content, %options);
190 my $file = FFI::Build::File::Base->new($filename, %options);
191
192Create a new instance of the file class.  You may provide either the
193content of the file as a scalar reference, or the path to an existing
194filename.  Options:
195
196=over 4
197
198=item base
199
200The base name for any temporary file C<ffi_build_> by default.
201
202=item build
203
204The L<FFI::Build> instance to use.
205
206=item dir
207
208The directory to store any temporary file.
209
210=item platform
211
212The L<FFI::Build::Platform> instance to use.
213
214=back
215
216=head1 METHODS
217
218=head2 default_suffix
219
220 my $suffix = $file->default_suffix;
221
222B<MUST> be overridden in the subclass.  This is the standard extension for the file type.  C<.c> for a C file, C<.o> or C<.obj> for an object file depending on platform.  etc.
223
224=head2 default_encoding
225
226 my $encoding = $file->default_encoding;
227
228B<MUST> be overridden in the subclass.  This is the passed to C<binmode> when the file is opened for reading or writing.
229
230=head2 accept_suffix
231
232 my @suffix_list = $file->accept_suffix;
233
234Returns a list of regexes that recognize the file type.
235
236=head2 path
237
238 my $path = $file->path;
239
240The full or relative path to the file.
241
242=head2 basename
243
244 my $basename = $file->basename;
245
246The base filename part of the path.
247
248=head2 dirname
249
250 my $dir = $file->dirname;
251
252The directory part of the path.
253
254=head2 is_temp
255
256 my $bool = $file->is_temp;
257
258Returns true if the file is temporary, that is, it will be deleted when the file object falls out of scope.
259You can call C<keep>, to keep the file.
260
261=head2 platform
262
263 my $platform = $file->platform;
264
265The L<FFI::Build::Platform> instance used for this file object.
266
267=head2 build
268
269 my $build = $file->build;
270
271The L<FFI::Build> instance used for this file object, if any.
272
273=head2 native
274
275 my $path = $file->native;
276
277Returns the operating system native version of the filename path.  On Windows, this means that forward slash C<\> is
278used instead of backslash C</>.
279
280=head2 slurp
281
282 my $content = $file->slurp;
283
284Returns the content of the file.
285
286=head2 keep
287
288 $file->keep;
289
290Turns off the temporary flag on the file object, meaning it will not automatically be deleted when the
291file object is deallocated or falls out of scope.
292
293=head2 build_item
294
295 $file->build_item;
296
297Builds the file into its natural output type, usually an object file.  It returns a new file instance,
298or if the file is an object file then it returns empty list.
299
300=head2 build_all
301
302 $file->build_all;
303
304If implemented the file in question can directly create a shared or dynamic library
305without needing a link step.  This is useful for languages that have their own build
306systems.
307
308=head2 needs_rebuild
309
310 my $bool = $file->needs_rebuild
311
312=head2 ld
313
314=head1 AUTHOR
315
316Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
317
318Contributors:
319
320Bakkiaraj Murugesan (bakkiaraj)
321
322Dylan Cali (calid)
323
324pipcet
325
326Zaki Mughal (zmughal)
327
328Fitz Elliott (felliott)
329
330Vickenty Fesunov (vyf)
331
332Gregor Herrmann (gregoa)
333
334Shlomi Fish (shlomif)
335
336Damyan Ivanov
337
338Ilya Pavlov (Ilya33)
339
340Petr Písař (ppisar)
341
342Mohammad S Anwar (MANWAR)
343
344Håkon Hægland (hakonhagland, HAKONH)
345
346Meredith (merrilymeredith, MHOWARD)
347
348Diab Jerius (DJERIUS)
349
350Eric Brine (IKEGAMI)
351
352szTheory
353
354José Joaquín Atria (JJATRIA)
355
356Pete Houston (openstrike, HOUSTON)
357
358=head1 COPYRIGHT AND LICENSE
359
360This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
361
362This is free software; you can redistribute it and/or modify it under
363the same terms as the Perl 5 programming language system itself.
364
365=cut
366