File Coverage

blib/lib/RPerl/Config.pm
Criterion Covered Total %
statement 463 542 85.4
branch 34 78 43.5
condition 14 42 33.3
subroutine 123 128 96.0
pod 0 11 0.0
total 634 801 79.1


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   56 use strict;
  9         15  
  9         242  
6 9     9   47 use warnings;
  9         20  
  9         400  
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   5331 use Data::Dumper;
  9         65978  
  9         538  
24             $Data::Dumper::Sortkeys = 1; # Dumper() output must be sorted for lib/RPerl/Tests/Type_Types/* etc.
25 9     9   66 use Carp;
  9         19  
  9         421  
26 9     9   3595 use English qw(-no_match_vars);
  9         24753  
  9         50  
27 9     9   6573 use POSIX qw(ceil floor modf);
  9         45062  
  9         51  
28 9     9   11655 use Exporter 'import';
  9         18  
  9         532  
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   50 use Data::Dumper;
  9         18  
  9         394  
43             $Data::Dumper::Sortkeys = 1; # Dumper() output must be sorted for lib/RPerl/Tests/Type_Types/* etc.
44 9     9   47 use Carp;
  9         17  
  9         411  
45 9     9   49 use English qw(-no_match_vars);
  9         16  
  9         55  
46 9     9   2588 use POSIX qw(ceil floor modf);
  9         19  
  9         44  
47 9     9   518 use Exporter 'import';
  9         19  
  9         543  
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   54 use File::Find qw(find);
  9         18  
  9         485  
58 9     9   50 use File::Spec;
  9         20  
  9         193  
59 9     9   5620 use IPC::Cmd qw(can_run); # to check for `reset`
  9         383839  
  9         795  
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   93 use Data::Dumper;
  9         21  
  9         504  
77             $Data::Dumper::Sortkeys = 1; # Dumper() output must be sorted for lib/RPerl/Tests/Type_Types/* etc.
78 9     9   59 use Carp;
  9         19  
  9         434  
79 9     9   53 use English qw(-no_match_vars);
  9         17  
  9         75  
80 9     9   3120 use POSIX qw(ceil floor modf);
  9         20  
  9         67  
81 9     9   603 use Exporter 'import';
  9         20  
  9         1214  
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   66 use constant EPSILON => POSIX::DBL_EPSILON();
  9         20  
  9         16611  
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 96     96 0 457 (my $package_name, my $display_errors) = @ARG;
109             # RPerl::debug('in RPerl::eval_use(), received $package_name = ', $package_name, "\n");
110              
111 96         262 my $INC_ref_pre = {};
112 96         55272 foreach my $INC_key_pre (keys %INC) { $INC_ref_pre->{$INC_key_pre} = 1; }
  69838         132680  
