358 lines
6.8 KiB
Perl
358 lines
6.8 KiB
Perl
package FFI::Build::File::Base;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use 5.008004;
|
|
use Carp ();
|
|
use FFI::Temp;
|
|
use File::Basename ();
|
|
use FFI::Build::Platform;
|
|
use overload '""' => sub { $_[0]->path }, bool => sub { 1 }, fallback => 1;
|
|
|
|
# ABSTRACT: Base class for File::Build files
|
|
our $VERSION = '1.34'; # VERSION
|
|
|
|
|
|
sub new
|
|
{
|
|
my($class, $content, %config) = @_;
|
|
|
|
my $base = $config{base} || 'ffi_build_';
|
|
my $dir = $config{dir};
|
|
my $build = $config{build};
|
|
my $platform = $config{platform} || FFI::Build::Platform->new;
|
|
|
|
my $self = bless {
|
|
platform => $platform,
|
|
build => $build,
|
|
}, $class;
|
|
|
|
if(!defined $content)
|
|
{
|
|
Carp::croak("content is required");
|
|
}
|
|
elsif(ref($content) eq 'ARRAY')
|
|
{
|
|
$self->{path} = File::Spec->catfile(@$content);
|
|
}
|
|
elsif(ref($content) eq 'SCALAR')
|
|
{
|
|
my %args;
|
|
$args{TEMPLATE} = "${base}XXXXXX";
|
|
$args{DIR} = $dir if $dir;
|
|
$args{SUFFIX} = $self->default_suffix;
|
|
$args{UNLINK} = 0;
|
|
|
|
my $fh = $self->{fh} = FFI::Temp->new(%args);
|
|
|
|
binmode( $fh, $self->default_encoding );
|
|
print $fh $$content;
|
|
close $fh;
|
|
|
|
$self->{path} = $fh->filename;
|
|
$self->{temp} = 1;
|
|
}
|
|
elsif(ref($content) eq '')
|
|
{
|
|
$self->{path} = $content;
|
|
}
|
|
|
|
if($self->platform->osname eq 'MSWin32')
|
|
{
|
|
$self->{native} = File::Spec->catfile($self->{path});
|
|
$self->{path} =~ s{\\}{/}g;
|
|
}
|
|
|
|
$self;
|
|
}
|
|
|
|
|
|
sub default_suffix { die "must define a default extension in subclass" }
|
|
sub default_encoding { die "must define an encoding" }
|
|
sub accept_suffix { () }
|
|
|
|
|
|
sub path { shift->{path} }
|
|
sub basename { File::Basename::basename shift->{path} }
|
|
sub dirname { File::Basename::dirname shift->{path} }
|
|
sub is_temp { shift->{temp} }
|
|
sub platform { shift->{platform} }
|
|
sub build { shift->{build} }
|
|
|
|
|
|
sub native {
|
|
my($self) = @_;
|
|
$self->platform->osname eq 'MSWin32'
|
|
? $self->{native}
|
|
: $self->{path};
|
|
}
|
|
|
|
|
|
sub slurp
|
|
{
|
|
my($self) = @_;
|
|
my $fh;
|
|
open($fh, '<', $self->path) || Carp::croak "Error opening @{[ $self->path ]} for read $!";
|
|
binmode($fh, $self->default_encoding);
|
|
my $content = do { local $/; <$fh> };
|
|
close $fh;
|
|
$content;
|
|
}
|
|
|
|
|
|
sub keep
|
|
{
|
|
delete shift->{temp};
|
|
}
|
|
|
|
|
|
sub build_item
|
|
{
|
|
Carp::croak("Not implemented!");
|
|
}
|
|
|
|
|
|
sub needs_rebuild
|
|
{
|
|
my($self, @source) = @_;
|
|
# if the target doesn't exist, then we definitely
|
|
# need a rebuild.
|
|
return 1 unless -f $self->path;
|
|
my $target_time = [stat $self->path]->[9];
|
|
foreach my $source (@source)
|
|
{
|
|
my $source_time = [stat "$source"]->[9];
|
|
return 1 if ! defined $source_time;
|
|
return 1 if $source_time > $target_time;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
|
|
sub ld
|
|
{
|
|
return undef;
|
|
}
|
|
|
|
sub DESTROY
|
|
{
|
|
my($self) = @_;
|
|
|
|
if($self->{temp})
|
|
{
|
|
unlink($self->path);
|
|
}
|
|
}
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=pod
|
|
|
|
=encoding UTF-8
|
|
|
|
=head1 NAME
|
|
|
|
FFI::Build::File::Base - Base class for File::Build files
|
|
|
|
=head1 VERSION
|
|
|
|
version 1.34
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
Create your own file class
|
|
|
|
package FFI::Build::File::Foo;
|
|
use base qw( FFI::Build::File::Base );
|
|
use constant default_suffix => '.foo';
|
|
use constant default_encoding => ':utf8';
|
|
|
|
Use it:
|
|
|
|
# use an existing file in the filesystem
|
|
my $file = FFI::Build::File::Foo->new('src/myfile.foo');
|
|
|
|
# generate a temp file with provided content
|
|
# file will be deletd when $file falls out of scope.
|
|
my $file = FFI::Build::File::Foo->new(\'content for a temp foo');
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This class is the base class for other L<FFI::Build::File> classes.
|
|
|
|
=head1 CONSTRUCTOR
|
|
|
|
=head2 new
|
|
|
|
my $file = FFI::Build::File::Base->new(\$content, %options);
|
|
my $file = FFI::Build::File::Base->new($filename, %options);
|
|
|
|
Create a new instance of the file class. You may provide either the
|
|
content of the file as a scalar reference, or the path to an existing
|
|
filename. Options:
|
|
|
|
=over 4
|
|
|
|
=item base
|
|
|
|
The base name for any temporary file C<ffi_build_> by default.
|
|
|
|
=item build
|
|
|
|
The L<FFI::Build> instance to use.
|
|
|
|
=item dir
|
|
|
|
The directory to store any temporary file.
|
|
|
|
=item platform
|
|
|
|
The L<FFI::Build::Platform> instance to use.
|
|
|
|
=back
|
|
|
|
=head1 METHODS
|
|
|
|
=head2 default_suffix
|
|
|
|
my $suffix = $file->default_suffix;
|
|
|
|
B<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.
|
|
|
|
=head2 default_encoding
|
|
|
|
my $encoding = $file->default_encoding;
|
|
|
|
B<MUST> be overridden in the subclass. This is the passed to C<binmode> when the file is opened for reading or writing.
|
|
|
|
=head2 accept_suffix
|
|
|
|
my @suffix_list = $file->accept_suffix;
|
|
|
|
Returns a list of regexes that recognize the file type.
|
|
|
|
=head2 path
|
|
|
|
my $path = $file->path;
|
|
|
|
The full or relative path to the file.
|
|
|
|
=head2 basename
|
|
|
|
my $basename = $file->basename;
|
|
|
|
The base filename part of the path.
|
|
|
|
=head2 dirname
|
|
|
|
my $dir = $file->dirname;
|
|
|
|
The directory part of the path.
|
|
|
|
=head2 is_temp
|
|
|
|
my $bool = $file->is_temp;
|
|
|
|
Returns true if the file is temporary, that is, it will be deleted when the file object falls out of scope.
|
|
You can call C<keep>, to keep the file.
|
|
|
|
=head2 platform
|
|
|
|
my $platform = $file->platform;
|
|
|
|
The L<FFI::Build::Platform> instance used for this file object.
|
|
|
|
=head2 build
|
|
|
|
my $build = $file->build;
|
|
|
|
The L<FFI::Build> instance used for this file object, if any.
|
|
|
|
=head2 native
|
|
|
|
my $path = $file->native;
|
|
|
|
Returns the operating system native version of the filename path. On Windows, this means that forward slash C<\> is
|
|
used instead of backslash C</>.
|
|
|
|
=head2 slurp
|
|
|
|
my $content = $file->slurp;
|
|
|
|
Returns the content of the file.
|
|
|
|
=head2 keep
|
|
|
|
$file->keep;
|
|
|
|
Turns off the temporary flag on the file object, meaning it will not automatically be deleted when the
|
|
file object is deallocated or falls out of scope.
|
|
|
|
=head2 build_item
|
|
|
|
$file->build_item;
|
|
|
|
Builds the file into its natural output type, usually an object file. It returns a new file instance,
|
|
or if the file is an object file then it returns empty list.
|
|
|
|
=head2 build_all
|
|
|
|
$file->build_all;
|
|
|
|
If implemented the file in question can directly create a shared or dynamic library
|
|
without needing a link step. This is useful for languages that have their own build
|
|
systems.
|
|
|
|
=head2 needs_rebuild
|
|
|
|
my $bool = $file->needs_rebuild
|
|
|
|
=head2 ld
|
|
|
|
=head1 AUTHOR
|
|
|
|
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
|
|
|
|
Contributors:
|
|
|
|
Bakkiaraj Murugesan (bakkiaraj)
|
|
|
|
Dylan Cali (calid)
|
|
|
|
pipcet
|
|
|
|
Zaki Mughal (zmughal)
|
|
|
|
Fitz Elliott (felliott)
|
|
|
|
Vickenty Fesunov (vyf)
|
|
|
|
Gregor Herrmann (gregoa)
|
|
|
|
Shlomi Fish (shlomif)
|
|
|
|
Damyan Ivanov
|
|
|
|
Ilya Pavlov (Ilya33)
|
|
|
|
Petr Pisar (ppisar)
|
|
|
|
Mohammad S Anwar (MANWAR)
|
|
|
|
Håkon Hægland (hakonhagland, HAKONH)
|
|
|
|
Meredith (merrilymeredith, MHOWARD)
|
|
|
|
Diab Jerius (DJERIUS)
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
|
|
|
|
This is free software; you can redistribute it and/or modify it under
|
|
the same terms as the Perl 5 programming language system itself.
|
|
|
|
=cut
|