File Coverage

blib/lib/Inline.pm
Criterion Covered Total %
statement 451 894 50.4
branch 140 452 30.9
condition 35 191 18.3
subroutine 70 149 46.9
pod 4 101 3.9
total 700 1787 39.1


line stmt bran cond sub pod time code
1 8     8   1437089 use strict; use warnings;
  8     8   54  
  8         193  
  8         34  
  8         12  
  8         346  
2             package Inline;
3              
4             our $VERSION = '0.86';
5              
6 8     8   2801 use Inline::denter;
  8         20  
  8         212  
7 8     8   43 use Config;
  8         14  
  8         260  
8 8     8   36 use Carp;
  8         11  
  8         317  
9 8     8   36 use Cwd qw(abs_path cwd);
  8         15  
  8         258  
10 8     8   3744 use Encode;
  8         67288  
  8         443  
11 8     8   57 use File::Spec;
  8         15  
  8         151  
12 8     8   32 use File::Spec::Unix;
  8         14  
  8         241  
13 8     8   44 use Fcntl qw(LOCK_EX LOCK_UN);
  8         12  
  8         285  
14 8     8   2715 use version;
  8         12527  
  8         38  
15 8     8   3971 use utf8;
  8         90  
  8         51  
16              
17             my %CONFIG = ();
18             my @DATA_OBJS = ();
19             my $INIT = 0;
20             my $version_requested = 0;
21             my $version_printed = 0;
22             my $untaint = 0;
23             my $safemode = 0;
24              
25             our $languages = undef;
26              
27             our $did = '_Inline'; # Default Inline Directory
28              
29             # This is the config file written by create_config_file().
30             our $configuration_file = 'config-' . $Config::Config{'archname'} . '-' . $];
31              
32             my %shortcuts =
33             (
34             NOCLEAN => [CLEAN_AFTER_BUILD => 0],
35             CLEAN => [CLEAN_BUILD_AREA => 1],
36             FORCE => [FORCE_BUILD => 1],
37             INFO => [PRINT_INFO => 1],
38             VERSION => [PRINT_VERSION => 1],
39             REPORTBUG => [REPORTBUG => 1],
40             UNTAINT => [UNTAINT => 1],
41             SAFE => [SAFEMODE => 1],
42             UNSAFE => [SAFEMODE => 0],
43             GLOBAL => [GLOBAL_LOAD => 1],
44             NOISY => [BUILD_NOISY => 1],
45             TIMERS => [BUILD_TIMERS => 1],
46             NOWARN => [WARNINGS => 0],
47             _INSTALL_ => [_INSTALL_ => 1],
48             SITE_INSTALL => undef, # No longer supported.
49             );
50              
51             my $default_config =
52             {
53             NAME => '',
54             AUTONAME => -1,
55             VERSION => '',
56             DIRECTORY => '',
57             WITH => [],
58             USING => [],
59              
60             CLEAN_AFTER_BUILD => 1,
61             CLEAN_BUILD_AREA => 0,
62             FORCE_BUILD => 0,
63             PRINT_INFO => 0,
64             PRINT_VERSION => 0,
65             REPORTBUG => 0,
66             UNTAINT => 0,
67             NO_UNTAINT_WARN => 0,
68             REWRITE_CONFIG_FILE => 0,
69             SAFEMODE => -1,
70             GLOBAL_LOAD => 0,
71             BUILD_NOISY => 0,
72             BUILD_TIMERS => 0,
73             WARNINGS => 1,
74             _INSTALL_ => 0,
75             _TESTING => 0,
76             };
77              
78 130     130 0 376 sub UNTAINT {$untaint}
79 0     0 0 0 sub SAFEMODE {$safemode}
80              
81             #==============================================================================
82             # This is where everything starts.
83             #==============================================================================
84             sub import {
85 26     26   1133 my $class = shift;
86 26         81 $class->import_heavy(@_);
87             }
88              
89             sub import_heavy {
90 26     26 0 108 local ($/, $") = ("\n", ' '); local ($\, $,);
  26         70  
91              
92 26         35 my $o;
93 26         135 my ($pkg, $script) = caller(1);
94             # Not sure what this is for. Let's see what breaks.
95             # $pkg =~ s/^.*[\/\\]//;
96 26         227 my $class = shift;
97 26 50       72 if ($class ne 'Inline') {
98 0 0       0 croak M01_usage_use($class) if $class =~ /^Inline::/;
99 0         0 croak M02_usage();
100             }
101              
102 26   66     107 $CONFIG{$pkg}{template} ||= $default_config;
103              
104 26 50       63 return unless @_;
105 26 50       48 &create_config_file(), return 1 if $_[0] eq '_CONFIG_';
106 26 50       87 goto &maker_utils if $_[0] =~ /^(install|makedist|makeppd)$/i;
107              
108 26         36 my $control = shift;
109              
110 26 100 33     283 if (uc $control eq uc 'with') {
    100          
    50          
    50          
111 2         5 return handle_with($pkg, @_);
112             }
113             elsif (uc $control eq uc 'Config') {
114 8         26 return handle_global_config($pkg, @_);
115             }
116             elsif (exists $shortcuts{uc($control)}) {
117 0         0 handle_shortcuts($pkg, $control, @_);
118 0         0 $version_requested = $CONFIG{$pkg}{template}{PRINT_VERSION};
119 0         0 return;
120             }
121             elsif ($control =~ /^\S+$/ and $control !~ /\n/) {
122 16         30 my $language_id = $control;
123 16   100     56 my $option = shift || '';
124 16         36 my @config = @_;
125 16         21 my $next = 0;
126 16         35 for (@config) {
127 10 100       24 next if $next++ % 2;
128 5 50       15 croak M02_usage() if /[\s\n]/;
129             }
130 16         32 $o = bless {}, $class;
131 16         78 $o->{INLINE}{version} = $VERSION;
132 16         33 $o->{API}{pkg} = $pkg;
133 16         25 $o->{API}{script} = $script;
134 16         26 $o->{API}{language_id} = $language_id;
135 16 50 66     222 if ($option =~ /^(FILE|BELOW)$/i or
    100 33        
    100 33        
      100        
136             not $option and
137             defined $INC{File::Spec::Unix->catfile('Inline','Files.pm')} and
138             Inline::Files::get_filename($pkg)
139             ) {
140 0         0 $o->read_inline_file;
141 0         0 $o->{CONFIG} = handle_language_config($o->{CONFIG}, @config);
142             }
143             elsif ($option eq 'DATA' or not $option) {
144 5         35 $o->{CONFIG} = handle_language_config($o->{CONFIG}, @config);
145 5         13 push @DATA_OBJS, $o;
146 5         1412 return;
147             }
148             elsif (uc $option eq uc 'Config') {
149 3         14 $CONFIG{$pkg}{$language_id} = handle_language_config($CONFIG{$pkg}{$language_id}, @config);
150 3         15 return;
151             }
152             else {
153 8         22435 $o->receive_code($option);
154 8         32 $o->{CONFIG} = handle_language_config($o->{CONFIG}, @config);
155             }
156             }
157             else {
158 0         0 croak M02_usage();
159             }
160 8         30 $o->glue;
161             }
162              
163             #==============================================================================
164             # Run time version of import (public method)
165             #==============================================================================
166             sub bind {
167 3     3 1 795 local ($/, $") = ("\n", ' '); local ($\, $,);
  3         7  
168              
169 3         5 my ($code, @config);
170 3         0 my $o;
171 3         9 my ($pkg, $script) = caller;
172 3         5 my $class = shift;
173 3 50       7 croak M03_usage_bind() unless $class eq 'Inline';
174              
175 3   33     6 $CONFIG{$pkg}{template} ||= $default_config;
176              
177 3 50       5 my $language_id = shift or croak M03_usage_bind();
178 3 50 33     18 croak M03_usage_bind()
179             unless ($language_id =~ /^\S+$/ and $language_id !~ /\n/);
180 3 50       7 $code = shift or croak M03_usage_bind();
181 3         4 @config = @_;
182              
183 3         4 my $next = 0;
184 3         6 for (@config) {
185 0 0       0 next if $next++ % 2;
186 0 0       0 croak M03_usage_bind() if /[\s\n]/;
187             }
188 3         4 $o = bless {}, $class;
189 3         14 $o->{INLINE}{version} = $VERSION;
190 3         5 $o->{API}{pkg} = $pkg;
191 3         6 $o->{API}{script} = $script;
192 3         3 $o->{API}{language_id} = $language_id;
193 3         8 $o->receive_code($code);
194 3         7 $o->{CONFIG} = handle_language_config($o->{CONFIG}, @config);
195              
196 3         7 $o->glue;
197             }
198              
199             #==============================================================================
200             # Process delayed objects that don't have source code yet.
201             #==============================================================================
202             # This code is an ugly hack because of the fact that you can't use an
203             # INIT block at "run-time proper". So we kill the warning and tell users
204             # to use an Inline->init() call if they run into problems. (rare)
205              
206 8     8   46 eval <
  8     6   13  
  8         339  
  6         483  
  6         19  
207             no warnings;
208             \$INIT = \$INIT; # Needed by Sarathy's patch.
209             sub INIT {
210             \$INIT++;
211             &init;
212             }
213             END
214              
215             sub init {
216 8     8 0 65 local ($/, $") = ("\n", ' '); local ($\, $,);
  8         26  
217              
218 8         148 while (my $o = shift(@DATA_OBJS)) {
219 5         20 $o->read_DATA;
220 5         16 $o->glue;
221             }
222             }
223              
224             sub END {
225 8 50   8   7976 warn M51_unused_DATA() if @DATA_OBJS;
226 8 50 33     221 print_version() if $version_requested && not $version_printed;
227             }
228              
229             #==============================================================================
230             # Print a small report about the version of Inline
231             #==============================================================================
232             sub print_version {
233 0 0   0 1 0 return if $version_printed++;
234 0         0 print STDERR <
235              
236             You are using Inline.pm version $VERSION
237              
238             END
239             }
240              
241             #==============================================================================
242             # Compile the source if needed and then dynaload the object
243             #==============================================================================
244             sub glue {
245 16     16 0 25 my $o = shift;
246 16         24 my ($pkg, $language_id) = @{$o->{API}}{qw(pkg language_id)};
  16         45  
247 16         91 my @config = (%{$CONFIG{$pkg}{template}},
248 16 100       109 %{$CONFIG{$pkg}{$language_id} || {}},
249 16 50       20 %{$o->{CONFIG} || {}},
  16         89  
250             );
251 16         65 @config = $o->check_config(@config);
252 16         59 $o->fold_options;
253              
254 16         57 $o->check_installed;
255 16 50       36 $o->env_untaint if UNTAINT;
256 16 50       59 if (not $o->{INLINE}{object_ready}) {
257 16         44 $o->check_config_file; # Final DIRECTORY set here.
258 13         109 push @config, $o->with_configs;
259 13         39 my $language = $o->{API}{language};
260 13 50       51 croak M04_error_nocode($language_id) unless $o->{API}{code};
261 13         74 $o->check_module;
262             }
263 13 50       49 $o->env_untaint if UNTAINT;
264 13 50       181 $o->obj_untaint if UNTAINT;
265 13 50       35 print_version() if $version_requested;
266 13 50       33 $o->reportbug() if $o->{CONFIG}{REPORTBUG};
267 13 50 33     73 if (not $o->{INLINE}{object_ready}
268             or $o->{CONFIG}{PRINT_INFO}
269             ) {
270 13         1372 eval "require $o->{INLINE}{ILSM_module}";
271 13 50       52 croak M05_error_eval('glue', $@) if $@;
272 13         66 $o->push_overrides;
273 13         41 bless $o, $o->{INLINE}{ILSM_module};
274 13         40 $o->validate(@config);
275             }
276             else {
277 0         0 $o->{CONFIG} = {(%{$o->{CONFIG}}, @config)};
  0         0  
278             }
279 13 50       37 $o->print_info if $o->{CONFIG}{PRINT_INFO};
280 13 50 33     85 unless ($o->{INLINE}{object_ready} or
281             not length $o->{INLINE}{ILSM_suffix}) {
282 13         37 $o->build();
283 13 50       224 $o->write_inl_file() unless $o->{CONFIG}{_INSTALL_};
284             }
285 13 50 33     241 if ($o->{INLINE}{ILSM_suffix} ne 'so' and
      33        
      33        
      33        
286             $o->{INLINE}{ILSM_suffix} ne 'dll' and
287             $o->{INLINE}{ILSM_suffix} ne 'bundle' and
288             $o->{INLINE}{ILSM_suffix} ne 'sl' and
289             ref($o) eq 'Inline'
290             ) {
291 0         0 eval "require $o->{INLINE}{ILSM_module}";
292 0 0       0 croak M05_error_eval('glue', $@) if $@;
293 0         0 $o->push_overrides;
294 0         0 bless $o, $o->{INLINE}{ILSM_module};
295 0         0 $o->validate(@config);
296             }
297 13         53 $o->load;
298 13         100 $o->pop_overrides;
299             }
300              
301             #==============================================================================
302             # Set up the USING overrides
303             #==============================================================================
304             sub push_overrides {
305 13     13 0 28 my ($o) = @_;
306 13         179 my ($language_id) = $o->{API}{language_id};
307 13         39 my ($ilsm) = $o->{INLINE}{ILSM_module};
308 13         19 for (@{$o->{CONFIG}{USING}}) {
  13         53  
309 0 0       0 my $fixed_name = /^Parser?(Pegex|RegExp|RecDescent)$/ ? "Parser::$1" : $_;
310 0         0 $fixed_name =~ s/^:://;
311 0 0       0 my $using_module = /^::/
    0          
312             ? "Inline::${language_id}::$fixed_name"
313             : /::/
314             ? $_
315             : "Inline::${language_id}::$fixed_name";
316 0         0 eval "require $using_module";
317 0 0       0 croak "Invalid module '$using_module' in USING list:\n$@" if $@;
318 0         0 my $register;
319 0         0 eval "\$register = $using_module->register";
320 0 0       0 croak "Invalid module '$using_module' in USING list:\n$@" if $@;
321 0         0 for my $override (@{$register->{overrides}}) {
  0         0  
322 8     8   15626 no strict 'refs';
  8         17  
  8         536  
323 0 0       0 next if defined $o->{OVERRIDDEN}{$ilsm . "::$override"};
324             $o->{OVERRIDDEN}{$ilsm . "::$override"} =
325 0         0 \&{$ilsm . "::$override"};
  0         0  
326             {
327 8     8   57 no warnings 'redefine';
  8         34  
  8         1741  
  0         0  
328 0         0 *{$ilsm . "::$override"} =
329 0         0 \&{$using_module . "::$override"};
  0         0  
330             }
331             }
332             }
333             }
334              
335             #==============================================================================
336             # Restore the modules original methods
337             #==============================================================================
338             sub pop_overrides {
339 13 50   13 0 64 my $nowarn = $] >= 5.006 ? "no warnings 'redefine';" : '';
340 13     6   705 eval ($nowarn .
  6     5   36  
  6     2   8  
  6     2   541  
  5     1   26  
  5     1   12  
  5     1   334  
  2     1   10  
  2     1   4  
  2     1   126  
  2     1   12  
  2     1   3  
  2     1   101  
  1     1   6  
  1     1   1  
  1     1   61  
  1         6  
  1         2  
  1         51  
  1         6  
  1         1  
  1         65  
  1         6  
  1         2  
  1         40  
  1         5  
  1         2  
  1         53  
  1         5  
  1         1  
  1         38  
  1         6  
  1         2  
  1         51  
  1         5  
  1         2  
  1         36  
  1         6  
  1         1  
  1         52  
  1         5  
  1         2  
  1         37  
  1         6  
  1         1  
  1         51  
  1         5  
  1         1  
  1         37  
341             'my ($o) = @_;
342             for my $override (keys %{$o->{OVERRIDDEN}}) {
343             no strict "refs";
344             *{$override} = $o->{OVERRIDDEN}{$override};
345             }
346             delete $o->{OVERRIDDEN};')
347             }
348              
349             #==============================================================================
350             # Get source from the DATA filehandle
351             #==============================================================================
352             my (%DATA, %DATA_read);
353             sub read_DATA {
354 5     5 0 1432 require Socket;
355 5         9605 my ($marker, $marker_tag);
356 5         11 my $o = shift;
357 5         10 my ($pkg, $language_id) = @{$o->{API}}{qw(pkg language_id)};
  5         20  
358 5 100       21 unless ($DATA_read{$pkg}++) {
359 8     8   50 no strict 'refs';
  8         14  
  8         19711  
360 3         6 *Inline::DATA = *{$pkg . '::DATA'};
  3         22  
361 3         11 local ($/);
362 3         39 my ($CR, $LF) = (&Socket::CR, &Socket::LF);
363 3         122 (my $data = ) =~ s/$CR?$LF/\n/g;
364 3         9 @{$DATA{$pkg}} = split /(?m)^[ \t]{0,}(__\S+?__\n)/, $data;
  3         44  
365 3 50 50     7 shift @{$DATA{$pkg}} unless ($ {$DATA{$pkg}}[0] || '') =~ /__\S+?__\n/;
  3         14  
366             }
367 5         20 ($marker, $o->{API}{code}) = splice @{$DATA{$pkg}}, 0, 2;
  5         20  
368 5 50       14 croak M08_no_DATA_source_code($language_id)
369             unless defined $marker;
370 5         37 ($marker_tag = $marker) =~ s/__(\S+?)__\n/$1/;
371 5 50       21 croak M09_marker_mismatch($marker, $language_id)
372             unless $marker_tag eq $language_id;
373             }
374              
375             #==============================================================================
376             # Validate and store the non language-specific config options
377             #==============================================================================
378             sub check_config {
379 16     16 0 24 my $o = shift;
380 16         21 my @others;
381 16         62 while (@_) {
382 357         451 my ($key, $value) = (shift, shift);
383 357 100       454 if (defined $default_config->{$key}) {
384 352 100       845 if ($key =~ /^(WITH|USING)$/) {
385 32 50 33     146 croak M10_usage_WITH_USING()
386             if (ref $value and ref $value ne 'ARRAY');
387 32 50       55 $value = [$value] unless ref $value;
388 32         68 $o->{CONFIG}{$key} = $value;
389 32         60 next;
390             }
391 320 100       685 $o->{CONFIG}{$key} = $value, next if not $value;
392 80 100       166 if ($key eq 'DIRECTORY') {
    50          
    50          
393 16 50       232 croak M11_usage_DIRECTORY($value) unless (-d $value);
394 16         270 $value = abs_path($value);
395             }
396             elsif ($key eq 'NAME') {
397 0 0       0 croak M12_usage_NAME($value)
398             unless $value =~ /^[a-zA-Z_](\w|::)*$/;
399             }
400             elsif ($key eq 'VERSION') {
401 0 0       0 croak M13_usage_VERSION($value)
402             unless version::is_lax($value);
403             }
404 80         190 $o->{CONFIG}{$key} = $value;
405             }
406             else {
407 5         32 push @others, $key, $value;
408             }
409             }
410 16         68 return (@others);
411             }
412              
413             #==============================================================================
414             # Set option defaults based on current option settings.
415             #==============================================================================
416             sub fold_options {
417 16     16 0 30 my $o = shift;
418              
419             # The following small section of code seems, to me, to be unnecessary - which is the
420             # reason that I've commented it out. I've left it here (including its associated comments)
421             # in case it later becomes evident that there *is* good reason to include it. --sisyphus
422             #
423             ## This bit tries to enable UNTAINT automatically if required when running the test suite.
424             # my $env_ha = $ENV{HARNESS_ACTIVE} || 0 ;
425             # my ($harness_active) = $env_ha =~ /(.*)/ ;
426             # if (($harness_active)&&(! $o->{CONFIG}{UNTAINT})){
427             # eval {
428             # require Scalar::Util;
429             # $o->{CONFIG}{UNTAINT} =
430             # (Scalar::Util::tainted(Cwd::cwd()) ? 1 : 0) ;
431             ## Disable SAFEMODE in the test suite, we know what we are doing...
432             # $o->{CONFIG}{SAFEMODE} = 0 ;
433             # warn "\n-[tT] enabled for test suite.
434             #Automatically setting UNTAINT=1 and SAFEMODE=0.\n"
435             # unless $Inline::_TAINT_WARNING_ ;
436             # $Inline::_TAINT_WARNING_ = 1 ;
437             # } ;
438             # }
439             ##
440 16   50     96 $untaint = $o->{CONFIG}{UNTAINT} || 0;
441             $safemode = (($o->{CONFIG}{SAFEMODE} == -1) ?
442             ($untaint ? 1 : 0) :
443             $o->{CONFIG}{SAFEMODE}
444 16 50       51 );
    50          
445 16 0 33     33 if (UNTAINT and
      33        
446             SAFEMODE and
447             not $o->{CONFIG}{DIRECTORY}) {
448 0 0 0     0 croak M49_usage_unsafe(1) if ($< == 0 or $> == 0);
449 0 0       0 warn M49_usage_unsafe(0) if $^W;
450             }
451 16 50       63 if ($o->{CONFIG}{AUTONAME} == -1) {
452 16 50       82 $o->{CONFIG}{AUTONAME} = length($o->{CONFIG}{NAME}) ? 0 : 1;
453             }
454             $o->{API}{cleanup} =
455 16   33     91 ($o->{CONFIG}{CLEAN_AFTER_BUILD} and not $o->{CONFIG}{REPORTBUG});
456             }
457              
458             #==============================================================================
459             # Check if Inline extension is preinstalled
460             #==============================================================================
461             sub check_installed {
462 16     16 0 25 my $o = shift;
463 16         43 $o->{INLINE}{object_ready} = 0;
464 16 50       61 unless ($o->{API}{code} =~ /^[A-Fa-f0-9]{32}$/) {
465 16         101 require Digest::MD5;
466 16         37 my $encoded_code = $o->{API}{code};
467 16 100       60 if ( utf8::is_utf8($encoded_code)) {
468 1         3 $encoded_code = Encode::encode_utf8($encoded_code);
469             }
470 16         74 $o->{INLINE}{md5} = Digest::MD5::md5_hex($encoded_code);
471             }
472             else {
473 0         0 $o->{INLINE}{md5} = $o->{API}{code};
474             }
475 16 50       43 return if $o->{CONFIG}{_INSTALL_};
476 16 50       47 return unless $o->{CONFIG}{VERSION};
477             croak M26_error_version_without_name()
478 0 0       0 unless $o->{CONFIG}{NAME};
479              
480 0         0 my @pkgparts = split(/::/, $o->{API}{pkg});
481 0         0 my $realname = File::Spec->catfile(@pkgparts) . '.pm';
482 0         0 my $realname_unix = File::Spec::Unix->catfile(@pkgparts) . '.pm';
483 0 0       0 my $realpath = $INC{$realname_unix}
484             or croak M27_module_not_indexed($realname_unix);
485              
486 0         0 my ($volume,$dir,$file) = File::Spec->splitpath($realpath);
487 0         0 my @dirparts = File::Spec->splitdir($dir);
488 0 0       0 pop @dirparts unless $dirparts[-1];
489 0         0 push @dirparts, $file;
490 0         0 my @endparts = splice(@dirparts, 0 - @pkgparts);
491              
492 0 0 0     0 $dirparts[-1] = 'arch'
493             if $dirparts[-2] eq 'blib' && $dirparts[-1] eq 'lib';
494 0 0       0 File::Spec->catfile(@endparts) eq $realname
495             or croak M28_error_grokking_path($realpath);
496 0         0 $realpath =
497             File::Spec->catpath($volume,File::Spec->catdir(@dirparts),"");
498              
499 0         0 $o->{API}{version} = $o->{CONFIG}{VERSION};
500 0         0 $o->{API}{module} = $o->{CONFIG}{NAME};
501 0         0 my @modparts = split(/::/,$o->{API}{module});
502 0         0 $o->{API}{modfname} = $modparts[-1];
503 0         0 $o->{API}{modpname} = File::Spec->catdir(@modparts);
504              
505 0         0 my $suffix = $Config{dlext};
506             my $obj = File::Spec->catfile($realpath,'auto',$o->{API}{modpname},
507 0         0 "$o->{API}{modfname}.$suffix");
508             croak M30_error_no_obj($o->{CONFIG}{NAME}, $o->{API}{pkg},
509 0 0       0 $realpath) unless -f $obj;
510              
511 0         0 @{$o->{CONFIG}}{qw( PRINT_INFO
  0         0  
512             REPORTBUG
513             FORCE_BUILD
514             _INSTALL_
515             )} = (0, 0, 0, 0);
516              
517 0         0 $o->{install_lib} = $realpath;
518 0         0 $o->{INLINE}{ILSM_type} = 'compiled';
519 0         0 $o->{INLINE}{ILSM_module} = 'Inline::C';
520 0         0 $o->{INLINE}{ILSM_suffix} = $suffix;
521 0         0 $o->{INLINE}{object_ready} = 1;
522             }
523              
524             #==============================================================================
525             # Dynamically load the object module
526             #==============================================================================
527             sub load {
528 0     0 0 0 my $o = shift;
529              
530 0 0       0 return if $o->{CONFIG}{_INSTALL_};
531              
532 0         0 my ($pkg, $module) = @{$o->{API}}{qw(pkg module)};
  0         0  
533 0 0       0 croak M42_usage_loader() unless $o->{INLINE}{ILSM_type} eq 'compiled';
534              
535 0         0 require DynaLoader;
536 0         0 @Inline::ISA = qw(DynaLoader);
537              
538 0 0       0 my $global = $o->{CONFIG}{GLOBAL_LOAD} ? '0x01' : '0x00';
539 0   0     0 my $version = $o->{API}{version} || '0.00';
540              
541 0         0 eval <
542             package $pkg;
543             push \@$ {pkg}::ISA, qw($module)
544             unless \$module eq "$pkg";
545             local \$$ {module}::VERSION = '$version';
546              
547             package $module;
548             push \@$ {module}::ISA, qw(Exporter DynaLoader);
549             sub dl_load_flags { $global }
550             ${module}::->bootstrap;
551             END
552 0 0       0 croak M43_error_bootstrap($module, $@) if $@;
553             }
554              
555             #==============================================================================
556             # Create file that satisfies the Makefile dependency for this object
557             #==============================================================================
558              
559             sub satisfy_makefile_dep {
560 0     0 0 0 my $o = shift;
561              
562 0         0 my $inline = $o->{API}{modinlname};
563 0 0       0 open INLINE, "> $inline"
564             or croak M24_open_for_output_failed($inline);
565 0         0 print INLINE "*** AUTOGENERATED by Inline.pm ***\n\n";
566 0         0 print INLINE "This file satisfies the make dependency for ";
567 0         0 print INLINE "$o->{API}{module}\n";
568 0         0 close INLINE;
569 0         0 return;
570             }
571              
572             #==============================================================================
573             # Process the config options that apply to all Inline sections
574             #==============================================================================
575             sub handle_global_config {
576 8     8 0 19 my $pkg = shift;
577 8         21 while (@_) {
578 13         40 my ($key, $value) = (uc shift, shift);
579 13 50       41 croak M02_usage() if $key =~ /[\s\n]/;
580 13 100       47 if ($key =~ /^(ENABLE|DISABLE)$/) {
581 2 50       8 ($key, $value) = (uc $value, $key eq 'ENABLE' ? 1 : 0);
582             }
583             croak M47_invalid_config_option($key)
584 13 50       39 unless defined $default_config->{$key};
585 13         1671 $CONFIG{$pkg}{template}{$key} = $value;
586             }
587             }
588              
589             #==============================================================================
590             # Process the config options that apply to a particular language
591             #==============================================================================
592             sub handle_language_config {
593 19 100   19 0 26 my %merge_with = %{ shift || {} };
  19         117  
594 19         47 my @values;
595 19         45 while (@_) {
596 5         12 my ($key, $value) = (uc shift, shift);
597 5 50       17 croak M02_usage() if $key =~ /[\s\n]/;
598 5 100       16 if ($key eq 'ENABLE') {
    50          
599 3         11 push @values, uc $value, 1;
600             }
601             elsif ($key eq 'DISABLE') {
602 0         0 push @values, uc $value, 0;
603             }
604             else {
605 2         6 push @values, $key, $value;
606             }
607             }
608 19         70 return {%merge_with, @values};
609             }
610              
611             #==============================================================================
612             # Validate and store shortcut config options
613             #==============================================================================
614             sub handle_shortcuts {
615 0     0 0 0 my $pkg = shift;
616              
617 0         0 for my $option (@_) {
618 0         0 my $OPTION = uc($option);
619 0 0       0 if ($OPTION eq 'SITE_INSTALL') {
    0          
620 0         0 croak M58_site_install();
621             }
622             elsif ($shortcuts{$OPTION}) {
623 0         0 my ($method, $arg) = @{$shortcuts{$OPTION}};
  0         0  
624 0         0 $CONFIG{$pkg}{template}{$method} = $arg;
625             }
626             else {
627 0         0 croak M48_usage_shortcuts($option);
628             }
629             }
630             }
631              
632             #==============================================================================
633             # Process the with command
634             #==============================================================================
635             sub handle_with {
636 2     2 0 3 my $pkg = shift;
637 2 50       5 croak M45_usage_with() unless @_;
638 2         4 for (@_) {
639 2 50       10 croak M02_usage() unless /^[\w:]+$/;
640 2         81 eval "require $_;";
641 2 50       7 croak M46_usage_with_bad($_) . $@ if $@;
642 2         3 push @{$CONFIG{$pkg}{template}{WITH}}, $_;
  2         13  
643             }
644             }
645              
646             #==============================================================================
647             # Perform cleanup duties
648             #==============================================================================
649             sub DESTROY {
650 19     19   1709 my $o = shift;
651 19 50       7778 $o->clean_build if $o->{CONFIG}{CLEAN_BUILD_AREA};
652             }
653              
654             #==============================================================================
655             # Get the source code
656             #==============================================================================
657             sub receive_code {
658 11     11 0 17 my $o = shift;
659 11         15 my $code = shift;
660              
661 11 50 33     55 croak M02_usage() unless (defined $code and $code);
662              
663 11 50 66     68 if (ref $code eq 'CODE') {
    50          
    100          
664 0         0 $o->{API}{code} = &$code;
665             }
666             elsif (ref $code eq 'ARRAY') {
667 0         0 $o->{API}{code} = join '', @$code;
668             }
669             elsif ($code =~ m|[/\\:]| and
670             $code =~ m|^[/\\:\w.\-\ \$\[\]<>]+$|) {
671 1 50       17 if (-f $code) {
672 1         5 local ($/, *CODE);
673 1 50       28 open CODE, "< $code" or croak M06_code_file_failed_open($code);
674 1         27 $o->{API}{code} = ;
675             }
676             else {
677 0         0 croak M07_code_file_does_not_exist($code);
678             }
679             }
680             else {
681 10         26 $o->{API}{code} = $code;
682             }
683             }
684              
685             #==============================================================================
686             # Get the source code from an Inline::Files filehandle
687             #==============================================================================
688             sub read_inline_file {
689 0     0 0 0 my $o = shift;
690 0         0 my ($lang, $pkg) = @{$o->{API}}{qw(language_id pkg)};
  0         0  
691 0         0 my $langfile = uc($lang);
692 0 0       0 croak M59_bad_inline_file($lang) unless $langfile =~ /^[A-Z]\w*$/;
693             croak M60_no_inline_files()
694 0 0 0     0 unless (defined $INC{File::Spec::Unix->catfile("Inline","Files.pm")} and
      0        
695             $Inline::Files::VERSION =~ /^\d\.\d\d$/ and
696             $Inline::Files::VERSION ge '0.51');
697 0 0       0 croak M61_not_parsed() unless $lang = Inline::Files::get_filename($pkg);
698             {
699 8     8   58 no strict 'refs';
  8         14  
  8         5431  
  0         0  
700 0         0 local $/;
701 0         0 $Inline::FILE = \*{"${pkg}::$langfile"};
  0         0  
702             # open $Inline::FILE;
703 0         0 $o->{API}{code} = <$Inline::FILE>;
704             # close $Inline::FILE;
705             }
706             }
707              
708             #==============================================================================
709             # Read the cached config file from the Inline directory. This will indicate
710             # whether the Language code is valid or not.
711             #==============================================================================
712             sub check_config_file {
713 16     16 0 23 my ($DIRECTORY, %config);
714 16         24 my $o = shift;
715              
716 16 50       34 croak M14_usage_Config() if $Inline::Config::VERSION;
717             croak M63_no_source($o->{API}{pkg})
718 16 50       52 if $o->{INLINE}{md5} eq $o->{API}{code};
719              
720             # First make sure we have the DIRECTORY
721 16 50       41 if ($o->{CONFIG}{_INSTALL_}) {
722             croak M15_usage_install_directory()
723 0 0       0 if $o->{CONFIG}{DIRECTORY};
724 0         0 my $cwd = Cwd::cwd();
725             $DIRECTORY =
726 0         0 $o->{INLINE}{DIRECTORY} = File::Spec->catdir($cwd, $did);
727 0 0       0 if (not -d $DIRECTORY) {
728 0 0       0 _mkdir($DIRECTORY, 0777)
729             or croak M16_DIRECTORY_mkdir_failed($DIRECTORY);
730             }
731             }
732             else {
733             $DIRECTORY = $o->{INLINE}{DIRECTORY} =
734 16   33     52 $o->{CONFIG}{DIRECTORY} || $o->find_temp_dir;
735             }
736              
737 16 100       36 if($o->{CONFIG}{REWRITE_CONFIG_FILE}) {
738 1 50       26 if(-e File::Spec->catfile($DIRECTORY, $configuration_file)) {
739 1         66 my $unlink = unlink(File::Spec->catfile($DIRECTORY, $configuration_file));
740 1 50       7 if(!$unlink) {warn "REWRITE_CONFIG_FILE is set, but removal of config file failed"}
  0         0  
741 1 50       12 else {warn "config file removal successful\n" if $o->{CONFIG}{_TESTING}}
742             }
743             }
744              
745             my $load_cfg = sub {
746 19 100   19   598 $o->create_config_file($DIRECTORY)
747             if not -e File::Spec->catfile($DIRECTORY, $configuration_file);
748              
749 19 50       1596 open CONFIG, "< ".File::Spec->catfile($DIRECTORY,$configuration_file)
750             or croak M17_config_open_failed($DIRECTORY);
751 19 50       678 flock(CONFIG, LOCK_EX) if $^O !~ /^VMS|riscos|VOS$/;
752 19         757 my $config = join '', ;
753 19 50       308 flock(CONFIG, LOCK_UN) if $^O !~ /^VMS|riscos|VOS$/;
754 19         184 close CONFIG;
755              
756 19 50       283 unless($config =~ /^version :/) {
757 0         0 warn "\$load_cfg sub: \$config: *${config}*\n";
758 0         0 croak M62_invalid_config_file(File::Spec->catfile($DIRECTORY,$configuration_file));
759             }
760              
761 19 50       199 if(UNTAINT) {
762             warn "In Inline::check_config_file(): Blindly untainting Inline configuration file information.\n"
763 0 0       0 unless $o->{CONFIG}{NO_UNTAINT_WARN};
764 0         0 ($config) = $config =~ /(.*)/s;
765             }
766              
767 19         459 %config = Inline::denter->new()->undent($config);
768 16         143 } ;
769              
770 16         35 $load_cfg->() ;
771 16 100       167 if (! defined $config{languages}->{$o->{API}{language_id}}){
772 3         260 my $unlink = unlink(File::Spec->catfile($DIRECTORY, $configuration_file));
773 3 50       22 if(!$unlink) {warn "Failed to remove config file"}
  0         0  
774 3 100       44 else {warn "config file removed\n" if $o->{CONFIG}{_TESTING}}
775 3         96 $load_cfg->() ;
776             }
777              
778 16         98 $Inline::languages = $config{languages};
779              
780             {
781 8     8   53 no warnings ('numeric'); # These warnings were a pain with devel releases.
  8         85  
  8         20854  
  16         65  
782             # If there's a problem with the version number, the
783             # error message will output $config{version} anyway.
784             croak M18_error_old_version($config{version}, $DIRECTORY)
785             unless (defined $config{version} and
786             $config{version} =~ /TRIAL/ or
787 16 50 33     253 $config{version} >= 0.40);
      33        
788             } # numeric warnings re-enabled.
789              
790             croak M19_usage_language($o->{API}{language_id}, $DIRECTORY)
791 16 100       133 unless defined $config{languages}->{$o->{API}{language_id}};
792 13         75 $o->{API}{language} = $config{languages}->{$o->{API}{language_id}};
793 13 100       63 if ($o->{API}{language} ne $o->{API}{language_id}) {
794 1 50       4 if (defined $o->{$o->{API}{language_id}}) {
795 0         0 $o->{$o->{API}{language}} = $o->{$o->{API}{language_id}};
796 0         0 delete $o->{$o->{API}{language_id}};
797             }
798             }
799              
800 13         105 $o->{INLINE}{ILSM_type} = $config{types}->{$o->{API}{language}};
801 13         53 $o->{INLINE}{ILSM_module} = $config{modules}->{$o->{API}{language}};
802 13         210 $o->{INLINE}{ILSM_suffix} = $config{suffixes}->{$o->{API}{language}};
803             }
804              
805             sub derive_minus_I {
806 10     10 0 19 my $o = shift;
807 10         76 require Cwd;
808             my @libexclude = (
809             # perl has these already
810             (grep length, map $Config{$_},
811             qw(archlibexp privlibexp sitearchexp sitelibexp vendorarchexp vendorlibexp)),
812             (defined $ENV{PERL5LIB} ? (
813 20         42 map { my $l = $_; ($l, map File::Spec->catdir($l, $Config{$_}), qw(version archname)) }
  20         304  
814             split $Config{path_sep}, $ENV{PERL5LIB}
815 10 50       873 ) : ()),
816             );
817 10 50       58 if ($^O eq 'MSWin32') {
818             # Strawberry Perl Unix-ises its @INC, so we need to add Unix-y versions
819             push @libexclude,
820 0         0 map { my $d = $_; $d =~ s#\\#/#g; $d }
  0         0  
  0         0  
  0         0  
821             @libexclude;
822             }
823 10         40 my %libexclude = map { $_=>1 } @libexclude;
  100         209  
824 10         36 my @libinclude = grep !$libexclude{$_}, grep { $_ ne '.' } @INC;
  108         274  
825             # grep is because on Windows, Cwd::abs_path blows up on non-exist dir
826 10         1095 @libinclude = map Cwd::abs_path($_), grep -e, @libinclude;
827 10         26 my %seen; @libinclude = grep !$seen{$_}++, @libinclude; # de-dup
  10         60  
828 10 50       25 @libinclude = map /(.*)/s, @libinclude if UNTAINT;
829 10         77 @libinclude;
830             }
831              
832             #==============================================================================
833             # Auto-detect installed Inline language support modules
834             #==============================================================================
835             sub create_config_file {
836 10     10 0 26 my ($o, $dir) = @_;
837              
838             # This subroutine actually fires off another instance of perl.
839             # with arguments that make this routine get called again.
840             # That way the queried modules don't stay loaded.
841 10 50       26 if (defined $o) {
842 10 50       21 ($dir) = $dir =~ /(.*)/s if UNTAINT;
843 10         544 my $perl = $Config{perlpath};
844 10 50       168 $perl = $^X unless -f $perl;
845 10 50       44 ($perl) = $perl =~ /(.*)/s if UNTAINT;
846 10 50       33 local $ENV{PERL5OPT} if defined $ENV{PERL5OPT};
847              
848 10         48 my @_inc = map "-I$_", $o->derive_minus_I;
849 10 50       492817 system $perl, @_inc, "-MInline=_CONFIG_", "-e1", "$dir"
850             and croak M20_config_creation_failed($dir);
851 10         720 return;
852             }
853              
854 0         0 my ($lib, $mod, $register, %checked,
855             %languages, %types, %modules, %suffixes);
856 0         0 for my $lib (@INC) {
857 0 0       0 next unless -d File::Spec->catdir($lib,"Inline");
858 0 0       0 opendir LIB, File::Spec->catdir($lib,"Inline")
859             or warn(M21_opendir_failed(File::Spec->catdir($lib,"Inline"))), next;
860 0         0 while ($mod = readdir(LIB)) {
861 0 0       0 next unless $mod =~ /\.pm$/;
862 0         0 $mod =~ s/\.pm$//;
863 0 0       0 next if ($checked{$mod}++);
864 0 0       0 if ($mod eq 'Config') { # Skip Inline::Config
865 0         0 warn M14_usage_Config();
866 0         0 next;
867             }
868 0 0       0 next if $mod =~ /^(MakeMaker|denter|messages)$/;
869             # @INC is made safe by -T disallowing PERL5LIB et al
870 0         0 ($mod) = $mod =~ /(.*)/;
871 0         0 eval "require Inline::$mod;";
872 0 0       0 warn($@), next if $@;
873 0         0 eval "\$register=&Inline::${mod}::register";
874 0 0       0 next if $@;
875             my $language = ($register->{language})
876 0 0       0 or warn(M22_usage_register($mod)), next;
877 0         0 for (@{$register->{aliases}}) {
  0         0  
878             warn(M23_usage_alias_used($mod, $_, $languages{$_})), next
879 0 0       0 if defined $languages{$_};
880 0         0 $languages{$_} = $language;
881             }
882 0         0 $languages{$language} = $language;
883 0         0 $types{$language} = $register->{type};
884 0         0 $modules{$language} = "Inline::$mod";
885 0         0 $suffixes{$language} = $register->{suffix};
886             }
887 0         0 closedir LIB;
888             }
889              
890 0         0 my $file = File::Spec->catfile($ARGV[0], $configuration_file);
891 0 0       0 open CONFIG, "> $file" or croak M24_open_for_output_failed($file);
892 0 0       0 flock(CONFIG, LOCK_EX) if $^O !~ /^VMS|riscos|VOS$/;
893 0         0 print CONFIG Inline::denter->new()
894             ->indent(*version => $Inline::VERSION,
895             *languages => \%languages,
896             *types => \%types,
897             *modules => \%modules,
898             *suffixes => \%suffixes,
899             );
900 0 0       0 flock(CONFIG, LOCK_UN) if $^O !~ /^VMS|riscos|VOS$/;
901 0         0 close CONFIG;
902 0         0 exit 0;
903             }
904              
905             #==============================================================================
906             # Check to see if code has already been compiled
907             #==============================================================================
908             sub check_module {
909 13     13 0 34 my ($module, $module2);
910 13         24 my $o = shift;
911 13 50       38 return $o->install if $o->{CONFIG}{_INSTALL_};
912              
913 13 50       62 if ($o->{CONFIG}{NAME}) {
    50          
914 0         0 $module = $o->{CONFIG}{NAME};
915             }
916             elsif ($o->{API}{pkg} eq 'main') {
917 13         43 $module = $o->{API}{script};
918 13         418 my($v,$d,$file) = File::Spec->splitpath($module);
919 13         36 $module = $file;
920 13         84 $module =~ s|\W|_|g;
921 13         32 $module =~ s|^_+||;
922 13         42 $module =~ s|_+$||;
923 13 50       60 $module = 'FOO' if $module =~ /^_*$/;
924 13 50       75 $module = "_$module" if $module =~ /^\d/;
925             }
926             else {
927 0         0 $module = $o->{API}{pkg};
928             }
929              
930 13         58 $o->{API}{suffix} = $o->{INLINE}{ILSM_suffix};
931 13         62 $o->{API}{directory} = $o->{INLINE}{DIRECTORY};
932              
933 13         31 my $auto_level = 2;
934 13         47 while ($auto_level <= 5) {
935 13 50       43 if ($o->{CONFIG}{AUTONAME}) {
936             $module2 =
937 13         65 $module . '_' . substr($o->{INLINE}{md5}, 0, 2 + $auto_level);
938 13         19 $auto_level++;
939             } else {
940 0         0 $module2 = $module;
941 0         0 $auto_level = 6; # Don't loop on non-autoname objects
942             }
943 13         47 $o->{API}{module} = $module2;
944 13         52 my @modparts = split /::/, $module2;
945 13         48 $o->{API}{modfname} = $modparts[-1];
946 13         116 $o->{API}{modpname} = File::Spec->catdir(@modparts);
947             $o->{API}{build_dir} =
948             File::Spec->catdir($o->{INLINE}{DIRECTORY},
949 13         105 'build',$o->{API}{modpname});
950             $o->{API}{install_lib} =
951 13         79 File::Spec->catdir($o->{INLINE}{DIRECTORY}, 'lib');
952              
953             my $inl = File::Spec->catfile($o->{API}{install_lib},"auto",
954 13         114 $o->{API}{modpname},"$o->{API}{modfname}.inl");
955             $o->{API}{location} =
956             File::Spec->catfile($o->{API}{install_lib},"auto",$o->{API}{modpname},
957 13         123 "$o->{API}{modfname}.$o->{INLINE}{ILSM_suffix}");
958 13 50       323 last unless -f $inl;
959 0         0 my %inl;
960 0         0 { local ($/, *INL);
  0         0  
961 0 0       0 open INL, $inl or croak M31_inline_open_failed($inl);
962 0         0 %inl = Inline::denter->new()->undent();
963             }
964 0 0       0 next unless ($o->{INLINE}{md5} eq $inl{md5});
965 0 0       0 next unless ($inl{inline_version} ge '0.40');
966 0 0       0 next unless ($inl{Config}{version} eq $Config::Config{version});
967 0 0       0 next unless ($inl{Config}{archname} eq $Config::Config{archname});
968 0 0       0 unless (-f $o->{API}{location}) {
969 0 0       0 warn <
970             Missing object file: $o->{API}{location}
971             For Inline file: $inl
972             END
973 0         0 next;
974             }
975 0 0       0 $o->{INLINE}{object_ready} = 1 unless $o->{CONFIG}{FORCE_BUILD};
976 0         0 last;
977             }
978 13         92 unshift @::INC, $o->{API}{install_lib};
979             }
980              
981             #==============================================================================
982             # Set things up so that the extension gets installed into the blib/arch.
983             # Then 'make install' will do the right thing.
984             #==============================================================================
985             sub install {
986 0     0 0 0 my ($module, $DIRECTORY);
987 0         0 my $o = shift;
988              
989             croak M64_install_not_c($o->{API}{language_id})
990 0 0       0 unless uc($o->{API}{language_id}) =~ /^(C|CPP|Java|Python|Ruby|Lisp|Pdlpp)$/ ;
991             croak M36_usage_install_main()
992 0 0       0 if ($o->{API}{pkg} eq 'main');
993             croak M37_usage_install_auto()
994 0 0       0 if $o->{CONFIG}{AUTONAME};
995             croak M38_usage_install_name()
996 0 0       0 unless $o->{CONFIG}{NAME};
997             croak M39_usage_install_version()
998 0 0       0 unless $o->{CONFIG}{VERSION};
999             croak M40_usage_install_badname($o->{CONFIG}{NAME}, $o->{API}{pkg})
1000 0 0       0 unless $o->{CONFIG}{NAME} eq $o->{API}{pkg};
1001             # $o->{CONFIG}{NAME} =~ /^$o->{API}{pkg}::\w(\w|::)+$/
1002             # );
1003              
1004             my ($mod_name, $mod_ver, $ext_name, $ext_ver) =
1005 0         0 ($o->{API}{pkg}, $ARGV[0], @{$o->{CONFIG}}{qw(NAME VERSION)});
  0         0  
1006 0 0       0 croak M41_usage_install_version_mismatch($mod_name, $mod_ver,
1007             $ext_name, $ext_ver)
1008             unless ($mod_ver eq $ext_ver);
1009 0         0 $o->{INLINE}{INST_ARCHLIB} = $ARGV[1];
1010              
1011 0         0 $o->{API}{version} = $o->{CONFIG}{VERSION};
1012 0         0 $o->{API}{module} = $o->{CONFIG}{NAME};
1013 0         0 my @modparts = split(/::/,$o->{API}{module});
1014 0         0 $o->{API}{modfname} = $modparts[-1];
1015 0         0 $o->{API}{modpname} = File::Spec->catdir(@modparts);
1016 0         0 $o->{API}{modinlname} = join('-',@modparts).'.inl';
1017 0         0 $o->{API}{suffix} = $o->{INLINE}{ILSM_suffix};
1018             $o->{API}{build_dir} = File::Spec->catdir($o->{INLINE}{DIRECTORY},'build',
1019 0         0 $o->{API}{modpname});
1020 0         0 $o->{API}{directory} = $o->{INLINE}{DIRECTORY};
1021 0         0 my $cwd = Cwd::cwd();
1022             $o->{API}{install_lib} =
1023 0         0 File::Spec->catdir($cwd,$o->{INLINE}{INST_ARCHLIB});
1024             $o->{API}{location} =
1025             File::Spec->catfile($o->{API}{install_lib},"auto",$o->{API}{modpname},
1026 0         0 "$o->{API}{modfname}.$o->{INLINE}{ILSM_suffix}");
1027 0         0 unshift @::INC, $o->{API}{install_lib};
1028 0         0 $o->{INLINE}{object_ready} = 0;
1029             }
1030              
1031             #==============================================================================
1032             # Create the .inl file for an object
1033             #==============================================================================
1034             sub write_inl_file {
1035 13     13 0 57 my $o = shift;
1036             my $inl =
1037             File::Spec->catfile($o->{API}{install_lib},"auto",$o->{API}{modpname},
1038 13         170 "$o->{API}{modfname}.inl");
1039 13 50       624 open INL, "> $inl"
1040             or croak "Can't create Inline validation file $inl: $!";
1041 13   33     1540 my $apiversion = $Config{apiversion} || $Config{xs_apiversion};
1042             print INL Inline::denter->new()
1043             ->indent(*md5, $o->{INLINE}{md5},
1044             *name, $o->{API}{module},
1045             *version, $o->{CONFIG}{VERSION},
1046             *language, $o->{API}{language},
1047             *language_id, $o->{API}{language_id},
1048             *installed, $o->{CONFIG}{_INSTALL_},
1049             *date_compiled, scalar localtime,
1050             *inline_version, $Inline::VERSION,
1051 39         214 *ILSM, { map {($_, $o->{INLINE}{"ILSM_$_"})}
1052             (qw( module suffix type ))
1053             },
1054 13         141 *Config, { (map {($_,$Config{$_})}
  104         1165  
1055             (qw( archname osname osvers
1056             cc ccflags ld so version
1057             ))),
1058             (apiversion => $apiversion),
1059             },
1060             );
1061 13         426 close INL;
1062             }
1063              
1064             #==============================================================================
1065             # Get config hints
1066             #==============================================================================
1067             sub with_configs {
1068 13     13 0 30 my $o = shift;
1069 13         21 my @configs;
1070 13         30 for my $mod (@{$o->{CONFIG}{WITH}}) {
  13         79  
1071 1         2 my $ref = eval { $mod->Inline($o->{API}{language}); };
  1         4  
1072 1 50       7 croak M25_no_WITH_support($mod, $@) if $@;
1073 1 50       3 croak M65_WITH_not_lang($mod, $o->{API}{language}) unless $ref;
1074 1         4 push @configs, %$ref;
1075             }
1076 13         36 return @configs;
1077             }
1078              
1079             #==============================================================================
1080             # Blindly untaint tainted fields in %ENV.
1081             #==============================================================================
1082             sub env_untaint {
1083 0     0 0 0 my $o = shift;
1084 0 0       0 warn "In Inline::env_untaint() : Blindly untainting tainted fields in %ENV.\n" unless $o->{CONFIG}{NO_UNTAINT_WARN};
1085              
1086             {
1087 8     8   56 no warnings ('uninitialized'); # In case $ENV{$_} is set to undef.
  8         14  
  8         4047  
  0         0  
1088 0         0 for (keys %ENV) {
1089 0         0 ($ENV{$_}) = $ENV{$_} =~ /(.*)/;
1090             }
1091             }
1092              
1093             # only accept dirs that are absolute and not world-writable
1094             $ENV{PATH} = $^O eq 'MSWin32' ?
1095 0 0       0 join ';', grep {not /^\./ and -d $_
1096             } split /;/, $ENV{PATH}
1097             :
1098 0 0 0     0 join ':', grep {/^\// and -d $_ and $< == $> ? 1 : not (-W $_ or -O $_)
    0 0        
1099 0 0       0 } split /:/, $ENV{PATH};
1100              
1101 0         0 map {($_) = /(.*)/} @INC;
  0         0  
1102              
1103             # list cherry-picked from `perldoc perlrun`
1104 0         0 delete @ENV{qw(PERL5OPT PERL5SHELL PERL_ROOT IFS CDPATH ENV BASH_ENV)};
1105 0 0       0 $ENV{SHELL} = '/bin/sh' if -x '/bin/sh';
1106              
1107 0 0       0 $< = $> if $< != $>; # so child processes retain euid - ignore failure
1108             }
1109             #==============================================================================
1110             # Blindly untaint tainted fields in Inline object.
1111             #==============================================================================
1112             sub obj_untaint {
1113 0     0 0 0 my $o = shift;
1114 0 0       0 warn "In Inline::obj_untaint() : Blindly untainting tainted fields in Inline object.\n" unless $o->{CONFIG}{NO_UNTAINT_WARN};
1115 0         0 ($o->{INLINE}{ILSM_module}) = $o->{INLINE}{ILSM_module} =~ /(.*)/;
1116 0         0 ($o->{API}{directory}) = $o->{API}{directory} =~ /(.*)/;
1117 0         0 ($o->{API}{build_dir}) = $o->{API}{build_dir} =~ /(.*)/;
1118 0         0 ($o->{CONFIG}{DIRECTORY}) = $o->{CONFIG}{DIRECTORY} =~ /(.*)/;
1119 0         0 ($o->{API}{install_lib}) = $o->{API}{install_lib} =~ /(.*)/;
1120 0         0 ($o->{API}{modpname}) = $o->{API}{modpname} =~ /(.*)/;
1121 0         0 ($o->{API}{modfname}) = $o->{API}{modfname} =~ /(.*)/;
1122 0         0 ($o->{API}{language}) = $o->{API}{language} =~ /(.*)/;
1123 0         0 ($o->{API}{pkg}) = $o->{API}{pkg} =~ /(.*)/;
1124 0         0 ($o->{API}{module}) = $o->{API}{module} =~ /(.*)/;
1125             }
1126              
1127             #==============================================================================
1128             # Clean the build directory from previous builds
1129             #==============================================================================
1130             sub clean_build {
1131 8     8   60 use strict;
  8         74  
  8         2043  
1132 0     0 0 0 my ($prefix, $dir);
1133 0         0 my $o = shift;
1134              
1135 0         0 $prefix = $o->{INLINE}{DIRECTORY};
1136 0 0       0 opendir(BUILD, $prefix)
1137             or croak "Can't open build directory: $prefix for cleanup $!\n";
1138              
1139 0         0 while ($dir = readdir(BUILD)) {
1140 0         0 my $maybedir = File::Spec->catdir($prefix,$dir);
1141 0 0 0     0 if (($maybedir and -d $maybedir) and ($dir =~ /\w{36,}/)) {
      0        
1142 0         0 $o->rmpath($prefix,$dir);
1143             }
1144             }
1145              
1146 0         0 close BUILD;
1147             }
1148              
1149             #==============================================================================
1150             # Apply a list of filters to the source code
1151             #==============================================================================
1152             sub filter {
1153 0     0 0 0 my $o = shift;
1154 0         0 my $new_code = $o->{API}{code};
1155 0         0 for (@_) {
1156 0 0       0 croak M52_invalid_filter($_) unless ref;
1157 0 0       0 if (ref eq 'CODE') {
1158 0         0 $new_code = $_->($new_code);
1159             }
1160             else {
1161 0         0 $new_code = $_->filter($o, $new_code);
1162             }
1163             }
1164 0         0 return $new_code;
1165             }
1166              
1167             #==============================================================================
1168             # User wants to report a bug
1169             #==============================================================================
1170             sub reportbug {
1171 8     8   57 use strict;
  8         14  
  8         794  
1172 0     0 1 0 my $o = shift;
1173 0 0       0 return if $o->{INLINE}{reportbug_handled}++;
1174 0         0 print STDERR <
1175             <-----------------------REPORTBUG Section------------------------------------->
1176              
1177             REPORTBUG mode in effect.
1178              
1179             Your Inline $o->{API}{language_id} code will be processed in the build directory:
1180              
1181             $o->{API}{build_dir}
1182              
1183             A perl-readable bug report including your perl configuration and run-time
1184             diagnostics will also be generated in the build directory.
1185              
1186             When the program finishes please bundle up the above build directory with:
1187              
1188             tar czf Inline.REPORTBUG.tar.gz $o->{API}{build_dir}
1189              
1190             and send "Inline.REPORTBUG.tar.gz" as an email attachment to the author
1191             of the offending Inline::* module with the subject line:
1192              
1193             REPORTBUG: Inline.pm
1194              
1195             Include in the email, a description of the problem and anything else that
1196             you think might be helpful. Patches are welcome! :-\)
1197              
1198             <-----------------------End of REPORTBUG Section------------------------------>
1199             END
1200 0         0 my %versions;
1201             {
1202 8     8   48 no strict 'refs';
  8         10  
  8         1601  
  0         0  
1203 0         0 %versions = map {eval "use $_();"; ($_, $ {$_ . '::VERSION'})}
  0         0  
  0         0  
  0         0  
1204             qw (Digest::MD5 Parse::RecDescent
1205             ExtUtils::MakeMaker File::Path FindBin
1206             Inline
1207             );
1208             }
1209              
1210 0         0 $o->mkpath($o->{API}{build_dir});
1211             open REPORTBUG, "> ".File::Spec->catfile($o->{API}{build_dir},"REPORTBUG")
1212             or croak M24_open_for_output_failed
1213 0 0       0 (File::Spec->catfile($o->{API}{build_dir},"REPORTBUG"));
1214 0         0 %Inline::REPORTBUG_Inline_Object = ();
1215 0         0 %Inline::REPORTBUG_Perl_Config = ();
1216 0         0 %Inline::REPORTBUG_Module_Versions = ();
1217 0         0 print REPORTBUG Inline::denter->new()
1218             ->indent(*REPORTBUG_Inline_Object, $o,
1219             *REPORTBUG_Perl_Config, \%Config::Config,
1220             *REPORTBUG_Module_Versions, \%versions,
1221             );
1222 0         0 close REPORTBUG;
1223             }
1224              
1225             #==============================================================================
1226             # Print a small report if PRINT_INFO option is set.
1227             #==============================================================================
1228             sub print_info {
1229 8     8   47 use strict;
  8         19  
  8         2047  
1230 0     0 1 0 my $o = shift;
1231              
1232 0         0 print STDERR <
1233             <-----------------------Information Section----------------------------------->
1234              
1235             Information about the processing of your Inline $o->{API}{language_id} code:
1236              
1237             END
1238              
1239 0 0       0 print STDERR <{INLINE}{object_ready});
1240             Your module is already compiled. It is located at:
1241             $o->{API}{location}
1242              
1243             END
1244              
1245 0 0 0     0 print STDERR <{INLINE}{object_ready} and $o->{CONFIG}{FORCE_BUILD});
1246             But the FORCE_BUILD option is set, so your code will be recompiled.
1247             I\'ll use this build directory:
1248             $o->{API}{build_dir}
1249              
1250             and I\'ll install the executable as:
1251             $o->{API}{location}
1252              
1253             END
1254 0 0       0 print STDERR <{INLINE}{object_ready});
1255             Your source code needs to be compiled. I\'ll use this build directory:
1256             $o->{API}{build_dir}
1257              
1258             and I\'ll install the executable as:
1259             $o->{API}{location}
1260              
1261             END
1262              
1263 0         0 eval {
1264 0         0 print STDERR $o->info;
1265             };
1266 0 0       0 print $@ if $@;
1267              
1268 0         0 print STDERR <
1269              
1270             <-----------------------End of Information Section---------------------------->
1271             END
1272             }
1273              
1274             #==============================================================================
1275             # Hand off this invocation to Inline::MakeMaker
1276             #==============================================================================
1277             sub maker_utils {
1278 0     0 0 0 require Inline::MakeMaker;
1279 0         0 goto &Inline::MakeMaker::utils;
1280             }
1281              
1282             #==============================================================================
1283             # Utility subroutines
1284             #==============================================================================
1285              
1286             #==============================================================================
1287             # Make a path
1288             #==============================================================================
1289             sub mkpath {
1290 8     8   49 use strict;
  8         11  
  8         1108  
1291 13     13 0 45 my ($o, $mkpath) = @_;
1292 13         85 my($volume,$dirs,$nofile) = File::Spec->splitpath($mkpath,1);
1293 13         253 my @parts = File::Spec->splitdir($dirs);
1294 13         19 my @done;
1295 13         32 foreach (@parts){
1296 117         299 push(@done,$_);
1297 117         859 my $path = File::Spec->catpath($volume,File::Spec->catdir(@done),"");
1298 117 100       1341 -d $path || _mkdir($path, 0777);
1299             }
1300 13 50       235 croak M53_mkdir_failed($mkpath)
1301             unless -d $mkpath;
1302             }
1303              
1304             #==============================================================================
1305             # Nuke a path (nicely)
1306             #==============================================================================
1307             sub rmpath {
1308 8     8   54 use strict;
  8         10  
  8         23331  
1309 0     0 0 0 my ($o, $prefix, $rmpath) = @_;
1310             # Nuke the target directory
1311 0 0       0 _rmtree(File::Spec->catdir($prefix ? ($prefix,$rmpath) : ($rmpath)));
1312             # Remove any empty directories underneath the requested one
1313 0         0 my @parts = File::Spec->splitdir($rmpath);
1314 0         0 while (@parts){
1315 0 0       0 $rmpath = File::Spec->catdir($prefix ? ($prefix,@parts) : @parts);
1316 0 0       0 ($rmpath) = $rmpath =~ /(.*)/ if UNTAINT;
1317 0 0       0 rmdir $rmpath
1318             or last; # rmdir failed because dir was not empty
1319 0         0 pop @parts;
1320             }
1321             }
1322              
1323             sub _rmtree {
1324 0     0   0 my($roots) = @_;
1325 0 0       0 $roots = [$roots] unless ref $roots;
1326 0         0 my($root);
1327 0         0 foreach $root (@{$roots}) {
  0         0  
1328 0 0       0 if ( -d $root ) {
1329 0         0 my(@names,@paths);
1330 0 0       0 if (opendir MYDIR, $root) {
1331 0         0 @names = readdir MYDIR;
1332 0         0 closedir MYDIR;
1333             }
1334             else {
1335 0         0 croak M21_opendir_failed($root);
1336             }
1337              
1338 0         0 my $dot = File::Spec->curdir();
1339 0         0 my $dotdot = File::Spec->updir();
1340 0         0 foreach my $name (@names) {
1341 0 0 0     0 next if $name eq $dot or $name eq $dotdot;
1342 0         0 my $maybefile = File::Spec->catfile($root,$name);
1343 0 0 0     0 push(@paths,$maybefile),next if $maybefile and -f $maybefile;
1344 0         0 push(@paths,File::Spec->catdir($root,$name));
1345             }
1346              
1347 0         0 _rmtree(\@paths);
1348 0 0       0 ($root) = $root =~ /(.*)/ if UNTAINT;
1349 0 0       0 rmdir($root) or croak M54_rmdir_failed($root);
1350             }
1351             else {
1352 0 0       0 ($root) = $root =~ /(.*)/ if UNTAINT;
1353 0 0       0 unlink($root) or croak M55_unlink_failed($root);
1354             }
1355             }
1356             }
1357              
1358             #==============================================================================
1359             # Find the 'Inline' directory to use.
1360             #==============================================================================
1361             my $TEMP_DIR;
1362             sub find_temp_dir {
1363 0 0   0 0 0 return $TEMP_DIR if $TEMP_DIR;
1364              
1365 0         0 my ($temp_dir, $home, $bin, $cwd, $env);
1366 0         0 $temp_dir = '';
1367 0   0     0 $env = $ENV{PERL_INLINE_DIRECTORY} || '';
1368 0 0       0 $home = $ENV{HOME} ? abs_path($ENV{HOME}) : '';
1369              
1370 0 0 0     0 if ($env and
    0 0        
      0        
      0        
      0        
1371             -d $env and
1372             -w $env) {
1373 0         0 $temp_dir = $env;
1374             }
1375             elsif ($cwd = abs_path('.') and
1376             $cwd ne $home and
1377             -d File::Spec->catdir($cwd,".Inline") and
1378             -w File::Spec->catdir($cwd,".Inline")) {
1379 0         0 $temp_dir = File::Spec->catdir($cwd,".Inline");
1380             }
1381             else {
1382 0         0 require FindBin ;
1383 0 0 0     0 if ($bin = $FindBin::Bin and
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
1384             -d File::Spec->catdir($bin,".Inline") and
1385             -w File::Spec->catdir($bin,".Inline")) {
1386 0         0 $temp_dir = File::Spec->catdir($bin,".Inline");
1387             }
1388             elsif ($home and
1389             -d File::Spec->catdir($home,".Inline") and
1390             -w File::Spec->catdir($home,".Inline")) {
1391 0         0 $temp_dir = File::Spec->catdir($home,".Inline");
1392             }
1393             elsif (defined $cwd and $cwd and
1394             -d File::Spec->catdir($cwd, $did) and
1395             -w File::Spec->catdir($cwd, $did)) {
1396 0         0 $temp_dir = File::Spec->catdir($cwd, $did);
1397             }
1398             elsif (defined $bin and $bin and
1399             -d File::Spec->catdir($bin, $did) and
1400             -w File::Spec->catdir($bin, $did)) {
1401 0         0 $temp_dir = File::Spec->catdir($bin, $did);
1402             }
1403             elsif (defined $cwd and $cwd and
1404             -d $cwd and
1405             -w $cwd and
1406             _mkdir(File::Spec->catdir($cwd, $did), 0777)) {
1407 0         0 $temp_dir = File::Spec->catdir($cwd, $did);
1408             }
1409             elsif (defined $bin and $bin and
1410             -d $bin and
1411             -w $bin and
1412             _mkdir(File::Spec->catdir($bin, $did), 0777)) {
1413 0         0 $temp_dir = File::Spec->catdir($bin, $did);
1414             }
1415             }
1416              
1417 0 0       0 croak M56_no_DIRECTORY_found()
1418             unless $temp_dir;
1419 0         0 return $TEMP_DIR = abs_path($temp_dir);
1420             }
1421              
1422             sub _mkdir {
1423 23     23   50 my $dir = shift;
1424 23   50     53 my $mode = shift || 0777;
1425 23 50       57 ($dir) = ($dir =~ /(.*)/) if UNTAINT;
1426 23         104 $dir =~ s|[/\\:]$||;
1427 23         2222 return mkdir($dir, $mode);
1428             }
1429              
1430             #==============================================================================
1431             # Error messages
1432             #==============================================================================
1433              
1434             sub M01_usage_use {
1435 0     0 0 0 my ($module) = @_;
1436 0         0 return <
1437             It is invalid to use '$module' directly. Please consult the Inline
1438             documentation for more information.
1439              
1440             END
1441             }
1442              
1443             sub M02_usage {
1444 0     0 0 0 my $usage = <
1445             Invalid usage of Inline module. Valid usages are:
1446             use Inline;
1447             use Inline language => "source-string", config-pair-list;
1448             use Inline language => "source-file", config-pair-list;
1449             use Inline language => [source-line-list], config-pair-list;
1450             use Inline language => 'DATA', config-pair-list;
1451             use Inline language => 'Config', config-pair-list;
1452             use Inline Config => config-pair-list;
1453             use Inline with => module-list;
1454             use Inline shortcut-list;
1455             END
1456             # This is broken ????????????????????????????????????????????????????
1457 0 0       0 $usage .= <
1458              
1459             Supported languages:
1460 0         0 ${\ join(', ', sort keys %$Inline::languages)}
1461              
1462             END
1463 0         0 return $usage;
1464             }
1465              
1466             sub M03_usage_bind {
1467 0     0 0 0 my $usage = <
1468             Invalid usage of the Inline->bind() function. Valid usages are:
1469             Inline->bind(language => "source-string", config-pair-list);
1470             Inline->bind(language => "source-file", config-pair-list);
1471             Inline->bind(language => [source-line-list], config-pair-list);
1472             END
1473              
1474 0 0       0 $usage .= <
1475              
1476             Supported languages:
1477 0         0 ${\ join(', ', sort keys %$Inline::languages)}
1478              
1479             END
1480 0         0 return $usage;
1481             }
1482              
1483             sub M04_error_nocode {
1484 0     0 0 0 my ($language) = @_;
1485 0         0 return <
1486             No $language source code found for Inline.
1487              
1488             END
1489             }
1490              
1491             sub M05_error_eval {
1492 0     0 0 0 my ($subroutine, $msg) = @_;
1493 0         0 return <
1494             An eval() failed in Inline::$subroutine:
1495             $msg
1496              
1497             END
1498             }
1499              
1500             sub M06_code_file_failed_open {
1501 0     0 0 0 my ($file) = @_;
1502 0         0 return <
1503             Couldn't open Inline code file '$file':
1504             $!
1505              
1506             END
1507             #'
1508             }
1509              
1510             sub M07_code_file_does_not_exist {
1511 0     0 0 0 my ($file) = @_;
1512 0         0 return <
1513             Inline assumes '$file' is a filename,
1514             and that file does not exist.
1515              
1516             END
1517             }
1518              
1519             sub M08_no_DATA_source_code {
1520 0     0 0 0 my ($lang) = @_;
1521 0         0 return <
1522             No source code in DATA section for Inline '$lang' section.
1523              
1524             END
1525             }
1526              
1527             sub M09_marker_mismatch {
1528 0     0 0 0 my ($marker, $lang) = @_;
1529 0         0 return <
1530             Marker '$marker' does not match Inline '$lang' section.
1531              
1532             END
1533             }
1534              
1535             sub M10_usage_WITH_USING {
1536 0     0 0 0 return <
1537             Config option WITH or USING must be a module name or an array ref
1538             of module names.
1539              
1540             END
1541             }
1542              
1543             sub M11_usage_DIRECTORY {
1544 0     0 0 0 my ($value) = @_;
1545 0         0 return <
1546             Invalid value '$value' for config option DIRECTORY
1547              
1548             END
1549             }
1550              
1551             sub M12_usage_NAME {
1552 0     0 0 0 my ($name) = @_;
1553 0         0 return <
1554             Invalid value for NAME config option: '$name'
1555              
1556             END
1557             }
1558              
1559             sub M13_usage_VERSION {
1560 0     0 0 0 my ($version) = @_;
1561 0         0 return <
1562             Invalid (according to version.pm) VERSION config option: '$version'
1563             (Should also be specified as a string rather than a floating point number)
1564              
1565             END
1566             }
1567              
1568             sub M14_usage_Config {
1569 0     0 0 0 return <
1570             As of Inline v0.30, use of the Inline::Config module is no longer supported
1571             or allowed. If Inline::Config exists on your system, it can be removed. See
1572             the Inline documentation for information on how to configure Inline.
1573              
1574             END
1575             }
1576              
1577             sub M15_usage_install_directory {
1578 0     0 0 0 return <
1579             Can't use the DIRECTORY option when installing an Inline extension module.
1580              
1581             END
1582             #'
1583             }
1584              
1585             sub M16_DIRECTORY_mkdir_failed {
1586 0     0 0 0 my ($dir) = @_;
1587 0         0 return <
1588             Can't mkdir $dir to build Inline code.
1589              
1590             END
1591             #'
1592             }
1593              
1594             sub M17_config_open_failed {
1595 0     0 0 0 my ($dir) = @_;
1596 0         0 my $file = File::Spec->catfile(${dir}, $configuration_file);
1597 0         0 return <
1598             Can't open ${file} for input.
1599              
1600             END
1601             #'
1602             }
1603              
1604             sub M18_error_old_version {
1605 0     0 0 0 my ($old_version, $directory) = @_;
1606 0   0     0 $old_version ||= '???';
1607 0         0 return <
1608             You are using Inline version $Inline::VERSION with a directory that was
1609             configured by Inline version $old_version. This version is no longer supported.
1610             Please delete the following directory and try again:
1611              
1612             $directory
1613              
1614             END
1615             }
1616              
1617             sub M19_usage_language {
1618 3     3 0 35 my ($language, $directory) = @_;
1619 3         62 require Config;
1620 3         32 return <
1621             Error. You have specified '$language' as an Inline programming language.
1622              
1623             I currently only know about the following languages:
1624 3 50       704 ${ defined $Inline::languages ?
1625             \ join(', ', sort keys %$Inline::languages) : \ ''
1626             }
1627              
1628             If you have installed a support module for this language, try deleting the
1629             config-${Config::Config{'archname'}}-$] file from the following Inline DIRECTORY, and run again:
1630              
1631             $directory
1632              
1633             (And if that works, please file a bug report.)
1634              
1635             END
1636             }
1637              
1638             sub M20_config_creation_failed {
1639 0     0 0 0 my ($dir) = @_;
1640 0         0 my $file = File::Spec->catfile(${dir}, $configuration_file);
1641 0         0 return <
1642             Failed to autogenerate ${file}.
1643              
1644             END
1645             }
1646              
1647             sub M21_opendir_failed {
1648 0     0 0 0 my ($dir) = @_;
1649 0         0 return <
1650             Can't open directory '$dir'.
1651              
1652             END
1653             #'
1654             }
1655              
1656             sub M22_usage_register {
1657 0     0 0 0 my ($language, $error) = @_;
1658 0         0 return <
1659             The module Inline::$language does not support the Inline API, because it does
1660             properly support the register() method. This module will not work with Inline
1661             and should be uninstalled from your system. Please advise your sysadmin.
1662              
1663             The following error was generating from this module:
1664             $error
1665              
1666             END
1667             }
1668              
1669             sub M23_usage_alias_used {
1670 0     0 0 0 my ($new_mod, $alias, $old_mod) = @_;
1671 0         0 return <
1672             The module Inline::$new_mod is attempting to define $alias as an alias.
1673             But $alias is also an alias for Inline::$old_mod.
1674              
1675             One of these modules needs to be corrected or removed.
1676             Please notify the system administrator.
1677              
1678             END
1679             }
1680              
1681             sub M24_open_for_output_failed {
1682 0     0 0 0 my ($file) = @_;
1683 0         0 return <
1684             Can't open $file for output.
1685             $!
1686              
1687             END
1688             #'
1689             }
1690              
1691             sub M25_no_WITH_support {
1692 0     0 0 0 my ($mod, $err) = @_;
1693 0         0 return <
1694             You have requested "use Inline with => '$mod'"
1695             but '$mod' does not work with Inline.
1696              
1697             $err
1698              
1699             END
1700             }
1701              
1702             sub M26_error_version_without_name {
1703 0     0 0 0 return <
1704             Specifying VERSION option without NAME option is not permitted.
1705              
1706             END
1707             }
1708              
1709             sub M27_module_not_indexed {
1710 0     0 0 0 my ($mod) = @_;
1711 0         0 return <
1712             You are attempting to load an extension for '$mod',
1713             but there is no entry for that module in %INC.
1714              
1715             END
1716             }
1717              
1718             sub M28_error_grokking_path {
1719 0     0 0 0 my ($path) = @_;
1720 0         0 return <
1721             Can't calculate a path from '$path' in %INC
1722              
1723             END
1724             }
1725              
1726             sub M29_error_relative_path {
1727 0     0 0 0 my ($name, $path) = @_;
1728 0         0 return <
1729             Can't load installed extension '$name'
1730             from relative path '$path'.
1731              
1732             END
1733             #'
1734             }
1735              
1736             sub M30_error_no_obj {
1737 0     0 0 0 my ($name, $pkg, $path) = @_;
1738 0         0 <
1739             The extension '$name' is not properly installed in path:
1740             '$path'
1741              
1742             If this is a CPAN/distributed module, you may need to reinstall it on your
1743             system.
1744              
1745             To allow Inline to compile the module in a temporary cache, simply remove the
1746             Inline config option 'VERSION=' from the $pkg module.
1747              
1748             END
1749             }
1750              
1751             sub M31_inline_open_failed {
1752 0     0 0 0 my ($file) = @_;
1753 0         0 return <
1754             Can't open Inline validate file:
1755              
1756             $file
1757              
1758             $!
1759              
1760             END
1761             #'
1762             }
1763              
1764             sub M32_error_md5_validation {
1765 0     0 0 0 my ($md5, $inl) = @_;
1766 0         0 return <
1767             The source code fingerprint:
1768              
1769             $md5
1770              
1771             does not match the one in:
1772              
1773             $inl
1774              
1775             This module needs to be reinstalled.
1776              
1777             END
1778             }
1779              
1780             sub M33_error_old_inline_version {
1781 0     0 0 0 my ($inl) = @_;
1782 0         0 return <
1783             The following extension is not compatible with this version of Inline.pm.
1784              
1785             $inl
1786              
1787             You need to reinstall this extension.
1788              
1789             END
1790             }
1791              
1792             sub M34_error_incorrect_version {
1793 0     0 0 0 my ($inl) = @_;
1794 0         0 return <
1795             The version of your extension does not match the one indicated by your
1796             Inline source code, according to:
1797              
1798             $inl
1799              
1800             This module should be reinstalled.
1801              
1802             END
1803             }
1804              
1805             sub M35_error_no_object_file {
1806 0     0 0 0 my ($obj, $inl) = @_;
1807 0         0 return <
1808             There is no object file:
1809             $obj
1810              
1811             For Inline validation file:
1812             $inl
1813              
1814             This module should be reinstalled.
1815              
1816             END
1817             }
1818              
1819             sub M36_usage_install_main {
1820 0     0 0 0 return <
1821             Can't install an Inline extension module from package 'main'.
1822              
1823             END
1824             #'
1825             }
1826              
1827             sub M37_usage_install_auto {
1828 0     0 0 0 return <
1829             Can't install an Inline extension module with AUTONAME enabled.
1830              
1831             END
1832             #'
1833             }
1834              
1835             sub M38_usage_install_name {
1836 0     0 0 0 return <
1837             An Inline extension module requires an explicit NAME.
1838              
1839             END
1840             }
1841              
1842             sub M39_usage_install_version {
1843 0     0 0 0 return <
1844             An Inline extension module requires an explicit VERSION.
1845              
1846             END
1847             }
1848              
1849             sub M40_usage_install_badname {
1850 0     0 0 0 my ($name, $pkg) = @_;
1851 0         0 return <
1852             The NAME '$name' is illegal for this Inline extension.
1853             The NAME must match the current package name:
1854             $pkg
1855              
1856             END
1857             }
1858              
1859             sub M41_usage_install_version_mismatch {
1860 0     0 0 0 my ($mod_name, $mod_ver, $ext_name, $ext_ver) = @_;
1861 0         0 <
1862             The version '$mod_ver' for module '$mod_name' doe not match
1863             the version '$ext_ver' for Inline section '$ext_name'.
1864              
1865             END
1866             }
1867              
1868             sub M42_usage_loader {
1869 0     0 0 0 return <
1870             ERROR. The loader that was invoked is for compiled languages only.
1871              
1872             END
1873             }
1874              
1875             sub M43_error_bootstrap {
1876 0     0 0 0 my ($mod, $err) = @_;
1877 0         0 return <
1878             Had problems bootstrapping Inline module '$mod'
1879              
1880             $err
1881              
1882             END
1883             }
1884              
1885             sub M45_usage_with {
1886 0     0 0 0 return <
1887             Syntax error detected using 'use Inline with ...'.
1888             Should be specified as:
1889              
1890             use Inline with => 'module1', 'module2', ..., 'moduleN';
1891              
1892             END
1893             }
1894              
1895             sub M46_usage_with_bad {
1896 0     0 0 0 my $mod = shift;
1897 0         0 return <
1898             Syntax error detected using 'use Inline with => "$mod";'.
1899             '$mod' could not be found.
1900              
1901             END
1902             }
1903              
1904             sub M47_invalid_config_option {
1905 0     0 0 0 my ($option) = @_;
1906 0         0 return <
1907             Invalid Config option '$option'
1908              
1909             END
1910             #'
1911             }
1912              
1913             sub M48_usage_shortcuts {
1914 0     0 0 0 my ($shortcut) = @_;
1915 0         0 return <
1916             Invalid shortcut '$shortcut' specified.
1917              
1918             Valid shortcuts are:
1919             VERSION, INFO, FORCE, NOCLEAN, CLEAN, UNTAINT, SAFE, UNSAFE,
1920             GLOBAL, NOISY and REPORTBUG
1921              
1922             END
1923             }
1924              
1925             sub M49_usage_unsafe {
1926 0     0 0 0 my ($terminate) = @_;
1927             return <
1928             You are using the Inline.pm module with the UNTAINT and SAFEMODE options,
1929             but without specifying the DIRECTORY option. This is potentially unsafe.
1930             Either use the DIRECTORY option or turn off SAFEMODE.
1931              
1932             END
1933 0 0       0 ($terminate ? <
1934             Since you are running as a privileged user, Inline.pm is terminating.
1935              
1936             END
1937             }
1938              
1939             sub M51_unused_DATA {
1940 0     0 0 0 return <
1941             One or more DATA sections were not processed by Inline.
1942              
1943             END
1944             }
1945              
1946             sub M52_invalid_filter {
1947 0     0 0 0 my ($filter) = @_;
1948 0         0 return <
1949             Invalid filter '$filter' is not a reference.
1950              
1951             END
1952             }
1953              
1954             sub M53_mkdir_failed {
1955 0     0 0 0 my ($dir) = @_;
1956 0         0 return <
1957             Couldn't make directory path '$dir'.
1958              
1959             END
1960             #'
1961             }
1962              
1963             sub M54_rmdir_failed {
1964 0     0 0 0 my ($dir) = @_;
1965 0         0 return <
1966             Can't remove directory '$dir':
1967              
1968             $!
1969              
1970             END
1971             #'
1972             }
1973              
1974             sub M55_unlink_failed {
1975 0     0 0 0 my ($file) = @_;
1976 0         0 return <
1977             Can't unlink file '$file':
1978              
1979             $!
1980              
1981             END
1982             #'
1983             }
1984              
1985             sub M56_no_DIRECTORY_found {
1986 0     0 0 0 return <
1987             Couldn't find an appropriate DIRECTORY for Inline to use.
1988              
1989             END
1990             #'
1991             }
1992              
1993             sub M57_wrong_architecture {
1994 0     0 0 0 my ($ext, $arch, $thisarch) = @_;
1995 0         0 return <
1996             The extension '$ext'
1997             is built for perl on the '$arch' platform.
1998             This is the '$thisarch' platform.
1999              
2000             END
2001             }
2002              
2003             sub M58_site_install {
2004 0     0 0 0 return <
2005             You have specified the SITE_INSTALL command. Support for this option has
2006             been removed from Inline since version 0.40. It has been replaced by the
2007             use of Inline::MakeMaker in your Makefile.PL. Please see the Inline
2008             documentation for more help on creating and installing Inline based modules.
2009              
2010             END
2011             }
2012              
2013             sub M59_bad_inline_file {
2014 0     0 0 0 my ($lang) = @_;
2015 0         0 return <
2016             Could not find any Inline source code for the '$lang' language using
2017             the Inline::Files module.
2018              
2019             END
2020             }
2021              
2022             sub M60_no_inline_files {
2023 0     0 0 0 return <
2024             It appears that you have requested to use Inline with Inline::Files.
2025             You need to explicitly 'use Inline::Files;' before your 'use Inline'.
2026              
2027             END
2028             }
2029              
2030             sub M61_not_parsed {
2031 0     0 0 0 return <
2032             It does not appear that your program has been properly parsed by Inline::Files.
2033              
2034             END
2035             }
2036              
2037             sub M62_invalid_config_file {
2038 0     0 0 0 my ($config) = @_;
2039 0         0 return <
2040             You are using a config file that was created by an older version of Inline:
2041              
2042             $config
2043              
2044             This file and all the other components in its directory are no longer valid
2045             for this version of Inline. The best thing to do is simply delete all the
2046             contents of the directory and let Inline rebuild everything for you. Inline
2047             will do this automatically when you run your programs.
2048              
2049             END
2050             }
2051              
2052             sub M63_no_source {
2053 0     0 0 0 my ($pkg) = @_;
2054 0         0 return <
2055             This module $pkg can not be loaded and has no source code.
2056             You may need to reinstall this module.
2057              
2058             END
2059             }
2060              
2061             sub M64_install_not_c {
2062 0     0 0 0 my ($lang) = @_;
2063 0         0 return <
2064             Invalid attempt to install an Inline module using the '$lang' language.
2065              
2066             Only C and CPP (C++) based modules are currently supported.
2067              
2068             END
2069             }
2070              
2071             sub M65_WITH_not_lang {
2072 0     0 0 0 my ($mod, $lang) = @_;
2073 0         0 return <
2074             $mod gave no 'with' hints for $lang.
2075             END
2076             }
2077              
2078             1;