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 |