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.09'; # 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.09 =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 Eplicease@cpan.orgE 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) Lukas Mai (MAUKE) =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__ #if defined __CYGWIN__ #include #elif defined _WIN32 #include #else #include #endif #include #include #include #if defined __CYGWIN__ typedef void * dlib; #elif defined _WIN32 #define RTLD_LAZY 0 typedef HMODULE dlib; dlib dlopen(const char *filename, int flags) { (void)flags; return LoadLibrary(filename); } void * dlsym(dlib handle, const char *symbol_name) { return GetProcAddress(handle, symbol_name); } int dlclose(dlib handle) { FreeLibrary(handle); return 0; } const char * dlerror() { return "an error"; } #else typedef void * dlib; #endif int main(int argc, char **argv) { char *filename; int flags; int (*dlmain)(int, char **); char **dlargv; dlib handle; int n; int ret; if(argc < 3) { fprintf(stderr, "usage: %s dlfilename dlflags [ ... ]\n", argv[0]); return 1; } if(!strcmp(argv[1], "verify") && !strcmp(argv[2], "self")) { printf("dlrun verify self ok\n"); return 0; } #if defined WIN32 SetErrorMode(SetErrorMode(0) | SEM_NOGPFAULTERRORBOX); #endif dlargv = malloc(sizeof(char*)*(argc-2)); dlargv[0] = argv[0]; filename = argv[1]; flags = !strcmp(argv[2], "-") ? RTLD_LAZY : atoi(argv[2]); for(n=3; n