113             # RPerl::debug('in RPerl::eval_use(), have $INC_ref_pre = ', Dumper($INC_ref_pre), "\n");
114              
115 96         5697 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 96         325 $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 96     1   9226 my $eval_retval = eval $eval_string;
  1     1   8  
  1     1   2  
  1     1   98  
  1     1   13  
  1     1   6  
  1     1   134  
  1     1   21  
  1     1   4  
  1     1   140  
  1     1   20  
  1     1   8  
  1     1   141  
  1     1   19  
  1     1   4  
  1     1   140  
  1     1   33  
  1     1   11  
  1     1   206  
  1     1   21  
  1     1   4  
  1     1   181  
  1     1   17  
  1     1   7  
  1     1   119  
  1     1   17  
  1     1   7  
  1     1   121  
  1     1   17  
  1     1   3  
  1     1   119  
  1     1   17  
  1     1   7  
  1     1   122  
  1     1   15  
  1     1   7  
  1     1   108  
  1     1   15  
  1     1   6  
  1     1   116  
  1     1   835  
  1     1   8  
  1     1   101  
  1     1   740  
  1     1   6  
  1     1   102  
  1     1   7  
  1     1   3  
  1     1   82  
  1     1   19  
  1     1   5  
  1     1   143  
  1     1   20  
  1     1   7  
  1     1   142  
  1     1   828  
  1     1   6  
  1     1   115  
  1     1   11  
  1     1   3  
  1     1   78  
  1     1   16  
  1     1   5  
  1     1   118  
  1     1   20  
  1     1   6  
  1     1   149  
  1     1   7  
  1     1   7  
  1     1   87  
  1     1   20  
  1     1   8  
  1     1   150  
  1     1   20  
  1     1   7  
  1     1   147  
  1     1   10  
  1     1   5  
  1     1   121  
  1     1   925  
  1     1   8  
  1     1   130  
  1     1   7  
  1     1   6  
  1     1   78  
  1     1   16  
  1     1   5  
  1     1   122  
  1     1   804  
  1     1   4  
  1     1   108  
  1     1   10  
  1     1   3  
  1     1   80  
  1     1   17  
  1     1   3  
  1         119  
  1         917  
  1         5  
  1         131  
  1         8  
  1         8  
  1         85  
  1         17  
  1         5  
  1         136  
  1         823  
  1         6  
  1         115  
  1         11  
  1         2  
  1         109  
  1         16  
  1         6  
  1         143  
  1         1055  
  1         4  
  1         123  
  1         10  
  1         7  
  1         98  
  1         17  
  1         4  
  1         118  
  1         783  
  1         5  
  1         106  
  1         7  
  1         7  
  1         88  
  1         22  
  1         6  
  1         126  
  1         785  
  1         4  
  1         109  
  1         7  
  1         6  
  1         112  
  1         16  
  1         7  
  1         116  
  1         915  
  1         7  
  1         128  
  1         11  
  1         4  
  1         124  
  1         17  
  1         4  
  1         119  
  1         769  
  1         4  
  1         104  
  1         8  
  1         2  
  1         83  
  1         17  
  1         5  
  1         115  
  1         738  
  1         3  
  1         106  
  1         8  
  1         3  
  1         78  
  1         17  
  1         5  
  1         116  
  1         784  
  1         9  
  1         167  
  1         11  
  1         4  
  1         98  
  1         286  
  0         0  
  0         0  
  1         7  
  1         3  
  1         84  
  1         18  
  1         5  
  1         120  
  1         898  
  1         8  
  1         109  
  1         7  
  1         2  
  1         112  
  1         19  
  1         5  
  1         125  
  1         948  
  1         5  
  1         131  
  1         12  
  1         6  
  1         115  
  1         20  
  1         4  
  1         123  
  1         19  
  1         5  
  1         122  
  1         11  
  1         5  
  1         87  
  1         18  
  1         4  
  1         137  
  1         785  
  1         5  
  1         104  
  1         7  
  1         8  
  1         82  
  1         17  
  1         5  
  1         112  
  1         20  
  1         4  
  1         152  
  1         13  
  1         5  
  1         85  
  1         20  
  1         5  
  1         148  
  1         11  
  1         7  
  1         87  
  1         18  
  1         4  
  1         120  
  1         795  
  1         5  
  1         102  
  1         11  
  1         5  
  1         93  
  1         7  
  1         5  
  1         86  
  1         20  
  1         5  
  1         126  
  1         12  
  1         5  
  1         81  
  1         17  
  1         18  
  1         141  
  1         825  
  1         5  
  1         105  
  1         8  
  1         2  
  1         101  
  1         11  
  1         2  
  1         87  
  1         18  
  1         5  
  1         121  
  1         723  
  1         4  
  1         111  
  1         7  
  1         3  
  1         102  
  1         264  
  0         0  
  0         0  
  1         8  
  1         6  
  1         84  
  1         245  
  0         0  
  0         0  
  1         7  
  1         2  
  1         85  
  1         195  
  0         0  
  0         0  
  1         10  
  1         8  
  1         82  
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 96 0 33     939 if ($display_errors and (defined $EVAL_ERROR) and ($EVAL_ERROR ne q{})) {
      33        
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 96         554 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 102     102 0 407 sub diag { return debug(@ARG); }
168 0     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 102 50 33 102 0 897 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 102         2171 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 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 11066 50 33 11066 0 102791 if ( $ENV{RPERL_VERBOSE} or $RPerl::VERBOSE ) {
194 0         0 print {*STDOUT} @ARG;
  0         0  
195             }
196 11066         1854403 return 1;
197             }
198              
199             # same as verbose(), except require <ENTER> to continue
200             sub verbose_pause {
201 0 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 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 55 0 33 55 0 105476 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 55         494 return 1;
243             }
244              
245             sub analyze_class_symtab_entries {
246 0     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 0 31 ( 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     83 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         25 my $target_config_pm_loaded = $INC{$target_file_name_config};
305 9 50       360 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         244 ( my $volume_loaded, my $directories_loaded, my $file_loaded ) = File::Spec->splitpath( $target_config_pm_loaded, my $no_file = 0 );
311 9         129 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       42 if ( pop @directories_loaded_split eq q{} ) { pop @directories_loaded_split; }
  9         20  
317 9         190 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         26 my $target_pm_loaded = undef;
324 9 50 33     42 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       43 if ( ( substr $directories_loaded, -1, 1 ) eq q{/} ) {
337 9         22 $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         18 my $target_scripts_found = [];
344 9         24 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         81 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         376 my $sub_inc_paths = [];
353              
354             # push @{$sub_inc_paths}, $inc_path;
355 189         882 ( my $inc_volume, my $inc_directories, my $inc_file ) = File::Spec->splitpath( $inc_path, my $no_file = 1 );
356              
357 189         327 push @{$sub_inc_paths}, $inc_directories;
  189         391  
358              
359 189         872 my @directories_split = File::Spec->splitdir($inc_directories);
360 189         373 pop @directories_split;
361 189         285 push @{$sub_inc_paths}, File::Spec->catdir(@directories_split);
  189         828  
362 189         412 pop @directories_split;
363 189         278 push @{$sub_inc_paths}, File::Spec->catdir(@directories_split);
  189         671  
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         374 my $possible_target_scripts = [];
371 189         336 foreach my $sub_inc_path ( @{$sub_inc_paths} ) {
  189         330  
372 567         865 push @{$possible_target_scripts}, File::Spec->catpath( $inc_volume, $sub_inc_path, $target_file_name_script );
  567         2232  
373 567 100       1253 if ( $sub_inc_path ne q{} ) {
374 522         738 push @{$possible_target_scripts}, File::Spec->catpath( $inc_volume, File::Spec->catdir( $sub_inc_path, 'script' ), $target_file_name_script );
  522         3032  
375 522         1018 push @{$possible_target_scripts}, File::Spec->catpath( $inc_volume, File::Spec->catdir( $sub_inc_path, 'bin' ), $target_file_name_script );
  522         3221  
376             }
377             else {
378 45         79 push @{$possible_target_scripts}, File::Spec->catpath( $inc_volume, 'script', $target_file_name_script );
  45         177  
379 45         82 push @{$possible_target_scripts}, File::Spec->catpath( $inc_volume, 'bin', $target_file_name_script );
  45         201  
380             }
381             }
382              
383 189         323 foreach my $possible_target_script ( @{$possible_target_scripts} ) {
  189         316  
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     15707 if ( ( -f $possible_target_script ) and ( $OSNAME eq 'MSWin32' ? 1 : -x $possible_target_script ) ) {
    50          
389 171         341 my $is_unique = 1;
390 171         240 foreach my $target_script_found ( @{$target_scripts_found} ) {
  171         320  
391 477 100       1014 if ( $target_script_found eq $possible_target_script ) { $is_unique = 0; }
  135         229  
392             }
393 171 100       411 if ($is_unique) { push @{$target_scripts_found}, $possible_target_script; }
  36         79  
  36         80  
394             }
395             }
396              
397 189 50       519 if ( not defined $target_pm_loaded ) {
398 189         1356 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       2167 if ( -f $possible_target_pm ) {
403 27         61 my $is_unique = 1;
404 27         42 foreach my $target_pm_found ( @{$target_pms_found} ) {
  27         55  
405 18 100       69 if ( $target_pm_found eq $possible_target_pm ) {
406 9         33 $is_unique = 0;
407             }
408             }
409 27 100       87 if ($is_unique) { push @{$target_pms_found}, $possible_target_pm; }
  18         34  
  18         78  
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       36 if ( scalar @{$target_scripts_found} == 0 ) {
  9         37  
418 0         0 die 'ERROR EEXRP00: Failed to find `' . $target_file_name_script . '` executable, dying' . "\n";
419             }
420 9         27 my $target_script_found = $target_scripts_found->[0];
421 9 50       19 if ( scalar @{$target_scripts_found} > 1 ) {
  9         31  
422 9         52 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         22 my $target_pm_found = undef;
430 9 50       51 if ( defined $target_pm_loaded ) {
431 0         0 $target_pm_found = $target_pm_loaded;
432             }
433             else {
434              
435 9 50       19 if ( scalar @{$target_pms_found} == 0 ) {
  9         41  
436 0         0 Carp::croak 'ERROR EINRP00: Failed to find ' . $target_file_name_pm . ' module, croaking';
437             }
438 9         19 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         19 $target_pm_found = $target_pm_found_single;
441             }
442             }
443 9 50       38 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         133 ( 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         77 my @directories_target_pm_split = File::Spec->splitdir($directories_target_pm);
464 9         55 my @directories_target_script_split = File::Spec->splitdir($directories_target_script);
465 9         24 my @directories_base_split = ();
466              
467 9         38 for my $i ( 0 .. ( ( scalar @directories_target_pm_split ) - 1 ) ) {
468 18 100       57 if ( $directories_target_pm_split[$i] eq $directories_target_script_split[$i] ) {
469 9         25 push @directories_base_split, $directories_target_pm_split[$i];
470             }
471             else {
472 9         27 for my $j ( 0 .. ( $i - 1 ) ) {
473 9         22 shift @directories_target_pm_split;
474 9         21 shift @directories_target_script_split;
475             }
476 9         96 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         39 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         81 $MY_BASE_PATH = File::Spec->catpath( $volume_loaded, File::Spec->catdir(@directories_base_split), '' );
491 9 50       36 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         57 $MY_INCLUDE_PATH = File::Spec->catdir( $MY_BASE_PATH, @directories_target_pm_split );
499 9         60 $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         31 foreach my $inc_path (@INC) {
505 81         366 $MY_CORE_PATH = File::Spec->catdir( $inc_path, 'CORE' );
506 81         475 my $inc_core_perl_h_path = File::Spec->catfile( $MY_CORE_PATH, 'perl.h' );
507 81 100 66     1487 if ( ( -e $inc_core_perl_h_path ) and ( -r $inc_core_perl_h_path ) and ( -f $inc_core_perl_h_path ) ) { last; }
  9   66     31  
508 72         188 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         86 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