File Coverage

blib/lib/RPerl/Config.pm
Criterion Covered Total %
statement 169 254 66.5
branch 32 78 41.0
condition 10 42 23.8
subroutine 23 32 71.8
pod n/a
total 234 406 57.6


line stmt bran cond sub pod time code
1             ## no critic qw(ProhibitUselessNoCritic PodSpelling ProhibitExcessMainComplexity) # DEVELOPER DEFAULT 1a: allow unreachable & POD-commented code, must be on line 1; SYSTEM SPECIAL 4: allow complex code outside subroutines, must be on line 1
2              
3             # NEED FIX: triplicate export code
4             package RPerl::Config;
5 9     9   63 use strict;
  9         22  
  9         313  
6 9     9   61 use warnings;
  9         21  
  9         466  
7             our $VERSION = 0.007_000;
8              
9             ## no critic qw(ProhibitUselessNoCritic ProhibitMagicNumbers RequireCheckedSyscalls) # USER DEFAULT 1: allow numeric values & print operator
10             ## no critic qw(RequireInterpolationOfMetachars) # USER DEFAULT 2: allow single-quoted control characters & sigils
11             ## no critic qw(ProhibitUnreachableCode RequirePodSections RequirePodAtEnd) # DEVELOPER DEFAULT 1b: allow POD & unreachable or POD-commented code, must be after line 1
12             ## no critic qw(ProhibitStringyEval) # SYSTEM DEFAULT 1: allow eval()
13             ## no critic qw(ProhibitExplicitStdin) # USER DEFAULT 4: allow <STDIN> prompt
14             ## no critic qw(Capitalization ProhibitMultiplePackages ProhibitReusedNames) # SYSTEM DEFAULT 3: allow multiple & lower case package names
15             ## no critic qw(ProhibitAutomaticExportation) # SYSTEM SPECIAL 14: allow global exports from Config.pm
16              
17             # DEV NOTE: this package exists to serve as the header file for RPerl.pm itself,
18             # as well as for RPerl.pm dependencies such as Class.pm, HelperFunctions_cpp.pm, and rperltypes.pm
19              
20             # @ARG == @_, $OS_ERROR == $ERRNO == $!, $EVAL_ERROR == $@, $CHILD_ERROR == $?, $EXECUTABLE_NAME == $^X, $PROGRAM_NAME == $0, $OSNAME == $^O
21              
22             # export various subroutines and variables to all who call 'use RPerl::Config;'
23 9     9   5888 use Data::Dumper;
  9         82424  
  9         757  
24             $Data::Dumper::Sortkeys = 1; # Dumper() output must be sorted for lib/RPerl/Tests/Type_Types/* etc.
25 9     9   86 use Carp;
  9         24  
  9         571  
26 9     9   3962 use English qw(-no_match_vars);
  9         29948  
  9         75  
27 9     9   7851 use POSIX qw(ceil floor modf);
  9         49386  
  9         67  
28 9     9   12661 use Exporter 'import';
  9         26  
  9         637  
29              
30             # DEV NOTE, CORRELATION #rp008: can't include to_string(), type(), types(), name(), or scope_type_name_value() in @EXPORT here or in RPerl:: namespace below
31             # DEV NOTE, CORRELATION #rp034: enable @ARG in all packages (class & non-class)
32             our @EXPORT = qw(Dumper carp croak confess *ARG $OS_ERROR $EVAL_ERROR $CHILD_ERROR $EXECUTABLE_NAME $PROGRAM_NAME $OSNAME);
33              
34             1; # end of package
35              
36             # NEED FIX: triplicate export code
37             package RPerl::AfterSubclass;
38              
39             ## no critic qw(ProhibitAutomaticExportation) # SYSTEM SPECIAL 14: allow global exports from Config.pm
40              
41             # export various subroutines and variables to all who call 'use RPerl::AfterSubclass;'
42 9     9   53 use Data::Dumper;
  9         21  
  9         484  
43             $Data::Dumper::Sortkeys = 1; # Dumper() output must be sorted for lib/RPerl/Tests/Type_Types/* etc.
44 9     9   51 use Carp;
  9         21  
  9         556  
45 9     9   51 use English qw(-no_match_vars);
  9         17  
  9         61  
46 9     9   2744 use POSIX qw(ceil floor modf);
  9         20  
  9         44  
47 9     9   531 use Exporter 'import';
  9         19  
  9         477  
