File Coverage

blib/lib/Module/Build/FFI/Pascal.pm
Criterion Covered Total %
statement 24 101 23.7
branch 0 38 0.0
condition 0 6 0.0
subroutine 8 10 80.0
pod 2 2 100.0
total 34 157 21.6


line stmt bran cond sub pod time code
1             package Module::Build::FFI::Pascal;
2              
3 1     1   791 use strict;
  1         1  
  1         30  
4 1     1   4 use warnings;
  1         2  
  1         19  
5 1     1   3 use Config;
  1         1  
  1         34  
6 1     1   4 use File::Glob qw( bsd_glob );
  1         1  
  1         80  
7 1     1   6 use File::Which qw( which );
  1         1  
  1         50  
8 1     1   479 use File::chdir;
  1         2419  
  1         104  
9 1     1   544 use File::Copy qw( move );
  1         2312  
  1         71  
10 1     1   6 use base qw( Module::Build::FFI );
  1         1  
  1         619  
11              
12             our $VERSION = '0.04';
13              
14             =head1 NAME
15              
16             Module::Build::FFI::Pascal - Build Perl extensions in Free Pascal with FFI
17              
18             =head1 DESCRIPTION
19              
20             L variant for writing Perl extensions in Pascal with
21             FFI (sans XS).
22              
23             =head1 BASE CLASS
24              
25             All methods, properties and actions are inherited from:
26              
27             L
28              
29             =head1 PROPERTIES
30              
31             =over 4
32              
33             =item ffi_pascal_lib
34              
35             Name of Pascal libraries. Default is ['ffi.pas','test.pas']
36              
37             =item ffi_pascal_extra_compiler_flags
38              
39             Extra compiler flags to be passed to C.
40              
41             Must be a array reference.
42              
43             =item ffi_pascal_extra_linker_flags
44              
45             Extra linker flags to be passed to C.
46              
47             Must be a array reference.
48              
49             =back
50              
51             =cut
52              
53             __PACKAGE__->add_property( ffi_pascal_extra_compiler_flags =>
54             default => [],
55             );
56              
57             __PACKAGE__->add_property( ffi_pascal_extra_linker_flags =>
58             default => [],
59             );
60              
61             __PACKAGE__->add_property( ffi_pascal_lib =>
62             default => ['ffi.pas','test.pas'],
63             );
64              
65             =head1 BASE CLASS
66              
67             =over
68              
69             =item L
70              
71             =back
72              
73             =head1 METHODS
74              
75             =head2 ffi_have_compiler
76              
77             my $has_compiler = $mb->ffi_have_compiler;
78              
79             Returns true if Free Pascal is available.
80              
81             =cut
82              
83             sub ffi_have_compiler
84             {
85 0     0 1   my($self) = @_;
86            
87 0           my $fpc = which('fpc');
88 0           my $ppumove = which('ppumove');
89            
90 0   0       return (!!$fpc) && (!!$ppumove);
91             }
92              
93             =head2 ffi_build_dynamic_lib
94              
95             my $dll_path = $mb->ffi_build_dynamic_lib($src_dir, $name, $target_dir);
96             my $dll_path = $mb->ffi_build_dynamic_lib($src_dir, $name);
97              
98             Compiles the Pascal source in the C<$src_dir> and link it into a dynamic
99             library with base name of C<$name.$Config{dlexe}>. If C<$target_dir> is
100             specified then the dynamic library will be delivered into that directory.
101              
102             =cut
103              
104             sub ffi_build_dynamic_lib
105             {
106 0     0 1   my($self, $src_dir, $name, $target_dir) = @_;
107              
108 0 0         die "multiple directories not supported by ", __PACKAGE__
109             if @$src_dir > 1;
110            
111 0           $src_dir = $src_dir->[0];
112 0           my $lib;
113 0           my %lib = map { $_ => 1 } @{ $self->ffi_pascal_lib };
  0            
  0            
114              
115 0           do {
116 0           local $CWD = $src_dir;
117 0           print "cd $CWD\n";
118            
119 0 0         $target_dir = $src_dir unless defined $target_dir;
120 0           my @sources = bsd_glob("*.pas");
121            
122 0 0         return unless @sources;
123            
124 0           my $fpc = which('fpc');
125 0           my $ppumove = which('ppumove');
126              
127 0           my @compiler_flags;
128             my @linker_flags;
129              
130             # TODO: OSX not sure if checking ptrsize will actually work
131             # % arch -arch i386 /usr/bin/perl -V:ptrsize
132             # ptrsize='8';
133             # but the system perl is a universal binary
134             # or maybe I am using arch wrong. who knows.
135             # TODO: OSX make a universal binary if possible?
136             # Fortunately most people are probably using OS X 64 bit intel by now anyway
137 0 0 0       push @compiler_flags, '-Px86_64' if $^O eq 'darwin' && $Config{ptrsize} == 8;
138              
139 0           my @ppu;
140              
141 0           foreach my $src (@sources)
142             {
143 0 0         if($lib{$src})
144             {
145 0 0         die "Two or more libraries in $CWD" if defined $lib;
146 0           $lib = $src;
147 0           next;
148             }
149            
150 0           my @cmd = (
151             $fpc,
152             @compiler_flags,
153 0           @{ $self->ffi_pascal_extra_compiler_flags },
154             $src
155             );
156            
157 0           print "@cmd\n";
158 0           system @cmd;
159 0 0         exit 2 if $?;
160            
161 0           my $ppu = $src;
162 0           $ppu =~ s{\.pas$}{.ppu};
163            
164 0 0         unless(-r $ppu)
165             {
166 0           print STDERR "unable to find $ppu after compile\n";
167 0           exit 2;
168             }
169            
170 0           push @ppu, $ppu;
171             }
172              
173 0 0         if($lib)
174             {
175 0           my @cmd = (
176             $fpc,
177             @compiler_flags,
178 0           @{ $self->ffi_pascal_extra_compiler_flags },
179             $lib,
180             );
181 0           print "@cmd\n";
182 0           system @cmd;
183 0 0         exit 2 if $?;
184 0           my @so = map { bsd_glob("*.$_") } Module::Build::FFI->ffi_dlext;
  0            
185 0 0         die "multiple dylibs in $CWD" if @so > 1;
186 0 0         die "no dylib in $CWD" if @so < 1;
187             }
188             else
189             {
190 0           my @cmd;
191              
192 0 0         if($^O eq 'darwin')
193             {
194 0           my @obj = map { s/\.ppu/\.o/; $_ } @ppu;
  0            
  0            
195 0 0         @cmd = (
196             'ld',
197             $Config{dlext} eq 'bundle' ? '-bundle' : '-dylib',
198             '-o' => "libmbFFIPlatypusPascal.$Config{dlext}",
199             @obj,
200             );
201             }
202             else
203             {
204 0           @cmd = (
205             $ppumove,
206             @linker_flags,
207 0           @{ $self->ffi_pascal_extra_linker_flags },
208             -o => 'mbFFIPlatypusPascal',
209             -e => 'ppl',
210             @ppu,
211             );
212             }
213 0           print "@cmd\n";
214 0           system @cmd;
215 0 0         exit 2 if $?;
216             }
217              
218             };
219            
220 0           print "cd $CWD\n";
221            
222 0           my($from) = map { bsd_glob("$src_dir/*.$_") } Module::Build::FFI->ffi_dlext;
  0            
223            
224 0 0         unless(defined $from)
225             {
226 0           print STDERR "unable to find shared library\n";
227 0           exit 2;
228             }
229            
230 0           print "chmod 0755 $from\n";
231 0           chmod 0755, $from;
232            
233 0           my $ext = $Config{dlext};
234 0           foreach my $try (Module::Build::FFI->ffi_dlext)
235             {
236 0 0         $ext = $1 if $from =~ /\.($try)/;
237             }
238            
239 0           my $dll = File::Spec->catfile($target_dir, "$name.$ext");
240              
241 0 0         if($from ne $dll)
242             {
243 0           print "mv $from $dll\n";
244 0 0         move($from => $dll) || do {
245 0           print "error copying file $!";
246 0           exit 2;
247             };
248             }
249            
250 0           $dll;
251             }
252              
253             1;
254              
255             =head1 EXAMPLES
256              
257             TODO
258              
259             =head1 SUPPORT
260              
261             If something does not work as advertised, or the way that you think it
262             should, or if you have a feature request, please open an issue on this
263             project's GitHub issue tracker:
264              
265             L
266              
267             =head1 CONTRIBUTING
268              
269             If you have implemented a new feature or fixed a bug then you may make a
270             pull reequest on this project's GitHub repository:
271              
272             L
273              
274             Caution: if you do this too frequently I may nominate you as the new
275             maintainer. Extreme caution: if you like that sort of thing.
276              
277             =head1 SEE ALSO
278              
279             =over 4
280              
281             =item L
282              
283             The Core Platypus documentation.
284              
285             =item L
286              
287             General MB class for FFI / Platypus.
288              
289             =back
290              
291             =head1 AUTHOR
292              
293             Graham Ollis Eplicease@cpan.orgE
294              
295             =head1 COPYRIGHT AND LICENSE
296              
297             This software is copyright (c) 2015 by Graham Ollis.
298              
299             This is free software; you can redistribute it and/or modify it under
300             the same terms as the Perl 5 programming language system itself.
301              
302             =cut
303