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


line stmt bran cond sub pod time code
1             package FFI::Probe::Runner::Builder;
2              
3 1     1   4239 use strict;
  1         3  
  1         24  
4 1     1   4 use warnings;
  1         2  
  1         18  
5 1     1   14 use 5.008004;
  1         3  
6 1     1   4 use Config;
  1         1  
  1         42  
7 1     1   4 use Capture::Tiny qw( capture_merged );
  1         2  
  1         48  
8 1     1   362 use Text::ParseWords ();
  1         1035  
  1         20  
9 1     1   345 use FFI::Build::Platform;
  1         2  
  1         1309  
10              
11             # ABSTRACT: Probe runner builder for FFI
12             our $VERSION = '2.07'; # VERSION
13              
14              
15             sub new
16             {
17 1     1 1 6407 my($class, %args) = @_;
18              
19 1   50     8 $args{dir} ||= 'blib/lib/auto/share/dist/FFI-Platypus/probe';
20              
21 1         20 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 1 50       8 : [['-ldl'], [], map { [$_] } grep !/^-ldl/, $platform->shellwords($Config{perllibs})],
  6         16  
37             }, $class;
38              
39 1         7 $self;
40             }
41              
42              
43             sub dir
44             {
45 5     5 1 14 my($self, @subdirs) = @_;
46 5         11 my $dir = $self->{dir};
47              
48 5 50       13 if(@subdirs)
49             {
50 5         26 require File::Spec;
51 5         35 $dir = File::Spec->catdir($dir, @subdirs);
52             }
53              
54 5 100       498 unless(-d $dir)
55             {
56 2         15 require File::Path;
57 2         551 File::Path::mkpath($dir, 0, oct(755));
58             }
59 5         52 $dir;
60             }
61              
62              
63 1     1 1 5 sub cc { shift->{cc} }
64 1     1 1 16 sub ccflags { shift->{ccflags} }
65 1     1 1 10 sub optimize { shift->{optimize} }
66 8     8 1 20 sub ld { shift->{ld} }
67 8     8 1 28 sub ldflags { shift->{ldflags} }
68 2     2 1 16 sub libs { shift->{libs} }
69              
70              
71             sub file
72             {
73 4     4 1 15 my($self, @sub) = @_;
74 4 50       11 @sub >= 1 or die 'usage: $builder->file([@subdirs], $filename)';
75 4         8 my $filename = pop @sub;
76 4         23 require File::Spec;
77 4         250 File::Spec->catfile($self->dir(@sub), $filename);
78             }
79              
80             my $source;
81              
82              
83             sub exe
84             {
85 1     1 1 3 my($self) = @_;
86 1         8 my $xfn = $self->file('bin', "dlrun$Config{exe_ext}");
87             }
88              
89              
90             sub source
91             {
92 1 50   1 1 4 unless($source)
93             {
94 1         13 local $/;
95 1         118 $source = ;
96             }
97              
98 1         4 $source;
99             }
100              
101              
102             our $VERBOSE = !!$ENV{V};
103              
104             sub extract
105             {
106 1     1 1 3 my($self) = @_;
107              
108             # the source src/dlrun.c
109             {
110 1 50       4 print "XX src/dlrun.c\n" unless $VERBOSE;
111 1         2 my $fh;
112 1         4 my $fn = $self->file('src', 'dlrun.c');
113 1         5 my $source = $self->source;
114 1 50       68 open $fh, '>', $fn or die "unable to write $fn $!";
115 1         17 print $fh $source;
116 1         52 close $fh;
117             }
118              
119             # the bin directory bin
120             {
121 1 50       3 print "XX bin/\n" unless $VERBOSE;
  1         4  
  1         23  
122 1         4 $self->dir('bin');
123             }
124              
125             }
126              
127              
128             sub run
129             {
130 2     2 1 12 my($self, $type, @cmd) = @_;
131 2 100       5 @cmd = map { ref $_ ? @$_ : $_ } @cmd;
  10         41  
132             my($out, $ret) = capture_merged {
133 2     2   2278 $self->{platform}->run(@cmd);
134 2         121 };
135 2 50       2415 if($ret)
136             {
137 0         0 print STDERR $out;
138 0         0 die "$type failed";
139             }
140 2 50       100 print $out if $VERBOSE;
141 2         37 $out;
142             }
143              
144              
145             sub run_list
146             {
147 1     1 1 8 my($self, $type, @commands) = @_;
148              
149 1         7 my $log = '';
150              
151 1         8 foreach my $cmd (@commands)
152             {
153             my($out, $ret) = capture_merged {
154 1     1   1234 $self->{platform}->run(@$cmd);
155 1         94 };
156 1 50       1189 if($VERBOSE)
157             {
158 1         28 print $out;
159             }
160             else
161             {
162 0         0 $log .= $out;
163             }
164 1 50       27 return if !$ret;
165             }
166              
167 0         0 print $log;
168 0         0 die "$type failed";
169             }
170              
171              
172             sub build
173             {
174 1     1 1 10146 my($self) = @_;
175 1         5 $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 1 50 33     8 if($^O eq 'MSWin32' && $Config{ccname} eq 'cl')
182             {
183             $self->{ldflags} = [
184             grep !/^-nodefaultlib$/i,
185 0         0 @{ $self->{ldflags} }
  0         0  
186             ];
187             }
188              
189 1         23 my $cfn = $self->file('src', 'dlrun.c');
190 1         948 my $ofn = $self->file('src', "dlrun$Config{obj_ext}");
191 1         5 my $xfn = $self->exe;
192              
193             # compile
194 1 50       5 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 1         4 $self->{platform}->flag_object_output($ofn),
202             $cfn,
203             );
204              
205             # link
206 1 50       8 print "LD src/dlrun$Config{obj_ext}\n" unless $VERBOSE;
207             $self->run_list(link =>
208             map { [
209             $self->ld,
210             $self->ldflags,
211 8         31 $self->{platform}->flag_exe_output($xfn),
212             $ofn,
213             @$_
214 1         6 ] } @{ $self->libs },
  1         12  
215             );
216              
217             ## FIXME
218 1 50 33     27 if($^O eq 'MSWin32' && $Config{ccname} eq 'cl')
219             {
220 0 0 0     0 if(-f 'dlrun.exe' && ! -f $xfn)
221             {
222 0         0 rename 'dlrun.exe', $xfn;
223             }
224             }
225              
226             # verify
227 1 50       9 print "VV bin/dlrun$Config{exe_ext}\n" unless $VERBOSE;
228 1         19 my $out = $self->run(verify => $xfn, 'verify', 'self');
229 1 50       25 if($out !~ /dlrun verify self ok/)
230             {
231 0         0 print $out;
232 0         0 die "verify failed string match";
233             }
234              
235             # remove object
236 1 50       10 print "UN src/dlrun$Config{obj_ext}\n" unless $VERBOSE;
237 1         60 unlink $ofn;
238              
239 1         12 $xfn;
240             }
241              
242             1;
243              
244             =pod
245              
246             =encoding UTF-8
247              
248             =head1 NAME
249              
250             FFI::Probe::Runner::Builder - Probe runner builder for FFI
251              
252             =head1 VERSION
253              
254             version 2.07
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              
266             This is a builder class for the FFI probe runner. It is mostly only of
267             interest if you are hacking on L itself.
268              
269             The interface may and will change over time without notice. Use in
270             external dependencies at your own peril.
271              
272             =head1 CONSTRUCTORS
273              
274             =head2 new
275              
276             my $builder = FFI::Probe::Runner::Builder->new(%args);
277              
278             Create a new instance.
279              
280             =over 4
281              
282             =item dir
283              
284             The root directory for where to place the probe runner files.
285             Will be created if it doesn't already exist. The default
286             makes sense for when L is being built.
287              
288             =back
289              
290             =head1 METHODS
291              
292             =head2 dir
293              
294             my $dir = $builder->dir(@subdirs);
295              
296             Returns a subdirectory from the builder root. Directory
297             will be created if it doesn't already exist.
298              
299             =head2 cc
300              
301             my @cc = @{ $builder->cc };
302              
303             The 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              
309             The C compiler flags to use. Returned as an array reference so that it may be modified.
310              
311             =head2 optimize
312              
313             The 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              
319             The 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              
325             The 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              
331             The 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              
337             Returns a file in a subdirectory from the builder root.
338             Directory will be created if it doesn't already exist.
339             File will not be created.
340              
341             =head2 exe
342              
343             my $exe = $builder->exe;
344              
345             The name of the executable, once it is built.
346              
347             =head2 source
348              
349             my $source = $builder->source;
350              
351             The C source for the probe runner.
352              
353             =head2 extract
354              
355             $builder->extract;
356              
357             Extract the source for the probe runner.
358              
359             =head2 run
360              
361             $builder->run($type, @command);
362              
363             Runs the given command. Dies if the command fails.
364              
365             =head2 run_list
366              
367             $builder->run($type, \@command, \@command, ...);
368              
369             Runs the given commands in order until one succeeds.
370             Dies if they all fail.
371              
372             =head2 build
373              
374             my $exe = $builder->build;
375              
376             Builds the probe runner. Returns the path to the executable.
377              
378             =head1 AUTHOR
379              
380             Author: Graham Ollis Eplicease@cpan.orgE
381              
382             Contributors:
383              
384             Bakkiaraj Murugesan (bakkiaraj)
385              
386             Dylan Cali (calid)
387              
388             pipcet
389              
390             Zaki Mughal (zmughal)
391              
392             Fitz Elliott (felliott)
393              
394             Vickenty Fesunov (vyf)
395              
396             Gregor Herrmann (gregoa)
397              
398             Shlomi Fish (shlomif)
399              
400             Damyan Ivanov
401              
402             Ilya Pavlov (Ilya33)
403              
404             Petr Písař (ppisar)
405              
406             Mohammad S Anwar (MANWAR)
407              
408             Håkon Hægland (hakonhagland, HAKONH)
409              
410             Meredith (merrilymeredith, MHOWARD)
411              
412             Diab Jerius (DJERIUS)
413              
414             Eric Brine (IKEGAMI)
415              
416             szTheory
417              
418             José Joaquín Atria (JJATRIA)
419              
420             Pete Houston (openstrike, HOUSTON)
421              
422             =head1 COPYRIGHT AND LICENSE
423              
424             This software is copyright (c) 2015-2022 by Graham Ollis.
425              
426             This is free software; you can redistribute it and/or modify it under
427             the same terms as the Perl 5 programming language system itself.
428              
429             =cut
430              
431             __DATA__