48              
49             # DEV NOTE, CORRELATION #rp008: can't include to_string(), type(), types(), name(), or scope_type_name_value() in @EXPORT here or in RPerl:: namespace below
50             # DEV NOTE, CORRELATION #rp034: enable @ARG in all packages (class & non-class)
51             our @EXPORT = qw(Dumper carp croak confess *ARG $OS_ERROR $EVAL_ERROR $CHILD_ERROR $EXECUTABLE_NAME $PROGRAM_NAME $OSNAME);
52              
53             1; # end of package
54              
55             # NEED FIX: triplicate export code
56             package RPerl;
57 9     9   49 use File::Find qw(find);
  9         15  
  9         472  
58 9     9   53 use File::Spec;
  9         21  
  9         312  
59 9     9   5564 use IPC::Cmd qw(can_run); # to check for `reset`
  9         417758  
  9         1166  
60              
61             ## no critic qw(ProhibitUselessNoCritic ProhibitMagicNumbers RequireCheckedSyscalls) # USER DEFAULT 1: allow numeric values & print operator
62             ## no critic qw(RequireInterpolationOfMetachars) # USER DEFAULT 2: allow single-quoted control characters & sigils
63             ## no critic qw(ProhibitUnreachableCode RequirePodSections RequirePodAtEnd) # DEVELOPER DEFAULT 1b: allow POD & unreachable or POD-commented code, must be after line 1
64             ## no critic qw(ProhibitStringyEval) # SYSTEM DEFAULT 1: allow eval()
65             ## no critic qw(ProhibitExplicitStdin) # USER DEFAULT 4: allow <STDIN> prompt
66             ## no critic qw(Capitalization ProhibitMultiplePackages ProhibitReusedNames) # SYSTEM DEFAULT 3: allow multiple & lower case package names
67             ## no critic qw(ProhibitAutomaticExportation) # SYSTEM SPECIAL 14: allow global exports from Config.pm
68              
69             # export $RPerl::MODES, as well as various subroutines and variables to all who call 'use RPerl;'
70             our $MODES = { # see perl_modes.txt for more info
71             0 => { ops => 'PERL', types => 'PERL' }, # NEED FIX: should be types => 'PERL_STATIC'
72             1 => { ops => 'CPP', types => 'PERL' }, # NEED FIX: should be types => 'PERL_STATIC'
73             2 => { ops => 'CPP', types => 'CPP' }
74             };
75              
76 9     9   106 use Data::Dumper;
  9         27  
  9         548  
77             $Data::Dumper::Sortkeys = 1; # Dumper() output must be sorted for lib/RPerl/Tests/Type_Types/* etc.
78 9     9   58 use Carp;
  9         23  
  9         508  
79 9     9   62 use English qw(-no_match_vars);
  9         21  
  9         86  
80 9     9   3341 use POSIX qw(ceil floor modf);
  9         24  
  9         83  
81 9     9   726 use Exporter 'import';
  9         19  
  9         1274  
82             # DEV NOTE, CORRELATION #rp034: enable @ARG in all packages (class & non-class)
83             our @EXPORT = qw(Dumper carp croak confess *ARG $OS_ERROR $EVAL_ERROR $CHILD_ERROR $EXECUTABLE_NAME $PROGRAM_NAME $OSNAME);
84              
85             # [[[ OO CLASS PROPERTIES SPECIAL ]]]
86              
87             # data type checking mode, disabled in RPerl system code which calls 'use RPerl;',
88             # changed on a per-file basis by preprocessor directive, see RPerl::CompileUnit::Module::Class::INIT
89             # NEED UPGRADE: enable in RPerl system code when bootstrapping compiler
90             our $CHECK = 'OFF';
91             our $DEBUG = 0; # $RPerl::DEBUG & env var RPERL_DEBUG are equivalent, default to off, see debug*() & diag*() below
92             our $VERBOSE = 0; # $RPerl::VERBOSE & env var RPERL_VERBOSE are equivalent, default to off, see verbose*() below
93             our $WARNINGS = 1; # $RPerl::WARNINGS & env var RPERL_WARNINGS are equivalent, default to on, see warn*() below
94             our $TYPES_CCFLAG = ' -D__CPP__TYPES'; # rperltypes_mode.h & here default to CPPTYPES if PERLTYPES not explicitly set in this variable via rperltypes::types_enable()
95             our $BASE_PATH = undef; # all target software lives below here
96             our $INCLUDE_PATH = undef; # all target system modules live here
97             our $SCRIPT_PATH = undef; # interpreted target system programs live here
98             our $CORE_PATH = undef; # all Perl core components (perl.h, etc) live here
99              
100             # DEV NOTE, CORRELATION #rp032: NEED UPGRADE: properly determine whether to use DBL_EPSILON or FLT_EPSILON below
101 9     9   69 use constant EPSILON => POSIX::DBL_EPSILON();
  9         19  
  9         19257  
