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