File Coverage

blib/lib/FFI/Probe/Runner/Builder.pm

Criterion	Covered	Total	%
statement	99	110	90.0
branch	22	42	52.3
condition	3	11	27.2
subroutine	24	24	100.0
pod	15	15	100.0
total	163	202	80.6

package FFI::Probe::Runner::Builder;

use strict;
use warnings;
use 5.008004;
use Config;
use Capture::Tiny qw( capture_merged );
use Text::ParseWords ();
use FFI::Build::Platform;

# ABSTRACT: Probe runner builder for FFI
our $VERSION = '2.07'; # VERSION


sub new
{
  my($class, %args) = @_;

  $args{dir} ||= 'blib/lib/auto/share/dist/FFI-Platypus/probe';

  my $platform = FFI::Build::Platform->new;

  my $self = bless {
    dir      => $args{dir},
    platform => $platform,
    # we don't use the platform ccflags, etc because they are geared
    # for building dynamic libs not exes
    cc       => [$platform->shellwords($Config{cc})],
    ld       => [$platform->shellwords($Config{ld})],
    ccflags  => [$platform->shellwords($Config{ccflags})],
    optimize => [$platform->shellwords($Config{optimize})],
    ldflags  => [$platform->shellwords($Config{ldflags})],
    libs     =>
      $^O eq 'MSWin32'
        ? [[]]
        : [['-ldl'], [], map { [$_] } grep !/^-ldl/, $platform->shellwords($Config{perllibs})],
  }, $class;

  $self;
}


sub dir
{
  my($self, @subdirs) = @_;
  my $dir = $self->{dir};

  if(@subdirs)
  {
    require File::Spec;
    $dir = File::Spec->catdir($dir, @subdirs);
  }

  unless(-d $dir)
  {
    require File::Path;
    File::Path::mkpath($dir, 0, oct(755));
  }
  $dir;
}


sub cc       { shift->{cc}       }
sub ccflags  { shift->{ccflags}  }
sub optimize { shift->{optimize} }
sub ld       { shift->{ld}       }
sub ldflags  { shift->{ldflags}  }
sub libs     { shift->{libs}     }


sub file
{
  my($self, @sub) = @_;
  @sub >= 1 or die 'usage: $builder->file([@subdirs], $filename)';
  my $filename  = pop @sub;
  require File::Spec;
  File::Spec->catfile($self->dir(@sub), $filename);
}

my $source;


sub exe
{
  my($self) =  @_;
  my $xfn = $self->file('bin', "dlrun$Config{exe_ext}");
}


sub source
{
  unless($source)
  {
    local $/;
    $source = ;
  }

  $source;
}


our $VERBOSE = !!$ENV{V};

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

  # the source src/dlrun.c
  {
    print "XX src/dlrun.c\n" unless $VERBOSE;
    my $fh;
    my $fn = $self->file('src', 'dlrun.c');
    my $source = $self->source;
    open $fh, '>', $fn or die "unable to write $fn $!";
    print $fh $source;
    close $fh;
  }

  # the bin directory bin
  {
    print "XX bin/\n" unless $VERBOSE;
    $self->dir('bin');
  }

}


sub run
{
  my($self, $type, @cmd) = @_;
  @cmd = map { ref $_ ? @$_ : $_ } @cmd;
  my($out, $ret) = capture_merged {
    $self->{platform}->run(@cmd);
  };
  if($ret)
  {
    print STDERR $out;
    die "$type failed";
  }
  print $out if $VERBOSE;
  $out;
}


sub run_list
{
  my($self, $type, @commands) = @_;

  my $log = '';

  foreach my $cmd (@commands)
  {
    my($out, $ret) = capture_merged {
      $self->{platform}->run(@$cmd);
    };
    if($VERBOSE)
    {
      print $out;
    }
    else
    {
      $log .= $out;
    }
    return if !$ret;
  }

  print $log;
  die "$type failed";
}


