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