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