File Coverage

blib/lib/FFI/Build/File/Base.pm

Criterion	Covered	Total	%
statement	68	82	82.9
branch	13	22	59.0
condition	3	5	60.0
subroutine	21	26	80.7
pod	16	16	100.0
total	121	151	80.1

package FFI::Build::File::Base;

use strict;
use warnings;
use 5.008001;
use Carp ();
use File::Temp     ();
use File::Basename ();
use FFI::Build::Platform;
use overload '""' => sub { $_[0]->path };

# ABSTRACT: Base class for File::Build files
our $VERSION = '0.12'; # 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;
    push @args, "${base}XXXXXX";
    push @args, DIR => $dir if $dir;
    push @args, SUFFIX => $self->default_suffix;

    my($fh, $filename) = File::Temp::tempfile(@args);

    binmode( $fh, $self->default_encoding );
    print $fh $$content;
    close $fh;

    $self->{path} = $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 $source_time > $target_time;
  }
  return 0;
}


sub ld
{
  return undef;
}

sub DESTROY
{
  my($self) = @_;

  if($self->{temp})
  {
    unlink($self->path);
  }
}

1;

__END__