1package FFI::Probe::Runner::Builder; 2 3use strict; 4use warnings; 5use 5.008004; 6use Config; 7use Capture::Tiny qw( capture_merged ); 8use Text::ParseWords (); 9use FFI::Build::Platform; 10 11# ABSTRACT: Probe runner builder for FFI 12our $VERSION = '1.56'; # VERSION 13 14 15sub new 16{ 17 my($class, %args) = @_; 18 19 $args{dir} ||= 'blib/lib/auto/share/dist/FFI-Platypus/probe'; 20 21 my $platform = FFI::Build::Platform->new; 22 23 my $self = bless { 24 dir => $args{dir}, 25 platform => $platform, 26 # we don't use the platform ccflags, etc because they are geared 27 # for building dynamic libs not exes 28 cc => [$platform->shellwords($Config{cc})], 29 ld => [$platform->shellwords($Config{ld})], 30 ccflags => [$platform->shellwords($Config{ccflags})], 31 optimize => [$platform->shellwords($Config{optimize})], 32 ldflags => [$platform->shellwords($Config{ldflags})], 33 libs => 34 $^O eq 'MSWin32' 35 ? [[]] 36 : [['-ldl'], [], map { [$_] } grep !/^-ldl/, $platform->shellwords($Config{perllibs})], 37 }, $class; 38 39 $self; 40} 41 42 43sub dir 44{ 45 my($self, @subdirs) = @_; 46 my $dir = $self->{dir}; 47 48 if(@subdirs) 49 { 50 require File::Spec; 51 $dir = File::Spec->catdir($dir, @subdirs); 52 } 53 54 unless(-d $dir) 55 { 56 require File::Path; 57 File::Path::mkpath($dir, 0, oct(755)); 58 } 59 $dir; 60} 61 62 63sub cc { shift->{cc} } 64sub ccflags { shift->{ccflags} } 65sub optimize { shift->{optimize} } 66sub ld { shift->{ld} } 67sub ldflags { shift->{ldflags} } 68sub libs { shift->{libs} } 69 70 71sub file 72{ 73 my($self, @sub) = @_; 74 @sub >= 1 or die 'usage: $builder->file([@subdirs], $filename)'; 75 my $filename = pop @sub; 76 require File::Spec; 77 File::Spec->catfile($self->dir(@sub), $filename); 78} 79 80my $source; 81 82 83sub exe 84{ 85 my($self) = @_; 86 my $xfn = $self->file('bin', "dlrun$Config{exe_ext}"); 87} 88 89 90sub source 91{ 92 unless($source) 93 { 94 local $/; 95 $source = <DATA>; 96 } 97 98 $source; 99} 100 101 102our $VERBOSE = !!$ENV{V}; 103 104sub extract 105{ 106 my($self) = @_; 107 108 # the source src/dlrun.c 109 { 110 print "XX src/dlrun.c\n" unless $VERBOSE; 111 my $fh; 112 my $fn = $self->file('src', 'dlrun.c'); 113 my $source = $self->source; 114 open $fh, '>', $fn or die "unable to write $fn $!"; 115 print $fh $source; 116 close $fh; 117 } 118 119 # the bin directory bin 120 { 121 print "XX bin/\n" unless $VERBOSE; 122 $self->dir('bin'); 123 } 124 125} 126 127 128sub run 129{ 130 my($self, $type, @cmd) = @_; 131 @cmd = map { ref $_ ? @$_ : $_ } @cmd; 132 my($out, $ret) = capture_merged { 133 $self->{platform}->run(@cmd); 134 }; 135 if($ret) 136 { 137 print STDERR $out; 138 die "$type failed"; 139 } 140 print $out if $VERBOSE; 141 $out; 142} 143 144 145sub run_list 146{ 147 my($self, $type, @commands) = @_; 148 149 my $log = ''; 150 151 foreach my $cmd (@commands) 152 { 153 my($out, $ret) = capture_merged { 154 $self->{platform}->run(@$cmd); 155 }; 156 if($VERBOSE) 157 { 158 print $out; 159 } 160 else 161 { 162 $log .= $out; 163 } 164 return if !$ret; 165 } 166 167 print $log; 168 die "$type failed"; 169} 170 171 172sub build 173{ 174 my($self) = @_; 175 $self->extract; 176 177 # this should really be done in `new` but the build 178 # scripts for FFI-Platypus edit the ldfalgs from there 179 # so. Also this may actually belong in FFI::Build::Platform 180 # which would resolve the problem. 181 if($^O eq 'MSWin32' && $Config{ccname} eq 'cl') 182 { 183 $self->{ldflags} = [ 184 grep !/^-nodefaultlib$/i, 185 @{ $self->{ldflags} } 186 ]; 187 } 188 189 my $cfn = $self->file('src', 'dlrun.c'); 190 my $ofn = $self->file('src', "dlrun$Config{obj_ext}"); 191 my $xfn = $self->exe; 192 193 # compile 194 print "CC src/dlrun.c\n" unless $VERBOSE; 195 $self->run( 196 compile => 197 $self->cc, 198 $self->ccflags, 199 $self->optimize, 200 '-c', 201 $self->{platform}->flag_object_output($ofn), 202 $cfn, 203 ); 204 205 # link 206 print "LD src/dlrun$Config{obj_ext}\n" unless $VERBOSE; 207 $self->run_list(link => 208 map { [ 209 $self->ld, 210 $self->ldflags, 211 $self->{platform}->flag_exe_output($xfn), 212 $ofn, 213 @$_ 214 ] } @{ $self->libs }, 215 ); 216 217 ## FIXME 218 if($^O eq 'MSWin32' && $Config{ccname} eq 'cl') 219 { 220 if(-f 'dlrun.exe' && ! -f $xfn) 221 { 222 rename 'dlrun.exe', $xfn; 223 } 224 } 225 226 # verify 227 print "VV bin/dlrun$Config{exe_ext}\n" unless $VERBOSE; 228 my $out = $self->run(verify => $xfn, 'verify', 'self'); 229 if($out !~ /dlrun verify self ok/) 230 { 231 print $out; 232 die "verify failed string match"; 233 } 234 235 # remove object 236 print "UN src/dlrun$Config{obj_ext}\n" unless $VERBOSE; 237 unlink $ofn; 238 239 $xfn; 240} 241 2421; 243 244=pod 245 246=encoding UTF-8 247 248=head1 NAME 249 250FFI::Probe::Runner::Builder - Probe runner builder for FFI 251 252=head1 VERSION 253 254version 1.56 255 256=head1 SYNOPSIS 257 258 use FFI::Probe::Runner::Builder; 259 my $builder = FFI::Probe::Runner::Builder->new 260 dir => "/foo/bar", 261 ); 262 my $exe = $builder->build; 263 264=head1 DESCRIPTION 265 266This is a builder class for the FFI probe runner. It is mostly only of 267interest if you are hacking on L<FFI::Platypus> itself. 268 269The interface may and will change over time without notice. Use in 270external dependencies at your own peril. 271 272=head1 CONSTRUCTORS 273 274=head2 new 275 276 my $builder = FFI::Probe::Runner::Builder->new(%args); 277 278Create a new instance. 279 280=over 4 281 282=item dir 283 284The root directory for where to place the probe runner files. 285Will be created if it doesn't already exist. The default 286makes sense for when L<FFI::Platypus> is being built. 287 288=back 289 290=head1 METHODS 291 292=head2 dir 293 294 my $dir = $builder->dir(@subdirs); 295 296Returns a subdirectory from the builder root. Directory 297will be created if it doesn't already exist. 298 299=head2 cc 300 301 my @cc = @{ $builder->cc }; 302 303The C compiler to use. Returned as an array reference so that it may be modified. 304 305=head2 ccflags 306 307 my @ccflags = @{ $builder->ccflags }; 308 309The C compiler flags to use. Returned as an array reference so that it may be modified. 310 311=head2 optimize 312 313The C optimize flags to use. Returned as an array reference so that it may be modified. 314 315=head2 ld 316 317 my @ld = @{ $builder->ld }; 318 319The linker to use. Returned as an array reference so that it may be modified. 320 321=head2 ldflags 322 323 my @ldflags = @{ $builder->ldflags }; 324 325The linker flags to use. Returned as an array reference so that it may be modified. 326 327=head2 libs 328 329 my @libs = @{ $builder->libs }; 330 331The library flags to use. Returned as an array reference so that it may be modified. 332 333=head2 file 334 335 my $file = $builder->file(@subdirs, $filename); 336 337Returns a file in a subdirectory from the builder root. 338Directory will be created if it doesn't already exist. 339File will not be created. 340 341=head2 exe 342 343 my $exe = $builder->exe; 344 345The name of the executable, once it is built. 346 347=head2 source 348 349 my $source = $builder->source; 350 351The C source for the probe runner. 352 353=head2 extract 354 355 $builder->extract; 356 357Extract the source for the probe runner. 358 359=head2 run 360 361 $builder->run($type, @command); 362 363Runs the given command. Dies if the command fails. 364 365=head2 run_list 366 367 $builder->run($type, \@command, \@command, ...); 368 369Runs the given commands in order until one succeeds. 370Dies if they all fail. 371 372=head2 build 373 374 my $exe = $builder->build; 375 376Builds the probe runner. Returns the path to the executable. 377 378=head1 AUTHOR 379 380Author: Graham Ollis E<lt>plicease@cpan.orgE<gt> 381 382Contributors: 383 384Bakkiaraj Murugesan (bakkiaraj) 385 386Dylan Cali (calid) 387 388pipcet 389 390Zaki Mughal (zmughal) 391 392Fitz Elliott (felliott) 393 394Vickenty Fesunov (vyf) 395 396Gregor Herrmann (gregoa) 397 398Shlomi Fish (shlomif) 399 400Damyan Ivanov 401 402Ilya Pavlov (Ilya33) 403 404Petr Písař (ppisar) 405 406Mohammad S Anwar (MANWAR) 407 408Håkon Hægland (hakonhagland, HAKONH) 409 410Meredith (merrilymeredith, MHOWARD) 411 412Diab Jerius (DJERIUS) 413 414Eric Brine (IKEGAMI) 415 416szTheory 417 418José Joaquín Atria (JJATRIA) 419 420Pete Houston (openstrike, HOUSTON) 421 422=head1 COPYRIGHT AND LICENSE 423 424This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis. 425 426This is free software; you can redistribute it and/or modify it under 427the same terms as the Perl 5 programming language system itself. 428 429=cut 430 431__DATA__ 432 433#if defined __CYGWIN__ 434#include <dlfcn.h> 435#elif defined _WIN32 436#include <windows.h> 437#else 438#include <dlfcn.h> 439#endif 440#include <stdlib.h> 441#include <string.h> 442#include <stdio.h> 443 444#if defined __CYGWIN__ 445typedef void * dlib; 446#elif defined _WIN32 447 448#define RTLD_LAZY 0 449typedef HMODULE dlib; 450 451dlib 452dlopen(const char *filename, int flags) 453{ 454 (void)flags; 455 return LoadLibrary(filename); 456} 457 458void * 459dlsym(dlib handle, const char *symbol_name) 460{ 461 return GetProcAddress(handle, symbol_name); 462} 463 464int 465dlclose(dlib handle) 466{ 467 FreeLibrary(handle); 468 return 0; 469} 470 471const char * 472dlerror() 473{ 474 return "an error"; 475} 476 477#else 478typedef void * dlib; 479#endif 480 481int 482main(int argc, char **argv) 483{ 484 char *filename; 485 int flags; 486 int (*dlmain)(int, char **); 487 char **dlargv; 488 dlib handle; 489 int n; 490 int ret; 491 492 if(argc < 3) 493 { 494 fprintf(stderr, "usage: %s dlfilename dlflags [ ... ]\n", argv[0]); 495 return 1; 496 } 497 498 if(!strcmp(argv[1], "verify") && !strcmp(argv[2], "self")) 499 { 500 printf("dlrun verify self ok\n"); 501 return 0; 502 } 503 504#if defined WIN32 505 SetErrorMode(SetErrorMode(0) | SEM_NOGPFAULTERRORBOX); 506#endif 507 508 dlargv = malloc(sizeof(char*)*(argc-2)); 509 dlargv[0] = argv[0]; 510 filename = argv[1]; 511 flags = !strcmp(argv[2], "-") ? RTLD_LAZY : atoi(argv[2]); 512 for(n=3; n<argc; n++) 513 dlargv[n-2] = argv[n]; 514 515 handle = dlopen(filename, flags); 516 517 if(handle == NULL) 518 { 519 fprintf(stderr, "error loading %s (%d|%s): %s", filename, flags, argv[2], dlerror()); 520 return 1; 521 } 522 523 dlmain = dlsym(handle, "dlmain"); 524 525 if(dlmain == NULL) 526 { 527 fprintf(stderr, "no dlmain symbol"); 528 return 1; 529 } 530 531 ret = dlmain(argc-2, dlargv); 532 533 dlclose(handle); 534 535 return ret; 536} 537