102             #use constant EPSILON => POSIX::FLT_EPSILON();
103              
104             # [[[ SUBROUTINES SPECIAL ]]]
105              
106             # use a possibly-compiled RPerl package during runtime
107             sub eval_use {
108 0     0   0 (my $package_name, my $display_errors) = @ARG;
109             # RPerl::debug('in RPerl::eval_use(), received $package_name = ', $package_name, "\n");
110              
111 0         0 my $INC_ref_pre = {};
112 0         0 foreach my $INC_key_pre (keys %INC) { $INC_ref_pre->{$INC_key_pre} = 1; }
  0         0  
113             # RPerl::debug('in RPerl::eval_use(), have $INC_ref_pre = ', Dumper($INC_ref_pre), "\n");
114              
115 0         0 my $eval_string .=<<"EOL";
116             use $package_name;
117             # detect compiled C++ code and call cpp_load() accordingly
118             if (defined \&$package_name\:\:cpp_load) {
119             # RPerl::debug('in RPerl::eval_use() eval, $package_name\:\:cpp_load() is defined, calling...', "\\n");
120             $package_name\:\:cpp_load();
121             # RPerl::debug('in RPerl::eval_use() eval, $package_name\:\:cpp_load() is defined, returned from call', "\\n");
122             }
123             # else {
124             # RPerl::debug('in RPerl::eval_use() eval, $package_name\:\:cpp_load() is NOT defined, skipping...', "\\n");
125             # }
126             EOL
127              
128             # RPerl::debug('in RPerl::eval_use(), have $eval_string = ', "\n\n", $eval_string, "\n\n");
129              
130 0         0 $eval_string .=<<'EOL';
131             my $INC_ref_post = {};
132             foreach my $INC_key_post (keys %INC) {
133             if (not exists $INC_ref_pre->{$INC_key_post}) {
134             $INC_ref_post->{$INC_key_post} = $INC{$INC_key_post};
135             }
136             }
137             # RPerl::debug('in RPerl::eval_use() eval, have $INC_ref_post = ', Dumper($INC_ref_post), "\n");
138             RPerl::CompileUnit::Module::Class::create_symtab_entries_and_accessors_mutators($INC_ref_post);
139             EOL
140              
141 0         0 my $eval_retval = eval $eval_string;
142             # if (defined $eval_retval) { print 'have $eval_retval = ', $eval_retval, "\n"; }
143             # else { print 'have $eval_retval = undef, have $EVAL_ERROR = ', $EVAL_ERROR, "\n"; }
144 0 0 0     0 if ($display_errors and (defined $EVAL_ERROR) and ($EVAL_ERROR ne q{})) {
      0        
145 0         0 RPerl::warning( 'WARNING WCOEU00, EVAL USE: Failed to eval-use package ' . q{'}
146             . $package_name . q{'} . ', fatal error trapped and delayed' . "\n" );
147 0         0 RPerl::diag( ' Trapped the following error message...' . "\n\n" . $EVAL_ERROR . "\n" );
148 0         0 RPerl::warning("\n");
149             }
150              
151 0         0 return $eval_retval;
152             }
153              
154             # NEED UPGRADE: replace Data::Dumper with pure-RPerl equivalent?
155             #sub DUMPER {
156             # ( my $dumpee ) = @ARG;
157             # die ('in RPerl::DUMPER(), received undef argument, dying') if (not(defined($_[0])));
158             # return '**UNDEF**' if ( not( defined $dumpee ) );
159             # return $dumpee->DUMPER()
160             # if ( defined( eval( q{$} . ref($dumpee) . q{::DUMPER} ) ) );
161             # return Dumper($dumpee);
162             #}
163              
164             # DEV NOTE: to make diag*() & debug*() & verbose*() & warning() truly variadic, do not accept args as first line in subroutine
165              
166             # DEV NOTE: diag() is simply a wrapper around debug(), they are 100% equivalent; likewise diag_pause() and debug_pause()
167 0     0   0 sub diag { return debug(@ARG); }
168 0     0   0 sub diag_pause { return debug_pause(@ARG); }
169              
170             # print debugging AKA diagnostic message to STDERR, if either RPERL_DEBUG environmental variable or $RPerl::DEBUG global variable are true
171             sub debug {
172             # print {*STDERR} 'in debug(), have $ENV{RPERL_DEBUG} = ' . $ENV{RPERL_DEBUG} . "\n";
173              
174             # DEV NOTE, CORRELATION #rp017: default to off; if either variable is set to true, then do emit messages
175 0 0 0 0   0 if ( $ENV{RPERL_DEBUG} or $RPerl::DEBUG ) { print {*STDERR} @ARG; }
  0         0  
  0         0  
176              
177             # if ( $ENV{RPERL_DEBUG} or $RPerl::DEBUG ) { print {*STDERR} "\e[1;31m $message \e[0m"; } # print in red
178 0         0 return 1; # DEV NOTE: this must be here to avoid 'at -e line 0. INIT failed--call queue aborted.'... BUT WHY???
179             }
180              
181             # same as debug(), except require <ENTER> to continue
182             sub debug_pause {
183 0 0 0 0   0 if ( $ENV{RPERL_DEBUG} or $RPerl::DEBUG ) {
184 0         0 print {*STDERR} @ARG;
  0         0  
185 0         0 my $stdin_ignore = <STDIN>;
186             }
187 0         0 return 1;
188             }
189              
190             # print verbose user-friendly message to STDOUT, if either RPERL_VERBOSE environmental variable or $RPerl::VERBOSE global variable are true
191             sub verbose {
192             # DEV NOTE, CORRELATION #rp017: default to off; if either variable is set to true, then do emit messages
193 0 0 0 0   0 if ( $ENV{RPERL_VERBOSE} or $RPerl::VERBOSE ) {
194 0         0 print {*STDOUT} @ARG;
  0         0  
195             }
196 0         0 return 1;
197             }
198              
199             # same as verbose(), except require <ENTER> to continue
200             sub verbose_pause {
201 0 0 0 0   0 if ( $ENV{RPERL_VERBOSE} or $RPerl::VERBOSE ) {
202 0         0 print {*STDOUT} @ARG;
  0         0  
203 0         0 my $stdin_ignore = <STDIN>;
204             }
205 0         0 return 1;
206             }
207              
208             # clear STDOUT, if either RPERL_VERBOSE environmental variable or $RPerl::VERBOSE global variable are true
209             sub verbose_clear_screen {
210 0 0 0 0   0 if ( $ENV{RPERL_VERBOSE} or $RPerl::VERBOSE ) {
211 0 0       0 if ( $OSNAME eq 'linux' ) {
    0          
212 0         0 my $reset_path = can_run('reset');
213 0 0       0 if ( defined $reset_path ) {
214 0         0 system $reset_path;
215             }
216             }
217             elsif ( $OSNAME eq 'MSWin32' ) {
218              
219             # cls is a shell builtin, not a command which can be found by can_run()
220 0         0 system 'cls';
221             }
222             else {
223 0         0 RPerl::warning(
224             q{WARNING WOSCLSC00: Unknown operating system '} . $OSNAME . q{' where 'linux' or 'Win32' expected, skipping screen clearing} . "\n" );
225 0         0 return 0;
226             }
227             }
228 0         0 return 1;
229             }
230              
231             # print non-fatal warning message to STDERR, unless either RPERL_WARNINGS environmental variable or $RPerl::WARNINGS global variable are false
232             sub warning {
233             # default to on; if either variable is set to false, then do not emit messages
234 9 0 33 9   90 if ( ( ( not defined $ENV{RPERL_WARNINGS} ) or $ENV{RPERL_WARNINGS} )
      33        
235             and $RPerl::WARNINGS )
236             {
237             # NEED ADDRESS? the two following lines should be equivalent, but warn causes false ECOPAPL03
238 0         0 print {*STDERR} @ARG;
  0         0  
239              
240             # warn $message . "\n";
241             }
242 9         41 return 1;
243             }
244              
245             sub analyze_class_symtab_entries {
246 0     0   0 ( my $class ) = @ARG;
247 0         0 my $retval = q{};
248 0         0 my @isa_array = eval q{@} . $class . q{::ISA};
249              
250             #print Dumper(\@isa_array);
251 0         0 my $isa_string = join ', ', @isa_array;
252 0         0 $retval .= '<<<<< BEGIN SYMTAB ENTRIES >>>>>' . "\n";
253 0         0 $retval .= $class . ' ISA (' . $isa_string . ')' . "\n\n";
254              
255             #foreach my $entry ( sort keys %RPerl::CompileUnit::Module::Header:: ) {
256 0         0 my @keys = eval q{sort keys %} . $class . q{::};
257 0         0 foreach my $entry (@keys) {
258              
259             # my $glob = $RPerl::CompileUnit::Module::Header::{$entry};
260 0         0 my $glob = eval q{$} . $class . q{::{$entry}};
261              
262 0         0 $retval .= q{-} x 50;
263 0         0 $retval .= "\n";
264 0         0 $retval .= $entry . "\n";
265              
266             # $retval .= ref \$glob, "\n"; # always says GLOB
267              
268 0 0       0 if ( defined ${$glob} ) {
  0         0  
269 0         0 $retval .= "\t" . 'scalar';
270 0         0 my $ref_type = ref ${$glob};
  0         0  
271 0 0       0 if ( $ref_type ne q{} ) {
272 0         0 $retval .= "\t" . $ref_type . 'ref';
273             }
274             }
275 0 0       0 if ( @{$glob} ) {
  0         0  
276 0         0 $retval .= "\t" . 'array';
277             }
278 0 0       0 if ( %{$glob} ) {
  0         0  
279 0         0 $retval .= "\t" . 'hash';
280             }
281 0 0       0 if ( defined &{$glob} ) {
  0         0  
282 0         0 $retval .= "\t" . 'code';
283             }
284              
285 0         0 $retval .= "\n";
286             }
287 0         0 $retval .= '<<<<< END SYMTAB ENTRIES >>>>>' . "\n";
288 0         0 return $retval;
289             }
290              
291             # [ AUTOMATICALLY SET SYSTEM-DEPENDENT PATH VARIABLES ]
292             sub set_system_paths {
293 9     9   29 ( my $target_file_name_config, my $target_package_name_config, my $target_file_name_pm, my $target_file_name_script ) = @ARG;
294 9 50 33     98 if (( not exists $INC{$target_file_name_config} )
295             or ( not defined $INC{$target_file_name_config} )
296             )
297             {
298 0         0 Carp::croak 'BIZARRE ERROR EINPL00: Non-existent or undefined Perl %INC path entry for '
299             . $target_file_name_config
300             . ', reported from within '
301             . $target_package_name_config
302             . ', croaking';
303             }
304 9         29 my $target_config_pm_loaded = $INC{$target_file_name_config};
305 9 50       475 if ( not -e $target_config_pm_loaded ) {
306 0         0 Carp::croak 'BIZARRE ERROR EINPL01: Non-existent file ',
307             $target_config_pm_loaded,
308             ' supposedly loaded in %INC, reported from within ' . $target_package_name_config . ', croaking';
309             }
310 9         297 ( my $volume_loaded, my $directories_loaded, my $file_loaded ) = File::Spec->splitpath( $target_config_pm_loaded, my $no_file = 0 );
311 9         147 my @directories_loaded_split = File::Spec->splitdir($directories_loaded);
312              
313             #print {*STDERR} 'in ' . $target_package_name_config . ', have pre-pop @directories_loaded_split = ', "\n", Dumper(@directories_loaded_split), "\n";
314              
315             # pop twice if empty entry on top
316 9 50       47 if ( pop @directories_loaded_split eq q{} ) { pop @directories_loaded_split; }
  9         25  
317 9         234 my $target_pm_wanted = File::Spec->catpath( $volume_loaded, ( File::Spec->catdir(@directories_loaded_split) ), $target_file_name_pm );
318              
319             #print {*STDERR} 'in ' . $target_package_name_config . ', have post-pop @directories_loaded_split = ', "\n", Dumper(@directories_loaded_split), "\n";
320             #print {*STDERR} 'in ' . $target_package_name_config . ', have $target_config_pm_loaded = ', $target_config_pm_loaded, "\n";
321             #print {*STDERR} 'in ' . $target_package_name_config . ', have $target_pm_wanted = ', $target_pm_wanted, "\n";
322              
323 9         27 my $target_pm_loaded = undef;
324 9 50 33     50 if ( ( exists $INC{$target_file_name_pm} ) and ( defined $INC{$target_file_name_pm} ) ) {
325 0         0 $target_pm_loaded = $INC{$target_file_name_pm};
326              
327             # BULK88 20150608 2015.159: Win32 Bug Fix
328             # if ( not -e $target_pm_loaded ) {
329 0 0       0 if ( not -f $target_pm_loaded ) {
330 0         0 Carp::croak 'BIZARRE ERROR EINPL02: Non-existent file ', $target_pm_loaded,
331             ' supposedly loaded in %INC, reported from within ' . $target_package_name_config . ', croaking';
332             }
333             }
334              
335             # strip trailing '/'
336 9 50       35 if ( ( substr $directories_loaded, -1, 1 ) eq q{/} ) {
337 9         24 $directories_loaded = substr $directories_loaded, 0, -1;
338             }
339              
340             #print {*STDERR} 'in ' . $target_package_name_config . ', have $directories_loaded = ', $directories_loaded, "\n";
341             #print {*STDERR} 'in ' . $target_package_name_config . ', have $target_pm_loaded = ', ( $target_pm_loaded or '<undef>' ), "\n";
342              
343 9         21 my $target_scripts_found = [];
344 9         20 my $target_pms_found = [];
345              
346             # BULK88 20150608 2015.159: Win32 Bug Fix
347             #foreach my $inc_path ( $directories_loaded, @INC ) { # this doesn't work with Win32
348             # DEV NOTE: search order precedence for script command is OS paths, path of loaded TARGET/Config.pm (this file), Perl INC paths
349 9         99 foreach my $inc_path ( ( split ':', $ENV{PATH} ), File::Spec->catpath( $volume_loaded, $directories_loaded, '' ), @INC ) {
350              
351             # print {*STDERR} 'in ' . $target_package_name_config . ', top of main foreach() loop, have $inc_path = ', $inc_path, "\n";
352 189         414 my $sub_inc_paths = [];
353              
354             # push @{$sub_inc_paths}, $inc_path;
355 189         958 ( my $inc_volume, my $inc_directories, my $inc_file ) = File::Spec->splitpath( $inc_path, my $no_file = 1 );
356              
357 189         373 push @{$sub_inc_paths}, $inc_directories;
  189         425  
358              
359 189         981 my @directories_split = File::Spec->splitdir($inc_directories);
360 189         395 pop @directories_split;
361 189         309 push @{$sub_inc_paths}, File::Spec->catdir(@directories_split);
  189         894  
362 189         387 pop @directories_split;
363 189         304 push @{$sub_inc_paths}, File::Spec->catdir(@directories_split);
  189         723  
364              
365             # print {*STDERR} 'in ' . $target_package_name_config . ', in main foreach() loop, have $sub_inc_paths = ', "\n", Dumper($sub_inc_paths), "\n";
366             # print {*STDERR} 'in ' . $target_package_name_config . ', in main foreach() loop, have $inc_volume = ', "\n", Dumper($inc_volume), "\n";
367             # print {*STDERR} 'in ' . $target_package_name_config . ', in main foreach() loop, have $inc_directories = ', "\n", Dumper($inc_directories), "\n";
368             # print {*STDERR} 'in ' . $target_package_name_config . ', in main foreach() loop, have $inc_file = ', "\n", Dumper($inc_file), "\n";
369              
370 189         407 my $possible_target_scripts = [];
371 189         297 foreach my $sub_inc_path ( @{$sub_inc_paths} ) {
  189         404  
372 567         994 push @{$possible_target_scripts}, File::Spec->catpath( $inc_volume, $sub_inc_path, $target_file_name_script );
  567         2560  
373 567 100       1327 if ( $sub_inc_path ne q{} ) {
374 522         758 push @{$possible_target_scripts}, File::Spec->catpath( $inc_volume, File::Spec->catdir( $sub_inc_path, 'script' ), $target_file_name_script );
  522         3545  
375 522         1134 push @{$possible_target_scripts}, File::Spec->catpath( $inc_volume, File::Spec->catdir( $sub_inc_path, 'bin' ), $target_file_name_script );
  522         3640  
376             }
377             else {
378 45         70 push @{$possible_target_scripts}, File::Spec->catpath( $inc_volume, 'script', $target_file_name_script );
  45         179  
379 45         103 push @{$possible_target_scripts}, File::Spec->catpath( $inc_volume, 'bin', $target_file_name_script );
  45         205  
380             }
381             }
382              
383 189         362 foreach my $possible_target_script ( @{$possible_target_scripts} ) {
  189         338  
384              
385             # print {*STDERR} 'in ' . $target_package_name_config . ', have $possible_target_script = ', $possible_target_script, "\n";
386             # BULK88 20150608 2015.159: Win32 Bug Fix
387             # if ( ( -e $possible_target_script ) and ( -x $possible_target_script ) ) {
388 1701 50 66     15893 if ( ( -f $possible_target_script ) and ( $OSNAME eq 'MSWin32' ? 1 : -x $possible_target_script ) ) {
    50          
389 171         367 my $is_unique = 1;
390 171         247 foreach my $target_script_found ( @{$target_scripts_found} ) {
  171         332  
391 477 100       1060 if ( $target_script_found eq $possible_target_script ) { $is_unique = 0; }
  135         250  
392             }
393 171 100       472 if ($is_unique) { push @{$target_scripts_found}, $possible_target_script; }
  36         59  
  36         85  
394             }
395             }
396              
397 189 50       531 if ( not defined $target_pm_loaded ) {
398 189         1552 my $possible_target_pm = File::Spec->catfile( $inc_path, $target_file_name_pm );
399              
400             # BULK88 20150608 2015.159: Win32 Bug Fix
401             # if ( -e $possible_target_pm ) {
402 189 100       2206 if ( -f $possible_target_pm ) {
403 27         58 my $is_unique = 1;
404 27         45 foreach my $target_pm_found ( @{$target_pms_found} ) {
  27         68  
405 18 100       66 if ( $target_pm_found eq $possible_target_pm ) {
406 9         24 $is_unique = 0;
407             }
408             }
409 27 100       92 if ($is_unique) { push @{$target_pms_found}, $possible_target_pm; }
  18         38  
  18         74  
410             }
411             }
412             }
413              
414             #print {*STDERR} 'in ' . $target_package_name_config . ', have $target_scripts_found = ', "\n", Dumper($target_scripts_found), "\n";
415             #print {*STDERR} 'in ' . $target_package_name_config . ', have $target_pms_found = ', "\n", Dumper($target_pms_found), "\n";
416              
417 9 50       33 if ( scalar @{$target_scripts_found} == 0 ) {
  9         42  
418 0         0 die 'ERROR EEXRP00: Failed to find `' . $target_file_name_script . '` executable, dying' . "\n";
419             }
420 9         33 my $target_script_found = $target_scripts_found->[0];
421 9 50       21 if ( scalar @{$target_scripts_found} > 1 ) {
  9         38  
422 9         345 RPerl::warning( 'WARNING WEXRP00: Found multiple `'
423             . $target_file_name_script
424             . '` executables, using first located, ' . q{`}
425             . $target_script_found . q{`}
426             . "\n" );
427             }
428              
429 9         32 my $target_pm_found = undef;
430 9 50       65 if ( defined $target_pm_loaded ) {
431 0         0 $target_pm_found = $target_pm_loaded;
432             }
433             else {
434              
435 9 50       21 if ( scalar @{$target_pms_found} == 0 ) {
  9         39  
436 0         0 Carp::croak 'ERROR EINRP00: Failed to find ' . $target_file_name_pm . ' module, croaking';
437             }
438 9         21 foreach my $target_pm_found_single ( @{$target_pms_found} ) {
  9         23  
439 18 100       54 if ( $target_pm_found_single eq $target_pm_wanted ) {
440 9         23 $target_pm_found = $target_pm_found_single;
441             }
442             }
443 9 50       45 if ( not defined $target_pm_found ) {
444 0         0 Carp::croak 'ERROR EINRP01: Expected to find ', $target_pm_wanted, ' but instead found ', "\n", Dumper($target_pms_found), ', croaking';
445             }
446             }
447              
448             #print {*STDERR} 'in ' . $target_package_name_config . ', have $target_pm_found = ', $target_pm_found, "\n";
449             #print {*STDERR} 'in ' . $target_package_name_config . ', have $target_script_found = ', $target_script_found, "\n";
450              
451             #( my $volume_target_pm, my $directories_target_pm, my $file_target_pm ) = File::Spec->splitpath( $target_pm_found, $no_file = 0 );
452             #( my $volume_target_script, my $directories_target_script, my $file_target_script ) = File::Spec->splitpath( $target_script_found, $no_file = 0 );
453 9         169 ( undef, my $directories_target_pm, my $file_target_pm ) = File::Spec->splitpath( $target_pm_found, $no_file = 0 );
454 9         73 ( undef, my $directories_target_script, my $file_target_script ) = File::Spec->splitpath( $target_script_found, $no_file = 0 );
455              
456             #print {*STDERR} 'in ' . $target_package_name_config . ', have $volume_target_pm = ', $volume_target_pm, "\n";
457             #print {*STDERR} 'in ' . $target_package_name_config . ', have $directories_target_pm = ', $directories_target_pm, "\n";
458             #print {*STDERR} 'in ' . $target_package_name_config . ', have $file_target_pm = ', $file_target_pm, "\n";
459             #print {*STDERR} 'in ' . $target_package_name_config . ', have $volume_target_script = ', $volume_target_script, "\n";
460             #print {*STDERR} 'in ' . $target_package_name_config . ', have $directories_target_script = ', $directories_target_script, "\n";
461             #print {*STDERR} 'in ' . $target_package_name_config . ', have $file_target_script = ', $file_target_script, "\n";
462              
463 9         72 my @directories_target_pm_split = File::Spec->splitdir($directories_target_pm);
464 9         54 my @directories_target_script_split = File::Spec->splitdir($directories_target_script);
465 9         28 my @directories_base_split = ();
466              
467 9         43 for my $i ( 0 .. ( ( scalar @directories_target_pm_split ) - 1 ) ) {
468 18 100       58 if ( $directories_target_pm_split[$i] eq $directories_target_script_split[$i] ) {
469 9         28 push @directories_base_split, $directories_target_pm_split[$i];
470             }
471             else {
472 9         26 for my $j ( 0 .. ( $i - 1 ) ) {
473 9         21 shift @directories_target_pm_split;
474 9         29 shift @directories_target_script_split;
475             }
476 9         26 last;
477             }
478             }
479              
480             #print {*STDERR} 'in ' . $target_package_name_config . ', have @directories_base_split = ', "\n", Dumper(\@directories_base_split), "\n";
481             #print {*STDERR} 'in ' . $target_package_name_config . ', have @directories_target_pm_split = ', "\n", Dumper(\@directories_target_pm_split), "\n";
482             #print {*STDERR} 'in ' . $target_package_name_config . ', have @directories_target_script_split = ', "\n", Dumper(\@directories_target_script_split), "\n";
483              
484 9         44 my $MY_BASE_PATH;
485             my $MY_INCLUDE_PATH;
486 9         0 my $MY_SCRIPT_PATH;
487 9         0 my $MY_CORE_PATH;
488              
489             # NEED FIX: how do we catpath() with some $volume instead of catdir() below, without breaking relative paths?
490 9         89 $MY_BASE_PATH = File::Spec->catpath( $volume_loaded, File::Spec->catdir(@directories_base_split), '' );
491 9 50       35 if ( $MY_BASE_PATH eq q{} ) {
492 0         0 $MY_INCLUDE_PATH = File::Spec->catpath( $volume_loaded, File::Spec->catdir(@directories_target_pm_split), '' );
493 0         0 $MY_SCRIPT_PATH = File::Spec->catpath( $volume_loaded, File::Spec->catdir(@directories_target_script_split), '' );
494              
495             # print {*STDERR} 'in ' . $target_package_name_config . ', have $MY_BASE_PATH eq q{} = ', $MY_BASE_PATH, "\n";
496             }
497             else {
498 9         59 $MY_INCLUDE_PATH = File::Spec->catdir( $MY_BASE_PATH, @directories_target_pm_split );
499 9         56 $MY_SCRIPT_PATH = File::Spec->catdir( $MY_BASE_PATH, @directories_target_script_split );
500              
501             # print {*STDERR} 'in ' . $target_package_name_config . ', have $MY_BASE_PATH ne q{} ', $MY_BASE_PATH, "\n";
502             }
503              
504 9         79 foreach my $inc_path (@INC) {
505 81         323 $MY_CORE_PATH = File::Spec->catdir( $inc_path, 'CORE' );
506 81         431 my $inc_core_perl_h_path = File::Spec->catfile( $MY_CORE_PATH, 'perl.h' );
507 81 100 66     1335 if ( ( -e $inc_core_perl_h_path ) and ( -r $inc_core_perl_h_path ) and ( -f $inc_core_perl_h_path ) ) { last; }
  9   66     39  
508 72         165 else { $MY_CORE_PATH = q{}; }
509             }
510              
511             #print {*STDERR} 'in ' . $target_package_name_config . ', have $MY_BASE_PATH = ', $MY_BASE_PATH, "\n";
512             #print {*STDERR} 'in ' . $target_package_name_config . ', have $MY_INCLUDE_PATH = ', $MY_INCLUDE_PATH, "\n";
513             #print {*STDERR} 'in ' . $target_package_name_config . ', have $MY_SCRIPT_PATH = ', $MY_SCRIPT_PATH, "\n";
514             #print {*STDERR} 'in ' . $target_package_name_config . ', have $MY_CORE_PATH = ', $MY_CORE_PATH, "\n";
515            
516 9         93 return [$MY_BASE_PATH, $MY_INCLUDE_PATH, $MY_SCRIPT_PATH, $MY_CORE_PATH];
517             }
518              
519             # [[[ OPERATIONS SPECIAL ]]]
520              
521             my $file_name_config = 'RPerl/Config.pm'; # this file name
522             my $package_name_config = 'RPerl::Config'; # this file's primary package name
523             my $file_name_pm = 'RPerl.pm';
524             my $file_name_script = 'rperl';
525             ($BASE_PATH, $INCLUDE_PATH, $SCRIPT_PATH, $CORE_PATH) = @{set_system_paths($file_name_config, $package_name_config, $file_name_pm, $file_name_script)};
526              
527             1; # end of package
528              
529              
530             # export system paths to main:: namespace for use by PMC files
531             package main;
532              
533             # [[[ OO CLASS PROPERTIES SPECIAL ]]]
534             # DEV NOTE: duplicate lines to avoid 'used only once' warnings
535             our $BASE_PATH = $RPerl::BASE_PATH;
536             $BASE_PATH = $RPerl::BASE_PATH;
537             our $INCLUDE_PATH = $RPerl::INCLUDE_PATH;
538             $INCLUDE_PATH = $RPerl::INCLUDE_PATH;
539             our $SCRIPT_PATH = $RPerl::SCRIPT_PATH;
540             $SCRIPT_PATH = $RPerl::SCRIPT_PATH;
541              
542             1; # end of package