sub build
{
  my($self) = @_;
  $self->extract;

  # this should really be done in `new` but the build
  # scripts for FFI-Platypus edit the ldfalgs from there
  # so.  Also this may actually belong in FFI::Build::Platform
  # which would resolve the problem.
  if($^O eq 'MSWin32' && $Config{ccname} eq 'cl')
  {
    $self->{ldflags} = [
      grep !/^-nodefaultlib$/i,
      @{ $self->{ldflags} }
    ];
  }

  my $cfn = $self->file('src', 'dlrun.c');
  my $ofn = $self->file('src', "dlrun$Config{obj_ext}");
  my $xfn = $self->exe;

  # compile
  print "CC src/dlrun.c\n" unless $VERBOSE;
  $self->run(
    compile =>
      $self->cc,
      $self->ccflags,
      $self->optimize,
      '-c',
      $self->{platform}->flag_object_output($ofn),
      $cfn,
  );

  # link
  print "LD src/dlrun$Config{obj_ext}\n" unless $VERBOSE;
  $self->run_list(link =>
    map { [
      $self->ld,
      $self->ldflags,
      $self->{platform}->flag_exe_output($xfn),
      $ofn,
      @$_
    ] } @{ $self->libs },
  );

  ## FIXME
  if($^O eq 'MSWin32' && $Config{ccname} eq 'cl')
  {
    if(-f 'dlrun.exe' && ! -f $xfn)
    {
      rename 'dlrun.exe', $xfn;
    }
  }

  # verify
  print "VV bin/dlrun$Config{exe_ext}\n" unless $VERBOSE;
  my $out = $self->run(verify => $xfn, 'verify', 'self');
  if($out !~ /dlrun verify self ok/)
  {
    print $out;
    die "verify failed string match";
  }

  # remove object
  print "UN src/dlrun$Config{obj_ext}\n" unless $VERBOSE;
  unlink $ofn;

  $xfn;
}

1;

=pod

=encoding UTF-8

=head1 NAME

FFI::Probe::Runner::Builder - Probe runner builder for FFI

=head1 VERSION

version 2.07

=head1 SYNOPSIS

 use FFI::Probe::Runner::Builder;
 my $builder = FFI::Probe::Runner::Builder->new
   dir => "/foo/bar",
 );
 my $exe = $builder->build;

=head1 DESCRIPTION

This is a builder class for the FFI probe runner.  It is mostly only of
interest if you are hacking on L itself.

The interface may and will change over time without notice.  Use in
external dependencies at your own peril.

=head1 CONSTRUCTORS

=head2 new

 my $builder = FFI::Probe::Runner::Builder->new(%args);

Create a new instance.

=over 4

=item dir

The root directory for where to place the probe runner files.
Will be created if it doesn't already exist.  The default
makes sense for when L is being built.

=back

=head1 METHODS

=head2 dir

 my $dir = $builder->dir(@subdirs);

Returns a subdirectory from the builder root.  Directory
will be created if it doesn't already exist.

=head2 cc

 my @cc = @{ $builder->cc };

The C compiler to use.  Returned as an array reference so that it may be modified.

=head2 ccflags

 my @ccflags = @{ $builder->ccflags };

The C compiler flags to use.  Returned as an array reference so that it may be modified.

=head2 optimize

The C optimize flags to use.  Returned as an array reference so that it may be modified.

=head2 ld

 my @ld = @{ $builder->ld };

The linker to use.  Returned as an array reference so that it may be modified.

=head2 ldflags

 my @ldflags = @{ $builder->ldflags };

The linker flags to use.  Returned as an array reference so that it may be modified.

=head2 libs

 my @libs = @{ $builder->libs };

The library flags to use.  Returned as an array reference so that it may be modified.

=head2 file

 my $file = $builder->file(@subdirs, $filename);

Returns a file in a subdirectory from the builder root.
Directory will be created if it doesn't already exist.
File will not be created.

=head2 exe

 my $exe = $builder->exe;

The name of the executable, once it is built.

=head2 source

 my $source = $builder->source;

The C source for the probe runner.

=head2 extract

 $builder->extract;

Extract the source for the probe runner.

=head2 run

 $builder->run($type, @command);

Runs the given command.  Dies if the command fails.

=head2 run_list

 $builder->run($type, \@command, \@command, ...);

Runs the given commands in order until one succeeds.
Dies if they all fail.

=head2 build

 my $exe = $builder->build;

Builds the probe runner.  Returns the path to the executable.

=head1 AUTHOR

Author: Graham Ollis [e-mail]

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 Písař (ppisar)

Mohammad S Anwar (MANWAR)

Håkon Hægland (hakonhagland, HAKONH)

Meredith (merrilymeredith, MHOWARD)

Diab Jerius (DJERIUS)

Eric Brine (IKEGAMI)

szTheory

José Joaquín Atria (JJATRIA)

Pete Houston (openstrike, HOUSTON)

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015-2022 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

__DATA__