#!/usr/bin/env perl
our
$VERSION
=
'7.000000'
;
sub
accept_and_verify_input_files {
(
my
string_arrayref
$input_file_names
,
my
string_arrayref
$input_file_names_unlabeled
,
my
string_hashref
$modes
) =
@_
;
RPerl::diag(
"\n\n"
);
RPerl::diag(
'in rperl, have $RPerl::DEBUG = '
.
$RPerl::DEBUG
.
', $ENV{RPERL_DEBUG} = '
. (
$ENV
{RPERL_DEBUG} ||
'<NOT SET>'
) .
"\n"
);
RPerl::diag(
'in rperl, have $RPerl::VERBOSE = '
.
$RPerl::VERBOSE
.
', $ENV{RPERL_VERBOSE} = '
. (
$ENV
{RPERL_VERBOSE} ||
'<NOT SET>'
) .
"\n"
);
if
( (
scalar
@{
$input_file_names_unlabeled
} ) > 0 ) {
if
( (
scalar
@{
$input_file_names
} ) == 0 ) {
$input_file_names
=
$input_file_names_unlabeled
;
}
else
{
die
'ERROR EAR08: Both labeled & unlabeled RPerl source code input file argument(s) specified, dying'
.
"\n"
;
}
}
if
( (
scalar
@{
$input_file_names
} ) == 0 ) {
die
'ERROR EAR01: No RPerl source code input file(s) specified, dying'
.
"\n"
;
}
my
$input_files_count
=
scalar
@{
$input_file_names
};
for
my
$i
( 0 .. (
$input_files_count
- 1 ) ) {
my
string
$input_file_name
=
$input_file_names
->[
$i
];
if
(
$input_file_name
=~ m/\s/xms ) {
my
string_arrayref
$input_file_name_and_args
= [
split
/[ ]/xms,
$input_file_name
];
$input_file_name
=
shift
@{
$input_file_name_and_args
};
$input_file_names
->[
$i
] =
$input_file_name
;
$modes
->{arguments} =
$input_file_name_and_args
;
}
if
( not( -e
$input_file_name
) ) {
die
'ERROR EAR02: Specified RPerl source code input file '
.
q{'}
.
$input_file_name
.
q{'}
.
' does not exist, dying'
.
"\n"
;
}
elsif
( not( -r
$input_file_name
) ) {
die
'ERROR EAR03: Specified RPerl source code input file '
.
q{'}
.
$input_file_name
.
q{'}
.
' is not readable, dying'
.
"\n"
;
}
elsif
( not( -f
$input_file_name
) ) {
die
'ERROR EAR04: Specified RPerl source code input file '
.
q{'}
.
$input_file_name
.
q{'}
.
' is not a plain file, dying'
.
"\n"
;
}
elsif
( (
$input_file_name
!~ /[.]pm$/xms )
and (
$input_file_name
!~ /[.]pl$/xms ) )
{
die
'ERROR EAR05: Specified RPerl source code input file '
.
q{'}
.
$input_file_name
.
q{'}
.
' is not a Perl program ending in '
.
q{'}
. '.pl
' . q{'
}
.
' or module ending in '
.
q{'}
. '.pm
' . q{'
}
.
', dying'
.
"\n"
;
}
while
(((
substr
$input_file_name
, 0, 2) eq
q{./}
) or ((
substr
$input_file_name
, 0, 2) eq
q{.\\}
)) {
substr
$input_file_name
, 0, 2,
q{}
;
$input_file_names
->[
$i
] =
$input_file_name
;
}
}
return
$input_file_names
;
}
sub
verify_and_default_modes {
(
my
string_hashref
$modes
,
my
string_hashref
$modes_default
,
my
arrayref_hashref
$modes_supported
,
my
integer
$magic_low_flag
,
my
integer
$magic_medium_flag
,
my
integer
$magic_high_flag
,
my
integer
$dependencies_flag
,
my
integer
$uncompile_flag
,
my
integer
$compile_flag
,
my
integer
$subcompile_assemble_flag
,
my
integer
$subcompile_archive_flag
,
my
integer
$subcompile_shared_flag
,
my
integer
$subcompile_static_flag
,
my
integer
$subcompile_CXX
,
my
integer
$parallel_flag
,
my
integer
$num_cores
,
my
integer
$execute_flag
,
my
integer
$test_flag
,
my
string_arrayref
$input_file_names
) =
@_
;
if
(
defined
$dependencies_flag
) {
if
(
$dependencies_flag
) {
$modes
->{dependencies} =
'ON'
;
}
else
{
$modes
->{dependencies} =
'OFF'
;
}
}
if
(
defined
$magic_low_flag
) {
if
(
$magic_low_flag
) {
if
( (
defined
$magic_medium_flag
) and
$magic_medium_flag
) {
die
'ERROR EAR18: Incompatible command-line argument flags provided, both --low and --medium, dying'
.
"\n"
;
}
if
( (
defined
$magic_high_flag
) and
$magic_high_flag
) {
die
'ERROR EAR18: Incompatible command-line argument flags provided, both --low and --high, dying'
.
"\n"
;
}
$modes
->{magic} =
'LOW'
;
}
}
if
(
defined
$magic_medium_flag
) {
if
(
$magic_medium_flag
) {
if
( (
defined
$magic_high_flag
) and
$magic_high_flag
) {
die
'ERROR EAR19: Incompatible command-line argument flags provided, both --medium and --high, dying'
.
"\n"
;
}
$modes
->{magic} =
'MEDIUM'
;
}
}
if
(
defined
$magic_high_flag
) {
if
(
$magic_high_flag
) {
$modes
->{magic} =
'HIGH'
;
}
}
if
(
defined
$uncompile_flag
) {
if
(
$uncompile_flag
) {
if
( (
defined
$compile_flag
) and
$compile_flag
) {
die
'ERROR EAR09: Incompatible command-line argument flags provided, both --uncompile and --compile, dying'
.
"\n"
;
}
if
( (
defined
$execute_flag
) and
$execute_flag
) {
die
'ERROR EAR09: Incompatible command-line argument flags provided, both --uncompile and --execute, dying'
.
"\n"
;
}
if
( (
defined
$test_flag
) and
$test_flag
) {
die
'ERROR EAR09: Incompatible command-line argument flags provided, both --uncompile and --test, dying'
.
"\n"
;
}
if
(
$uncompile_flag
== 1) {
$modes
->{uncompile} =
'SOURCE'
; }
if
(
$uncompile_flag
== 2) {
$modes
->{uncompile} =
'SOURCE_BINARY'
; }
if
(
$uncompile_flag
== 3) {
$modes
->{uncompile} =
'SOURCE_BINARY_INLINE'
; }
$modes
->{execute} =
'OFF'
;
}
else
{
$modes
->{uncompile} =
'OFF'
;
}
}
if
(
defined
$compile_flag
) {
if
(
$compile_flag
) {
$modes
->{compile} =
'SUBCOMPILE'
;
}
else
{
if
((
defined
$subcompile_assemble_flag
) and
$subcompile_assemble_flag
) {
die
'ERROR EAR10: Incompatible command-line argument flags provided, both --nocompile and --assemble, dying'
.
"\n"
;
}
if
( (
defined
$subcompile_archive_flag
) and
$subcompile_archive_flag
) {
die
'ERROR EAR10: Incompatible command-line argument flags provided, both --nocompile and --archive, dying'
.
"\n"
;
}
if
( (
defined
$subcompile_shared_flag
) and
$subcompile_shared_flag
) {
die
'ERROR EAR10: Incompatible command-line argument flags provided, both --nocompile and --shared, dying'
.
"\n"
;
}
if
( (
defined
$subcompile_static_flag
) and
$subcompile_static_flag
) {
die
'ERROR EAR10: Incompatible command-line argument flags provided, both --nocompile and --static, dying'
.
"\n"
;
}
$modes
->{compile} =
'GENERATE'
;
}
}
if
((
defined
$subcompile_assemble_flag
) and
$subcompile_assemble_flag
) {
if
( (
defined
$subcompile_archive_flag
) and
$subcompile_archive_flag
) {
die
'ERROR EAR11: Incompatible command-line argument flags provided, both --assemble and --archive, dying'
.
"\n"
;
}
if
( (
defined
$subcompile_shared_flag
) and
$subcompile_shared_flag
) {
die
'ERROR EAR11: Incompatible command-line argument flags provided, both --assemble and --shared, dying'
.
"\n"
;
}
if
( (
defined
$subcompile_static_flag
) and
$subcompile_static_flag
) {
die
'ERROR EAR11: Incompatible command-line argument flags provided, both --assemble and --static, dying'
.
"\n"
;
}
if
( (
defined
$execute_flag
) and
$execute_flag
) {
die
'ERROR EAR11: Incompatible command-line argument flags provided, both --assemble and --execute, dying'
.
"\n"
;
}
if
( (
defined
$test_flag
) and
$test_flag
) {
die
'ERROR EAR11: Incompatible command-line argument flags provided, both --assemble and --test, dying'
.
"\n"
;
}
$modes
->{compile} =
'SUBCOMPILE'
;
$modes
->{subcompile} =
'ASSEMBLE'
;
$modes
->{execute} =
'OFF'
;
}
if
((
defined
$subcompile_archive_flag
) and
$subcompile_archive_flag
) {
if
( (
defined
$subcompile_shared_flag
) and
$subcompile_shared_flag
) {
die
'ERROR EAR12: Incompatible command-line argument flags provided, both --archive and --shared, dying'
.
"\n"
;
}
if
( (
defined
$subcompile_static_flag
) and
$subcompile_static_flag
) {
die
'ERROR EAR12: Incompatible command-line argument flags provided, both --archive and --static, dying'
.
"\n"
;
}
if
( (
defined
$execute_flag
) and
$execute_flag
) {
die
'ERROR EAR12: Incompatible command-line argument flags provided, both --archive and --execute, dying'
.
"\n"
;
}
if
( (
defined
$test_flag
) and
$test_flag
) {
die
'ERROR EAR12: Incompatible command-line argument flags provided, both --archive and --test, dying'
.
"\n"
;
}
$modes
->{compile} =
'SUBCOMPILE'
;
$modes
->{subcompile} =
'ARCHIVE'
;
$modes
->{execute} =
'OFF'
;
}
if
((
defined
$subcompile_shared_flag
) and
$subcompile_shared_flag
) {
if
( (
defined
$subcompile_static_flag
) and
$subcompile_static_flag
) {
die
'ERROR EAR13: Incompatible command-line argument flags provided, both --shared and --static, dying'
.
"\n"
;
}
if
( (
defined
$execute_flag
) and
$execute_flag
) {
die
'ERROR EAR13: Incompatible command-line argument flags provided, both --shared and --execute, dying'
.
"\n"
;
}
if
( (
defined
$test_flag
) and
$test_flag
) {
die
'ERROR EAR13: Incompatible command-line argument flags provided, both --shared and --test, dying'
.
"\n"
;
}
$modes
->{compile} =
'SUBCOMPILE'
;
$modes
->{subcompile} =
'SHARED'
;
$modes
->{execute} =
'OFF'
;
}
if
((
defined
$subcompile_static_flag
) and
$subcompile_static_flag
) {
if
(
$subcompile_static_flag
) {
if
( (
defined
$test_flag
) and
$test_flag
) {
die
'ERROR EAR14: Incompatible command-line argument flags provided, both --static and --test, dying'
.
"\n"
;
}
foreach
my
string
$input_file_name
(@{
$input_file_names
}) {
if
(
$input_file_name
=~ /[.]pm$/xms ) {
die
'ERROR EAR15: Incompatible command-line arguments provided, both --static subcompile mode flag and *.pm Perl module input file(s), dying'
.
"\n"
;
}
}
$modes
->{compile} =
'SUBCOMPILE'
;
$modes
->{subcompile} =
'STATIC'
;
}
else
{
$modes
->{compile} =
'SUBCOMPILE'
;
$modes
->{subcompile} =
'DYNAMIC'
;
}
}
if
(
defined
$subcompile_CXX
) {
if
(
$subcompile_CXX
=~ m/^\s*$/gxms) {
die
'ERROR EAR16: Undefined, empty, or all-whitespace CXX command-line argument provided, dying'
.
"\n"
;
}
else
{
$modes
->{CXX} =
$subcompile_CXX
;
}
}
if
(
defined
$parallel_flag
) {
if
(
$parallel_flag
) {
$modes
->{parallel} =
'OPENMP'
;
}
else
{
$modes
->{parallel} =
'OFF'
;
}
}
if
(
defined
$num_cores
) {
if
(
$num_cores
=~ m/^\s*$/gxms) {
die
'ERROR EAR17: Undefined, empty, or all-whitespace CXX command-line argument provided, dying'
.
"\n"
;
}
else
{
$modes
->{num_cores} =
$num_cores
;
}
}
if
(
defined
$execute_flag
) {
if
(
$execute_flag
) {
$modes
->{execute} =
'ON'
;
}
else
{
$modes
->{execute} =
'OFF'
;
}
}
if
((
defined
$test_flag
) and
$test_flag
) {
$modes
->{ops} =
'PERL'
;
$modes
->{types} =
'PERL'
;
$modes
->{compile} =
'GENERATE'
;
}
if
(
$RPerl::DEBUG
) {
$ENV
{RPERL_DEBUG} =
$RPerl::DEBUG
;
}
if
(
$RPerl::VERBOSE
) {
$ENV
{RPERL_VERBOSE} =
$RPerl::VERBOSE
;
}
foreach
my
string
$mode_key
(
keys
%{
$modes
} ) {
if
( not(
exists
$modes_supported
->{
$mode_key
} ) ) {
die
"ERROR EAR06: Unsupported or invalid mode category '$mode_key' specified, supported categories are ("
.
join
(
', '
,
sort
keys
%{
$modes_supported
} )
.
'), dying'
.
"\n"
;
}
elsif
( (
defined
$modes_supported
->{
$mode_key
} ) and not(
grep
{
$_
eq
$modes
->{
$mode_key
} } @{
$modes_supported
->{
$mode_key
} } ) ) {
die
'ERROR EAR07: Unsupported or invalid mode '
.
q{'}
.
$modes
->{
$mode_key
} .
q{'}
.
' in mode category '
.
q{'}
.
$mode_key
.
q{'}
.
' specified, supported modes are ('
.
join
(
', '
,
sort
@{
$modes_supported
->{
$mode_key
} } )
.
'), dying'
.
"\n"
;
}
}
$modes
->{_symbol_table} = {
_namespace
=>
q{}
,
_subroutine
=>
q{}
};
foreach
my
string
$mode_default_key
(
keys
%{
$modes_default
} ) {
if
( not(
exists
$modes
->{
$mode_default_key
} ) ) {
$modes
->{
$mode_default_key
} =
$modes_default
->{
$mode_default_key
};
}
}
if
(
$modes
->{compile} ne
'SUBCOMPILE'
) {
$modes
->{subcompile} =
'OFF'
;
}
1;
return
$modes
;
}
sub
verbose_versions {
RPerl::verbose(
'RPERL VERBOSE VERSIONS & OTHER CONFIG INFO'
.
"\n\n"
);
RPerl::verbose(
q{$RPerl::VERSION using CPAN's underscore-is-beta numbering scheme }
.
$RPerl::VERSION
.
"\n"
);
RPerl::verbose(
q{$RPerl::VERSION using RPerl's underscore-is-comma numbering scheme }
. RPerl::DataType::Number::number_to_string(RPerl::DataType::String::string_to_number(
$RPerl::VERSION
)) .
"\n"
);
RPerl::verbose(
q{ rperl $VERSION using CPAN's underscore-is-beta numbering scheme }
.
$VERSION
.
"\n"
);
RPerl::verbose(
q{ rperl $VERSION using RPerl's underscore-is-comma numbering scheme }
. RPerl::DataType::Number::number_to_string(RPerl::DataType::String::string_to_number(
$VERSION
)) .
"\n\n"
);
my
string
$ccflags
= [ config_re(
'ccflags'
) ]->[0];
substr
$ccflags
, 0, 9,
q{}
;
substr
$ccflags
, -1, 1,
q{}
;
RPerl::verbose(
q{ Perl config_re('ccflags') }
.
$ccflags
.
"\n"
);
my
string
$cccdlflags
= [ config_re(
'cccdlflags'
) ]->[0];
substr
$cccdlflags
, 0, 12,
q{}
;
substr
$cccdlflags
, -1, 1,
q{}
;
RPerl::verbose(
q{ Perl config_re('cccdlflags') }
.
$cccdlflags
.
"\n"
);
RPerl::verbose(
'$RPerl::Inline::CCFLAGSEX '
.
$RPerl::Inline::CCFLAGSEX
.
"\n"
);
RPerl::verbose(
'$RPerl::Inline::ARGS{optimize} '
.
$RPerl::Inline::ARGS
{optimize} .
"\n\n"
);
RPerl::verbose(
'$RPerl::CHECK '
.
$RPerl::CHECK
.
"\n"
);
RPerl::verbose(
'$RPerl::DEBUG '
.
$RPerl::DEBUG
.
"\n"
);
RPerl::verbose(
'$ENV{RPERL_DEBUG} '
. (
$ENV
{RPERL_DEBUG} or
'[ NOT SET ]'
) .
"\n"
);
RPerl::verbose(
'$RPerl::VERBOSE '
.
$RPerl::VERBOSE
.
"\n"
);
RPerl::verbose(
'$ENV{RPERL_VERBOSE} '
. (
$ENV
{RPERL_VERBOSE} or
'[ NOT SET ]'
) .
"\n"
);
RPerl::verbose(
'$RPerl::WARNINGS '
.
$RPerl::WARNINGS
.
"\n"
);
RPerl::verbose(
'$ENV{RPERL_WARNINGS} '
. (
$ENV
{RPERL_WARNINGS} or
'[ NOT SET ]'
) .
"\n"
);
RPerl::verbose(
'$RPerl::TYPES_CCFLAG '
.
$RPerl::TYPES_CCFLAG
.
' [ HARD-CODED DEFAULT ]'
.
"\n"
);
RPerl::verbose(
'$RPerl::BASE_PATH '
.
$RPerl::BASE_PATH
.
"\n"
);
RPerl::verbose(
'$RPerl::INCLUDE_PATH '
.
$RPerl::INCLUDE_PATH
.
"\n"
);
RPerl::verbose(
'$RPerl::SCRIPT_PATH '
.
$RPerl::SCRIPT_PATH
.
"\n"
);
RPerl::verbose(
'$RPerl::CORE_PATH '
.
$RPerl::CORE_PATH
.
"\n"
);
return
;
}
sub
verbose_multi_file_settings {
(
my
string_arrayref
$input_file_names
,
my
hashref_arrayref
$output_file_name_groups
,
my
integer
$input_files_count
,
my
hashref_hashref
$filename_suffixes_supported
,
my
string_hashref
$modes
) =
@_
;
if
(
$input_files_count
> 1 ) {
RPerl::verbose( multi_file_settings(
$input_file_names
,
$output_file_name_groups
,
$input_files_count
,
$filename_suffixes_supported
,
$modes
) );
RPerl::verbose_pause(
"\n"
.
'PRESS <ENTER> TO CONTINUE'
.
"\n"
);
}
return
;
}
sub
diag_multi_file_settings {
(
my
string_arrayref
$input_file_names
,
my
hashref_arrayref
$output_file_name_groups
,
my
integer
$input_files_count
,
my
hashref_hashref
$filename_suffixes_supported
,
my
string_hashref
$modes
) =
@_
;
if
(
$input_files_count
> 1 ) {
RPerl::diag( multi_file_settings(
$input_file_names
,
$output_file_name_groups
,
$input_files_count
,
$filename_suffixes_supported
,
$modes
) );
RPerl::diag_pause(
"\n"
.
'PRESS <ENTER> TO CONTINUE'
.
"\n"
);
}
return
;
}
sub
multi_file_settings {
(
my
string_arrayref
$input_file_names
,
my
hashref_arrayref
$output_file_name_groups
,
my
integer
$input_files_count
,
my
hashref_hashref
$filename_suffixes_supported
,
my
string_hashref
$modes
) =
@_
;
my
string
$retval
=
q{}
;
$retval
.=
'Input File(s):'
.
"\n"
;
foreach
my
string
$input_file_name
( @{
$input_file_names
} ) {
$retval
.=
q{ }
.
$input_file_name
.
"\n"
;
}
$retval
.=
'Output File(s):'
.
"\n"
;
foreach
my
string_hashref
$output_file_name_group
( @{
$output_file_name_groups
} ) {
$retval
.=
q{ }
. stringify_output_file_name_group(
$output_file_name_group
,
$filename_suffixes_supported
) .
"\n"
;
}
$retval
.=
'Modes:'
.
"\n"
;
foreach
my
string
$mode_key
(
sort
keys
%{
$modes
} ) {
$retval
.=
q{ }
.
$mode_key
.
' => '
.
$modes
->{
$mode_key
} .
"\n"
;
}
return
$retval
;
}
sub
store_unlabeled_arguments {
(
my
unknown
$argument
) =
@_
;
push
@{$::input_file_names_unlabeled},
$argument
;
return
;
}
sub
verbose_flags {
my
integer
$magic_low_flag
,
my
integer
$magic_medium_flag
,
my
integer
$magic_high_flag
,
(
my
integer
$dependencies_flag
,
my
integer
$uncompile_flag
,
my
integer
$compile_flag
,
my
integer
$subcompile_assemble_flag
,
my
integer
$subcompile_archive_flag
,
my
integer
$subcompile_shared_flag
,
my
integer
$subcompile_static_flag
,
my
integer
$parallel_flag
,
my
integer
$execute_flag
,
my
integer
$test_flag
) =
@_
;
RPerl::verbose(
'Verbose Flag......... '
.
$RPerl::VERBOSE
.
"\n"
);
RPerl::verbose(
'Debug Flag........... '
.
$RPerl::DEBUG
.
"\n"
);
if
(
defined
$dependencies_flag
) {
RPerl::verbose(
'Dependencies Flag.... '
.
$dependencies_flag
.
"\n"
);
}
if
(
defined
$magic_low_flag
) {
RPerl::verbose(
'Low Magic Flag....... '
.
$magic_low_flag
.
"\n"
);
}
if
(
defined
$magic_medium_flag
) {
RPerl::verbose(
'Medium Magic Flag.... '
.
$magic_medium_flag
.
"\n"
);
}
if
(
defined
$magic_high_flag
) {
RPerl::verbose(
'High Magic Flag...... '
.
$magic_high_flag
.
"\n"
);
}
if
(
defined
$uncompile_flag
) {
RPerl::verbose(
'Uncompile Flag....... '
.
$uncompile_flag
.
"\n"
);
}
if
(
defined
$compile_flag
) {
RPerl::verbose(
'Compile Flag......... '
.
$compile_flag
.
"\n"
);
}
if
(
defined
$subcompile_archive_flag
) {
RPerl::verbose(
'Archive Flag......... '
.
$subcompile_archive_flag
.
"\n"
);
}
if
(
defined
$subcompile_assemble_flag
) {
RPerl::verbose(
'Assemble Flag........ '
.
$subcompile_assemble_flag
.
"\n"
);
}
if
(
defined
$subcompile_shared_flag
) {
RPerl::verbose(
'Shared Flag.......... '
.
$subcompile_shared_flag
.
"\n"
);
}
if
(
defined
$subcompile_static_flag
) {
RPerl::verbose(
'Static Flag.......... '
.
$subcompile_static_flag
.
"\n"
);
}
if
(
defined
$parallel_flag
) {
RPerl::verbose(
'Parallel Flag........ '
.
$parallel_flag
.
"\n"
);
}
if
(
defined
$execute_flag
) {
RPerl::verbose(
'Execute Flag......... '
.
$execute_flag
.
"\n"
);
}
if
(
defined
$test_flag
) {
RPerl::verbose(
'Test Flag............ '
.
$test_flag
.
"\n"
);
}
}
sub
stringify_output_file_name_group {
(
my
string_hashref
$output_file_name_group
,
my
hashref_hashref
$filename_suffixes_supported
) =
@_
;
my
string
$output_file_names
=
q{}
;
foreach
my
string
$suffix_key
(
sort
@{[
keys
%{
$filename_suffixes_supported
->{OUTPUT_SOURCE}},
keys
%{
$filename_suffixes_supported
->{OUTPUT_BINARY}}]}) {
if
(
exists
$output_file_name_group
->{
$suffix_key
} ) {
$output_file_names
.=
$output_file_name_group
->{
$suffix_key
};
if
(
exists
$output_file_name_group
->{
'_'
.
$suffix_key
.
'_label'
} ) {
$output_file_names
.=
$output_file_name_group
->{
'_'
.
$suffix_key
.
'_label'
};
}
$output_file_names
.=
q{ }
;
}
}
if
( (
length
$output_file_names
) > 55 ) {
my
@output_file_names_split
=
split
q{ }
,
$output_file_names
;
my
boolean
$is_first
= 1;
foreach
my
string
$output_file_name
(
@output_file_names_split
) {
if
(
$is_first
) {
$output_file_names
=
$output_file_name
;
$is_first
= 0;
}
else
{
$output_file_names
.=
"\n"
. (
q{ }
x 20 ) .
$output_file_name
;
}
}
}
return
$output_file_names
;
}
sub
depends_delete {
(
my
string_arrayref
$input_file_names
,
my
hashref_arrayref
$output_file_name_groups
,
my
string_arrayref
$output_file_name_prefixes
,
my
integer
$input_files_count
,
my
hashref_hashref
$filename_suffixes_supported
,
my
string_hashref
$modes
) =
@_
;
for
my
$i
( 0 .. (
$input_files_count
- 1 ) ) {
my
string
$input_file_name
=
$input_file_names
->[
$i
];
my
string_hashref
$output_file_name_group
=
$output_file_name_groups
->[
$i
];
if
(
$input_files_count
> 1 ) {
RPerl::verbose_clear_screen();
RPerl::verbose(
'Input File Number: '
. (
$i
+ 1 ) .
' of '
.
$input_files_count
.
"\n"
);
}
RPerl::verbose(
'Input File: '
.
$input_file_name
.
"\n"
);
RPerl::verbose(
'Output File(s): '
. stringify_output_file_name_group(
$output_file_name_group
,
$filename_suffixes_supported
) .
"\n"
);
RPerl::verbose(
'Modes: magic => '
.
$modes
->{magic}
.
', code => '
.
$modes
->{code}
.
', ops => '
.
$modes
->{ops}
.
', check => '
.
$modes
->{types}
.
', check => '
.
$modes
->{check}
.
', uncompile => '
.
$modes
->{uncompile}
.
', compile => '
.
$modes
->{compile}
.
', subcompile => '
.
$modes
->{subcompile}
.
', parallel => '
.
$modes
->{parallel}
.
', execute => '
.
$modes
->{execute}
.
', label => '
.
$modes
->{label}
.
"\n\n"
);
my
string_arrayref
$input_file_name_deps
= [
$input_file_name
];
my
integer
$input_file_and_deps_count
;
my
integer
$input_file_deps_count
= 0;
my
hashref_arrayref
$output_file_name_dep_groups
= [
$output_file_name_group
];
if
(
$modes
->{dependencies} eq
'ON'
) {
$input_file_name_deps
= RPerl::Compiler::find_dependencies(
$input_file_name
, 1,
$modes
);
RPerl::verbose(
'DEPENDENCIES: Follow & find all deps... '
);
if
(
exists
$input_file_name_deps
->[0] ) {
$input_file_name_deps
= accept_and_verify_input_files(
$input_file_name_deps
, [],
$modes
);
}
$input_file_name_deps
= [ @{
$input_file_name_deps
},
$input_file_name
];
$input_file_and_deps_count
=
scalar
@{
$input_file_name_deps
};
$input_file_deps_count
=
$input_file_and_deps_count
- 1;
$output_file_name_dep_groups
= RPerl::Compiler::generate_output_file_names(
$input_file_name_deps
,
$output_file_name_prefixes
,
$input_file_and_deps_count
,
$modes
);
RPerl::verbose(
sprintf
(
"%4d"
,
$input_file_deps_count
) .
' found.'
.
"\n"
);
diag_multi_file_settings(
$input_file_name_deps
,
$output_file_name_dep_groups
,
$input_file_and_deps_count
,
$filename_suffixes_supported
,
$modes
);
}
if
(not ((
$modes
->{uncompile} eq
'INLINE'
) or ((
$input_file_name
=~ /[.]pm$/xms) and (
$modes
->{subcompile} eq
'DYNAMIC'
) and (
$modes
->{uncompile} !~ m/SOURCE/gxms)) )) {
for
my
$j
( 0 ..
$input_file_deps_count
) {
my
string
$input_file_name_dep
=
$input_file_name_deps
->[
$j
];
my
string_hashref
$output_file_name_dep_group
=
$output_file_name_dep_groups
->[
$j
];
if
(
$j
<
$input_file_deps_count
) {
RPerl::verbose(
"\n"
.
'Dep Output File(s): '
. stringify_output_file_name_group(
$output_file_name_dep_group
,
$filename_suffixes_supported
) .
"\n"
);
}
elsif
(
$input_file_deps_count
> 1) {
RPerl::verbose(
"\n"
.
'Output File(s): '
. stringify_output_file_name_group(
$output_file_name_dep_group
,
$filename_suffixes_supported
) .
"\n"
);
}
RPerl::verbose(
'UNLINK PHASE 0: Delete files from disk...'
);
foreach
my
string
$output_file_name_key
(
keys
%{
$output_file_name_dep_group
} ) {
if
((
substr
$output_file_name_key
, 0, 1) eq
'_'
) {
next
; }
if
((
$modes
->{uncompile} eq
'SOURCE_BINARY_INLINE'
) or
(
$modes
->{uncompile} eq
'SOURCE_BINARY'
) or
((
$modes
->{uncompile} eq
'SOURCE'
) and (
exists
$filename_suffixes_supported
->{OUTPUT_SOURCE}->{
$output_file_name_key
})) or
((
$modes
->{uncompile} eq
'BINARY'
) and (
exists
$filename_suffixes_supported
->{OUTPUT_BINARY}->{
$output_file_name_key
}))) {
my
string
$output_file_name
=
$output_file_name_dep_group
->{
$output_file_name_key
};
if
( -f
$output_file_name
) {
unlink
$output_file_name
or
die
"\nERROR EUNFI00, UNCOMPILER, FILE SYSTEM: Cannot delete existing file '$output_file_name',\ndying: $OS_ERROR"
;
}
}
}
RPerl::verbose(
' done.'
.
"\n"
);
}
}
if
( ( (
$modes
->{uncompile} =~ m/INLINE/gxms) or
((
$input_file_name
=~ /[.]pm$/xms) and (
$modes
->{subcompile} eq
'DYNAMIC'
) and (
$modes
->{uncompile} =~ m/BINARY/gxms))
) and
( -d
'_Inline'
)) {
RPerl::verbose( (
"\n"
x (
$input_files_count
- 1 ) ) .
'UNLINK PHASE 1: Delete _Inline/ from disk...'
);
remove_tree(
'_Inline'
, {
error
=> \
my
$error_hashes
} );
if
( @{
$error_hashes
} ) {
foreach
my
string_hashref
$error_hash
( @{
$error_hashes
} ) {
my
(
$file_name
,
$error_message
) = %{
$error_hash
};
if
(
$file_name
eq
''
) {
die
"\nERROR EUNFI01, UNCOMPILER, FILE SYSTEM: Cannot delete folder '_Inline', general error, \ndying: $error_message"
;
}
else
{
die
"\nERROR EUNFI01, UNCOMPILER, FILE SYSTEM: Cannot delete folder '_Inline', error deleting file '$file_name', \ndying: $error_message"
;
}
}
}
RPerl::verbose(
' done.'
.
"\n"
);
}
if
( (
$input_files_count
> 1 ) and (
$i
< (
$input_files_count
- 1 ) ) ) {
RPerl::verbose_pause(
"\nPRESS <ENTER> TO CONTINUE\n"
);
}
}
return
;
}
sub
depends_parse_generate_save_subcompile_execute {
(
my
string_arrayref
$input_file_names
,
my
hashref_arrayref
$output_file_name_groups
,
my
string_arrayref
$output_file_name_prefixes
,
my
integer
$input_files_count
,
my
hashref_hashref
$filename_suffixes_supported
,
my
string_hashref
$modes
) =
@_
;
if
(
$modes
->{ops} eq
'PERL'
) {
if
(
$modes
->{compile} eq
'SUBCOMPILE'
) {
$modes
->{compile} =
'SAVE'
;
}
if
(
$modes
->{types} eq
'CPP'
) {
$modes
->{types} =
'PERL'
; }
}
if
(
$input_files_count
> 1 ) {
$modes
->{execute} =
'OFF'
;
}
for
my
$i
( 0 .. (
$input_files_count
- 1 ) ) {
my
string
$input_file_name
=
$input_file_names
->[
$i
];
my
string_hashref
$output_file_name_group
=
$output_file_name_groups
->[
$i
];
$modes
->{_input_file_name} =
$input_file_name
;
$modes
->{_input_file_name_current} =
$input_file_name
;
$modes
->{_symbol_table} = {
_namespace
=>
q{}
,
_subroutine
=>
q{}
};
if
( (
$modes
->{execute} eq
'ON'
) and (
$input_file_name
!~ /[.]pl$/xms ) ) {
$modes
->{execute} =
'OFF'
;
}
if
(
$input_files_count
> 1 ) {
RPerl::verbose_clear_screen();
RPerl::verbose(
'Input File Number: '
. (
$i
+ 1 ) .
' of '
.
$input_files_count
.
"\n"
);
}
RPerl::verbose(
'Input File: '
.
$input_file_name
.
"\n"
);
RPerl::verbose(
'Output File(s): '
. stringify_output_file_name_group(
$output_file_name_group
,
$filename_suffixes_supported
) .
"\n"
);
RPerl::verbose(
'Modes: magic => '
.
$modes
->{magic}
.
', code => '
.
$modes
->{code}
.
', ops => '
.
$modes
->{ops}
.
', types => '
.
$modes
->{types}
.
', check => '
.
$modes
->{check}
.
', uncompile => '
.
$modes
->{uncompile}
.
', compile => '
.
$modes
->{compile}
.
', subcompile => '
.
$modes
->{subcompile}
.
', parallel => '
.
$modes
->{parallel}
.
', execute => '
.
$modes
->{execute}
.
', label => '
.
$modes
->{label}
.
"\n\n"
);
my
string_arrayref
$input_file_name_deps
= [
$input_file_name
];
my
integer
$input_file_and_deps_count
;
my
integer
$input_file_deps_count
= 0;
my
hashref_arrayref
$output_file_name_dep_groups
= [
$output_file_name_group
];
my
hashref_arrayref
$source_dep_groups
= [];
if
(
$modes
->{dependencies} eq
'ON'
) {
$input_file_name_deps
= RPerl::Compiler::find_dependencies(
$input_file_name
, 1,
$modes
);
RPerl::verbose(
'DEPENDENCIES: Follow & find all deps... '
);
if
(
exists
$input_file_name_deps
->[0] ) {
$input_file_name_deps
= accept_and_verify_input_files(
$input_file_name_deps
, [],
$modes
);
}
$input_file_name_deps
= [ @{
$input_file_name_deps
},
$input_file_name
];
$input_file_and_deps_count
=
scalar
@{
$input_file_name_deps
};
$input_file_deps_count
=
$input_file_and_deps_count
- 1;
$output_file_name_dep_groups
= RPerl::Compiler::generate_output_file_names(
$input_file_name_deps
,
$output_file_name_prefixes
,
$input_file_and_deps_count
,
$modes
);
RPerl::verbose(
sprintf
(
"%4d"
,
$input_file_deps_count
) .
' found.'
.
"\n"
);
diag_multi_file_settings(
$input_file_name_deps
,
$output_file_name_dep_groups
,
$input_file_and_deps_count
,
$filename_suffixes_supported
,
$modes
);
}
if
( (
$input_file_deps_count
> 0 ) and (
$modes
->{compile} ne
'PARSE'
) ) {
$modes
->{_compile_saved} =
$modes
->{compile};
$modes
->{compile} =
'GENERATE'
;
}
for
my
$j
( 0 ..
$input_file_deps_count
) {
my
string
$input_file_name_dep
=
$input_file_name_deps
->[
$j
];
my
string_hashref
$output_file_name_dep_group
=
$output_file_name_dep_groups
->[
$j
];
$modes
->{_input_file_name_current} =
$input_file_name_dep
;
if
(
$input_file_deps_count
> 0 ) {
if
(
$j
<
$input_file_deps_count
) {
RPerl::verbose(
"\n"
.
'Dep Input File: '
.
$input_file_name_dep
.
"\n"
);
}
else
{
RPerl::verbose(
"\n"
.
'Input File: '
.
$input_file_name_dep
.
"\n"
);
}
}
if
(
$modes
->{ops} eq
'PERL'
) {
$source_dep_groups
->[
$j
] = RPerl::Compiler::rperl_to_rperl__parse_generate(
$input_file_name_dep
,
$output_file_name_dep_group
, {},
$modes
);
}
elsif
(
$modes
->{ops} eq
'CPP'
) {
my
integer
$eval_retval
=
eval
{
$source_dep_groups
->[
$j
]
= RPerl::Compiler::rperl_to_xsbinary__parse_generate_compile(
$input_file_name_dep
,
$output_file_name_dep_group
, {},
$modes
);
1;
};
if
( not
defined
$eval_retval
) {
print
$EVAL_ERROR
;
$modes
->{compile} =
'GENERATE'
;
$modes
->{_compile_saved} =
'GENERATE'
;
$modes
->{subcompile} =
'OFF'
;
$modes
->{execute} =
'OFF'
;
$modes
->{_bailout_message} =
"\n"
.
'BAILING OUT: One or more problems encountered, see error messages above for details, dying'
.
"\n"
;
}
}
}
if
( (
$input_file_deps_count
> 0 )
and (
$modes
->{compile} ne
'PARSE'
)
and ( (
$modes
->{_compile_saved} eq
'SAVE'
) or (
$modes
->{_compile_saved} eq
'SUBCOMPILE'
) ) )
{
RPerl::verbose(
"\n"
.
'DEPENDENCIES: Complete deferred actions...'
.
"\n"
);
for
my
$j
( 0 ..
$input_file_deps_count
) {
$modes
->{compile} =
$modes
->{_compile_saved} .
'_DEFERRED'
;
my
string
$input_file_name_dep
=
$input_file_name_deps
->[
$j
];
my
string_hashref
$output_file_name_dep_group
=
$output_file_name_dep_groups
->[
$j
];
my
string_hashref
$source_dep_group
=
$source_dep_groups
->[
$j
];
if
(
$j
<
$input_file_deps_count
) {
RPerl::verbose(
"\n"
.
'Dep Output File(s): '
. stringify_output_file_name_group(
$output_file_name_dep_group
,
$filename_suffixes_supported
) .
"\n"
);
}
else
{
RPerl::verbose(
"\n"
.
'Output File(s): '
. stringify_output_file_name_group(
$output_file_name_dep_group
,
$filename_suffixes_supported
) .
"\n"
);
}
if
(
$modes
->{ops} eq
'PERL'
) {
RPerl::Compiler::rperl_to_rperl__parse_generate(
$input_file_name_dep
,
$output_file_name_dep_group
,
$source_dep_group
,
$modes
);
}
elsif
(
$modes
->{ops} eq
'CPP'
) {
if
( (
$j
<
$input_file_deps_count
) and (
$modes
->{compile} eq
'SUBCOMPILE_DEFERRED'
) ) {
$modes
->{compile} =
'SAVE_DEFERRED'
;
}
my
integer
$eval_retval
=
eval
{
RPerl::Compiler::rperl_to_xsbinary__parse_generate_compile(
$input_file_name_dep
,
$output_file_name_dep_group
,
$source_dep_group
,
$modes
);
1;
};
if
( not
defined
$eval_retval
) {
print
$EVAL_ERROR
;
$modes
->{execute} =
'OFF'
;
}
}
}
}
if
(
$modes
->{execute} eq
'ON'
) {
RPerl::verbose(
'EXECUTE: Run code...'
.
"\n"
);
RPerl::verbose(
"\n"
);
if
((
$modes
->{ops} eq
'CPP'
) and (
$modes
->{compile} eq
'SUBCOMPILE'
)) {
my
$execute_file_name
=
$output_file_name_group
->{EXE};
if
(
defined
$modes
->{arguments} ) {
my
integer
$execute_retval
=
system
(
$execute_file_name
, @{
$modes
->{arguments} } );
}
else
{
my
integer
$execute_retval
=
system
(
$execute_file_name
);
}
}
else
{
if
(
defined
$modes
->{arguments} ) {
my
integer
$execute_retval
=
system
(
$EXECUTABLE_NAME
,
$input_file_name
, @{
$modes
->{arguments} } );
}
else
{
my
integer
$execute_retval
=
system
(
$EXECUTABLE_NAME
,
$input_file_name
);
}
}
}
if
( (
$input_files_count
> 1 )
and (
$i
< (
$input_files_count
- 1 ) ) )
{
RPerl::verbose_pause(
"\nPRESS <ENTER> TO CONTINUE\n"
);
}
}
if
((
exists
$modes
->{_bailout_message}) and (
defined
$modes
->{_bailout_message}) and (
$modes
->{_bailout_message} ne
q{}
)) {
die
$modes
->{_bailout_message};
}
return
;
}
my
hashref_hashref
$filename_suffixes_supported
=
$RPerl::Compiler::filename_suffixes_supported
;
my
integer
$input_files_count
= 0;
GetOptions(%{$::rperl_options}) or
die
"ERROR EAR00: Failure processing command-line arguments, dying\n"
;
if
($::help_flag) { pod2usage(
-verbose
=> 1,
-width
=> 80,
-exitval
=> 0 );
exit
; }
if
($::vversions_flag) {
$RPerl::VERBOSE
= 1; verbose_versions();
exit
; }
if
($::version_flag) {
my
$version_message
=
<<EOL;
This is RPerl version 7.000_000, Long Date 20200704, Star Date 2020.186, Codename Nova
v7.000_000 using RPerl's underscore-is-comma numbering scheme
v7.000000 using CPAN's underscore-is-beta numbering scheme
Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, William N. Braswell, Jr.. All Rights Reserved.
RPerl is part of the RPerl Family of software and documentation.
This work is Free & Open Source; you can redistribute it and/or modify it
under the same terms as Perl 7.0.
Perl may be copied only under the terms of either the Artistic License or the
GNU General Public License, which may be found in the Perl source kit.
Complete documentation for RPerl, including FAQ lists, should be found on
this system using `man rperl` or `perldoc rperl` or `perldoc RPerl::Learning`.
If you have access to the Internet, point your browser at the RPerl Home Page.
EOL
print
$version_message
;
exit
;
}
if
(
defined
$::uncompile_source_flag) {
if
($::uncompile_source_flag) { $::uncompile_flag = 1; }
else
{ $::uncompile_flag = 0; } }
if
(
defined
$::uncompile_source_binary_flag) {
if
($::uncompile_source_binary_flag) { $::uncompile_flag = 2; }
else
{ $::uncompile_flag = 0; } }
if
(
defined
$::uncompile_source_binary_inline_flag) {
if
($::uncompile_source_binary_inline_flag) { $::uncompile_flag = 3; }
else
{ $::uncompile_flag = 0; } }
verbose_flags(
$::magic_low_flag, $::magic_medium_flag, $::magic_high_flag, $::dependencies_flag, $::uncompile_flag, $::compile_flag, $::subcompile_assemble_flag,
$::subcompile_archive_flag, $::subcompile_shared_flag, $::subcompile_static_flag, $::parallel_flag, $::execute_flag, $::test_flag
);
$::input_file_names = accept_and_verify_input_files( $::input_file_names, $::input_file_names_unlabeled, $::modes );
$input_files_count
=
scalar
@{$::input_file_names};
$::modes = verify_and_default_modes(
$::modes, $::modes_default, $::modes_supported,
$::magic_low_flag, $::magic_medium_flag, $::magic_high_flag,
$::dependencies_flag, $::uncompile_flag, $::compile_flag,
$::subcompile_assemble_flag, $::subcompile_archive_flag, $::subcompile_shared_flag,
$::subcompile_static_flag, $::subcompile_CXX, $::parallel_flag, $::num_cores, $::execute_flag, $::test_flag, $::input_file_names
);
$::output_file_name_groups = RPerl::Compiler::generate_output_file_names( $::input_file_names, $::output_file_name_prefixes,
$input_files_count
, $::modes );
verbose_multi_file_settings( $::input_file_names, $::output_file_name_groups,
$input_files_count
,
$filename_suffixes_supported
, $::modes );
if
( $::modes->{uncompile} ne
'OFF'
) { depends_delete( $::input_file_names, $::output_file_name_groups, $::output_file_name_prefixes,
$input_files_count
,
$filename_suffixes_supported
, $::modes ); }
else
{ depends_parse_generate_save_subcompile_execute( $::input_file_names, $::output_file_name_groups, $::output_file_name_prefixes,
$input_files_count
,
$filename_suffixes_supported
, $::modes ); }
Hide Show 747 lines of Pod