App-SeismicUnixGui
view release on metacpan or search on metacpan
lib/App/SeismicUnixGui/developer/code/sunix/update.pm view on Meta::CPAN
$developer_sunix_categories[4] = 'header';
$developer_sunix_categories[5] = 'inversion';
$developer_sunix_categories[6] = 'migration';
$developer_sunix_categories[7] = 'model';
$developer_sunix_categories[8] = 'NMO_Vel_Stk';
$developer_sunix_categories[9] = 'par';
$developer_sunix_categories[10] = 'picks';
$developer_sunix_categories[11] = 'shapeNcut';
$developer_sunix_categories[12] = 'shell';
$developer_sunix_categories[13] = 'statsMath';
$developer_sunix_categories[14] = 'transform';
$developer_sunix_categories[15] = 'well';
$developer_sunix_categories[16] = '';
QUESTION 1:
Which group number do you want to use to update
for *.pm, *.config, and *_spec.pm files ?
e.g., for transforms use:
$group_number = 15
QUESTION 2:
Which program do you want to work on?
For example=
'sugetgthr';
'sugain';
'suputgthr';
'suifft';
'sufctanismod'
'vel2stiff
'unif2aniso'
'transp'
'suflip'
my $program_name = 'suhistogram';
=head2 CHANGES and their DATES
Feb. 2022
V0.2
read a file with spec-file modifications:
label_number numbers and suffix_types
=cut
use Moose;
our $VERSION = '0.0.1';
=head2 private hash
=cut
my $update = {
_directory => '',
_program_name => '',
_spec_changes_base_file_name => '',
_spec_label_number_aref => '',
_spec_suffix_type_aref => '',
_group_number => '',
_start_binding_index_line => '',
_end_binding_index_line => '',
_start_file_dialog_type_line => '',
_end_file_dialog_type_line => '',
_start_prefix_line => '',
_end_prefix_line => '',
_start_suffix_line => '',
_end_suffix_line => '',
};
=head2 Import packages
=cut
use aliased 'App::SeismicUnixGui::misc::L_SU_global_constants';
use App::SeismicUnixGui::misc::SeismicUnix
qw($bin $dat $pl $ps $segb $segd $segy $sgy $su $suffix_bin $suffix_ps
$suffix_segy $suffix_sgy $suffix_su $suffix_txt $txt $text);
use aliased 'App::SeismicUnixGui::configs::big_streams::Project_config';
use aliased 'App::SeismicUnixGui::misc::manage_files_by2';
use aliased 'App::SeismicUnixGui::developer::code::sunix::prog_doc2pm';
use aliased 'App::SeismicUnixGui::developer::code::sunix::sudoc';
use aliased 'App::SeismicUnixGui::developer::code::sunix::sunix_package';
=head2 clean memory private hash
=cut
sub clear {
my ($self) = @_;
$update->{_directory} = '';
$update->{_program_name} = '';
$update->{_spec_changes_base_file_name} = '';
$update->{_spec_label_number_aref} = '';
$update->{_spec_suffix_type_aref} = '';
$update->{_group_number} = '';
$update->{_start_binding_index_line} = '';
$update->{_end_binding_index_line} = '';
$update->{_start_file_dialog_type_line} = '';
$update->{_end_file_dialog_type_line} = '';
$update->{_start_prefix_line} = '';
$update->{_end_prefix_line} = '';
$update->{_start_suffix_line} = '';
$update->{_end_suffix_line} = '';
}
=head2 sub _get_spec_changes
label_number values,
directory types
suffix types
=cut
sub _get_spec_changes {
my ($self) = @_;
if ( length $update->{_program_name} && length $update->{_group_number}
and length $update->{_spec_changes_base_file_name} )
{
my $spec_changes_base_file_name =
$update->{_spec_changes_base_file_name};
=head2 instantiation of packages
=cut
my $file = manage_files_by2->new();
my $prog_doc2pm = prog_doc2pm->new();
my $get = L_SU_global_constants->new();
my $var = $get->var();
my $on = $var->{_on};
my $off = $var->{_off};
my $true = $var->{_true};
my $false = $var->{_false};
my $empty_string = $var->{_empty_string};
my $path_in = $prog_doc2pm->get_path_in();
my $program_name = $update->{_program_name};
my $group_number = $update->{_group_number};
=head21 Declare
variables
=cut
my ($directory_type_aref);
my ( @directory_type, @prefix_spec, @suffix_spec );
$directory_type_aref = \@directory_type;
my $inbound =
$path_in . '/' . $spec_changes_base_file_name . $suffix_txt;
my $spacer = " ";
my $aref = $file->read_2cols_aref( $inbound, $spacer );
my @array = @$aref;
my $label_number_aref = $array[0];
lib/App/SeismicUnixGui/developer/code/sunix/update.pm view on Meta::CPAN
sub set_program {
my ( $self, $program_name, $group_number ) = @_;
print(
"update, set_program , group_number category=$group_number, program_name=$program_name\n"
);
if ( length $program_name
&& length $group_number )
{
$update->{_program_name} = $program_name;
$update->{_group_number} = $group_number;
# print(
#"update, set_program, group_number category=$group_number, program_name=$program_name\n"
# );
}
else {
print("update, set_program, missing program name or group number\n");
}
return ();
}
=head2 sub set_spec_changes
label_number values,
directory types
suffix types
=cut
sub set_spec_changes {
my ($self) = @_;
if ( length $update->{_program_name} && length $update->{_group_number}
and length $update->{_spec_changes_base_file_name} )
{
my $sudoc = sudoc->new();
my $prog_doc2pm = prog_doc2pm->new();
my (@path_in4specs);
my ( @spec_file_in, @spec_inbound );
my $program_name = $update->{_program_name};
my $group_number = $update->{_group_number};
$prog_doc2pm->set_group_directory($group_number);
$path_in4specs[0] = $prog_doc2pm->get_path_out4specs();
=head2 define
search lines
=cut
my ( $start_binding_index_line, $end_binding_index_line );
my ( $start_file_dialog_type_line, $end_file_dialog_type_line );
my ( $start_prefix_line, $end_prefix_line );
my ( $start_suffix_line, $end_suffix_line );
my $start_binding_index_line2find = '# e.g., first binding index \(index=0\)';
my $end_binding_index_line2find = '= 8; # outbound item is bound';
my $end_file_dialog_type_line2find =
'# \$type\[\$index\[2\]\] = \$file_dialog_type->\{_Data\};';
my $start_file_dialog_type_line2find =
'# bound index will look for data';
my $start_prefix_line2find = 'sub prefix_aref \{';
my $end_prefix_line2find =
'\t# label 9 in GUI is input zz_file and needs a home directory';
my $end_suffix_line2find =
'# \$suffix\[ \$index\[2\] \] = \'\'.\'\' . \'\$suffix_su\';';
my $start_suffix_line2find = 'sub suffix_aref \{';
=head2 import
from program_spec_changes.txt file
=cut
my $changes_aref = _get_spec_changes();
my @changes = @$changes_aref;
my $prefix_spec_aref = $changes[1];
my $suffix_spec_aref = $changes[0];
my $label_number_aref = $changes[2];
$spec_file_in[0] = $program_name . '_spec.pm';
$spec_inbound[0] = $path_in4specs[0] . '/' . $spec_file_in[0];
=head2 Q. What range of lines remain to change in the spec file?
Step A: Start by reading in package file (
"program"_spec.pm)
=cut
$sudoc->set_file_in_sref( \$spec_file_in[0] );
$sudoc->set_perl_path_in( $path_in4specs[0] );
# slurp the whole file
$sudoc->whole();
my $whole_aref = $sudoc->get_whole();
my $length_of_slurp = scalar @{$whole_aref};
my @slurp = @{$whole_aref};
=head2 STEP B: Follow by finding the following
ranges of lines:
3)There are lines for prefixes
4)There are lines for suffixes
1)There are lines where there are interactive label_numbers
2) There are lines for data types
my $line_range4data_type =
my $line_range4prefix =
my $line_range4suffix =
my $line_range4index =
my change4data_standard =
my change4prefix_standard =
my change4suffix_standard =
my $additional_data_change =
my $additional_prefix_change =
my $additional_suffix_change =
=cut
for ( my $i = 0 ; $i < $length_of_slurp ; $i++ ) {
# print("update,All sunix documentation $slurp[$i]\n");
my $string = $slurp[$i];
if ( $string =~ /$start_binding_index_line2find/ ) {
$start_binding_index_line = $i + 4;
# print("update,
# a spec success at start_binding_index_line: $start_binding_index_line \n"
# );
}
if ( $string =~ /$end_binding_index_line2find/ ) {
$end_binding_index_line = $i + 3;
# print("update,
# a spec success at end_binding_index_line: $end_binding_index_line \n"
# );
}
if ( $string =~ /$start_file_dialog_type_line2find/ ) {
$start_file_dialog_type_line = $i + 2;
# print(
#"update, a spec success at start_file_dialog_type_line:$start_file_dialog_type_line \n"
# );
}
if ( $string =~ /$end_file_dialog_type_line2find/ ) {
$end_file_dialog_type_line = $i + 3;
# print(
#"update, a spec success at end_file_dialog_type_line:$end_file_dialog_type_line \n"
# );
}
if ( $string =~ /$start_prefix_line2find/ ) {
$start_prefix_line = $i + 13;
# print(
# "update, a spec success at start_prefix_line: $start_prefix_line \n"
# );
}
if ( $string =~ /$end_prefix_line2find/ ) {
$end_prefix_line = $i + 3;
print(
"update, a spec success at end_prefix_line: $end_prefix_line \n"
);
}
if ( $string =~ /$start_suffix_line2find/ ) {
$start_suffix_line = $i + 13;
# print(
# "update, a spec success at start_suffix_line: $start_suffix_line \n"
# );
}
if ( $string =~ /$end_suffix_line2find/ ) {
$end_suffix_line = $i + 3;
print(
"update, a spec success at end_suffix_line:$end_suffix_line \n"
);
}
}
my @result = (
$start_binding_index_line, $end_binding_index_line,
$start_file_dialog_type_line, $end_file_dialog_type_line,
$start_prefix_line, $start_suffix_line,
$end_suffix_line, $end_prefix_line
);
$update->{_start_binding_index_line} = $start_binding_index_line;
$update->{_end_binding_index_line} = $end_binding_index_line;
$update->{_start_file_dialog_type_line} = $start_file_dialog_type_line;
$update->{_end_file_dialog_type_line} = $end_file_dialog_type_line;
$update->{_start_prefix_line} = $start_prefix_line;
$update->{_start_suffix_line} = $start_suffix_line;
$update->{_end_suffix_line} = $end_suffix_line;
$update->{_end_prefix_line} = $end_prefix_line;
return ();
}
else {
print(
"update, set_spec_changes, missing program name or group number\n");
return ();
}
}
=head2 sub set_spec_changes_base_file_name
file name where the following
changes can be found:
label_number values
directory types
suffix types
=cut
sub set_spec_changes_base_file_name {
my ( $self, $spec_changes_base_file_name ) = @_;
if ( length $update->{_program_name} && length $update->{_group_number}
and $spec_changes_base_file_name )
{
$update->{_spec_changes_base_file_name} = $spec_changes_base_file_name;
print(
"update, set_spec_changes_base_file_name,spec_changes_base_file_name=$spec_changes_base_file_name\n"
);
}
else {
print(
"update, set_spec_changes_base_file_name, missing program name or group number\n"
);
}
return ();
}
sub set_changes {
my ($self) = @_;
if ( length $update->{_program_name}
&& length $update->{_group_number} )
{
lib/App/SeismicUnixGui/developer/code/sunix/update.pm view on Meta::CPAN
@slurp[ 0 .. ( $index_start_extraction - 1 ) ];
#tail array
my @slurp_after_extraction =
@slurp[ ( $index_end_extraction + 1 ) .. $length_of_slurp ];
# print("5.1 update, slurp_b4_extraction: @slurp_b4_extraction\n");
# add torso to head
push @slurp_b4_extraction, @new_program_list;
my @digested_slurp = @slurp_b4_extraction;
# print("5.2 update, digested_slurp: @digested_slurp\n");
# add tail to (torso+head)
push @digested_slurp, @slurp_after_extraction;
# print("5.3 update, digested_slurp: @digested_slurp\n");
# Write out the corrected file
# print("writing out to $global_constants_outbound[0] n");
my $length_digested_slurp = scalar @digested_slurp;
open( OUT, ">$global_constants_outbound[0] " )
or die("File $global_constants_outbound[0] not found");
for ( my $i = 0 ; $i < ( $length_digested_slurp - 1 ) ; $i++ ) {
if ( $digested_slurp[$i] ne "\t" ) {
# print(" update,$digested_slurp[$i]\n");
print OUT $digested_slurp[$i] . "\n";
}
}
close(OUT);
print(" update, wrote out a new $global_constants_file_out[0]\n");
}
else {
print "update: a global constants file is missing!\n";
} # for a selected global constants file
}
else {
print("update, missing program name or group number\n");
}
return ();
}
sub spec_changes {
my ($self) = @_;
my $changes_aref = _get_spec_changes();
if ( length $update->{_program_name} && length $update->{_group_number}
and length $update->{_spec_changes_base_file_name}
and length $changes_aref
and length $update->{_start_binding_index_line}
and length $update->{_start_prefix_line}
and length $update->{_start_suffix_line}
and length $update->{_end_suffix_line}
and length $update->{_end_prefix_line} )
{
my $sudoc = sudoc->new();
my $prog_doc2pm = prog_doc2pm->new();
my ( @path_in4specs, @path_out4specs );
my ( @spec_file_in, @spec_inbound, @spec_outbound );
my $program_name = $update->{_program_name};
my $group_number = $update->{_group_number};
$prog_doc2pm->set_group_directory($group_number);
$path_in4specs[0] = $prog_doc2pm->get_path_out4specs();
$path_out4specs[0] = $prog_doc2pm->get_path_out4specs();
$spec_file_in[0] = $program_name . '_spec.pm';
$spec_inbound[0] = $path_in4specs[0] . '/' . $spec_file_in[0];
$spec_outbound[0] =
$path_out4specs[0] . '/' . $program_name . '_spec.pm';
=head3 Read in
label_number values,
directory types
suffix types
=cut
my @changes = @$changes_aref;
my $prefix_spec_aref = $changes[1];
my $suffix_spec_aref = $changes[0];
my $label_number_aref = $changes[2];
my @label = @$label_number_aref;
my $label_number_of = scalar @$label_number_aref;
my @suffix_spec = @$suffix_spec_aref;
my @prefix_spec = @$prefix_spec_aref;
my $line_bump_suffix = 0;
my $line_bump_prefix = 0;
my $line_bump_binding_index = 0;
my $line_bump_file_dialog_type = 0;
my $new_length_of_slurp;
my ( @temp_array_suffix, @temp_array_prefix );
my ( @temp_array_binding_index, @temp_array_file_dialog_type );
my $temp_array_length_suffix;
my $temp_array_length_prefix;
my $temp_array_length_binding_index;
my $temp_array_length_file_dialog_type;
# print("update, spec_changes, suffix_spec:@$suffix_spec_aref\n");
print("update, spec_changes, prefix_spec:@$prefix_spec_aref\n");
print("update, spec_changes, label_number: @$label_number_aref\n");
print("update, spec_changes, label_number_of: $label_number_of\n");
=head2 Reading in package file (
"program"_spec.pm)
=cut
$sudoc->set_file_in_sref( \$spec_file_in[0] );
$sudoc->set_perl_path_in( $path_in4specs[0] );
# slurp the whole file
$sudoc->whole();
my $whole_aref = $sudoc->get_whole();
my $length_of_slurp = scalar @{$whole_aref};
my @slurp = @{$whole_aref};
=head2 include additional lines
that will allow user to interactively
click on the gui and open the
appropraate directory in which to
find a file. These parameters
are written into the program_spec.pm file
In case new lines are added, keep track
of these lines.
=cut
=head2 add to
suffix_aref lines in *_spec.pm file
=cut
print(
"1. update, spec_changes, start_suffix_line =$update->{_start_suffix_line}\n"
);
print(
"1. update, spec_changes, end_suffix_line =$update->{_end_suffix_line}\n"
);
my $start_suffix_line = $update->{_start_suffix_line} - 1;
my $end_suffix_line = $update->{_end_suffix_line} - 1;
=head2 save latter portion for addendum
to suffix_aref
=cut
$temp_array_length_suffix = $length_of_slurp - $end_suffix_line;
# print("update,spec_changes, length_of_slurp = $length_of_slurp\n");
# print("update,spec_changes, temp_array_length_suffix = $temp_array_length_suffix\n");
@temp_array_suffix[ 0 .. ( $temp_array_length_suffix - 1 ) ] =
@slurp[ $end_suffix_line .. $length_of_slurp ];
# print("update,spec_changes, temp_array = @temp_array\n");
=head2 overwrite or add new lines
to suffix_aref
=cut
$slurp[ ($start_suffix_line) ] =
("\tmy \$index_aref = get_binding_index_aref();");
$slurp[ ( $start_suffix_line + 1 ) ] =
("\tmy \@index = \@\$index_aref;");
# recursively modify *_spec.pm file
for ( my $i = 0 ; $i < $label_number_of ; $i++ ) {
# print("label_number=$label[$i]\n");
$slurp[ ( $start_suffix_line + ( ( $i + 1 ) * 3 ) ) ] =
(
"\t# label $label[$i] in GUI is input/ouput xx_file and needs a home directory"
);
$slurp[ ( $start_suffix_line + ( ( $i + 1 ) * 3 ) + 1 ) ] =
("\t\$suffix[ \$index[$i] ] = $suffix_spec[$i]");
$slurp[ ( $start_suffix_line + ( ( $i + 1 ) * 3 ) + 2 ) ] = (" ");
}
=head2 Add saved text lines
to suffix_aref
if we have more than 3 input/output interactions
=cut
if ( $label_number_of > 3 ) {
$line_bump_suffix = ( $label_number_of - 3 ) * 3;
my $new_length_of_slurp = $length_of_slurp + $line_bump_suffix;
my $new_end_suffix_line = $end_suffix_line + $line_bump_suffix + 1;
# print(
# "update, spec_changes,new_length_of_slurp=$new_length_of_slurp\n"
# );
# print(
#"update, spec_changes,new_end_suffix_line= $new_end_suffix_line\n"
# );
@slurp[ ( $new_end_suffix_line - 1 )
.. ( $new_length_of_slurp - 1 ) ] =
@temp_array_suffix[ 0 .. ( $temp_array_length_suffix - 1 ) ];
}
elsif ( $label_number_of <= 3 ) {
# NADA;
}
else {
print("update, spec_changes, unexpected value \n");
}
##########################################################################
=head2 Add lines to
prefix_aref lines in *_spec.pm file
Intentionally start from the end of the *.spec file
=cut
print(
"update, spec_changes, start_prefix_line =$update->{_start_prefix_line}\n"
);
print(
"1. update, spec_changes, end_prefix_line =$update->{_end_prefix_line}\n"
);
my $start_prefix_line = $update->{_start_prefix_line} - 1;
my $end_prefix_line = $update->{_end_prefix_line} - 1;
=head2 save latter portion for addendum
to prefix_aref
If suffix does not have more than 3 entries the line_bump_* = 0
=cut
$new_length_of_slurp = $length_of_slurp + $line_bump_suffix;
$temp_array_length_prefix = $new_length_of_slurp - $end_prefix_line;
# print("update,spec_changes, new_length_of_slurp = $new_length_of_slurp\n");
# print("update,spec_changes, prefix_aref temp_array_length_prefix = $temp_array_length_prefix\n");
@temp_array_prefix[ 0 .. ( $temp_array_length_prefix - 1 ) ] =
@slurp[ $end_prefix_line .. $new_length_of_slurp ];
# print("update,spec_changes, temp_array_prefix = @temp_array_prefix\n");
$slurp[ ($start_prefix_line) ] =
("\tmy \$index_aref = get_binding_index_aref();");
$slurp[ ( $start_prefix_line + 1 ) ] =
("\tmy \@index = \@\$index_aref;");
# recursively modify *_spec.pm file
for ( my $i = 0 ; $i < $label_number_of ; $i++ ) {
# print("update, spec_changes, L 1365, label_number=$label[$i]\n");
$slurp[ ( $start_prefix_line + ( ( $i + 1 ) * 3 ) ) ] =
(
"\t# label $label[$i] in GUI is input/output xx_file and needs a home directory"
);
$slurp[ ( $start_prefix_line + ( ( $i + 1 ) * 3 ) + 1 ) ] =
("\t\$prefix[ \$index[$i] ] = $prefix_spec[$i]");
$slurp[ ( $start_prefix_line + ( ( $i + 1 ) * 3 ) + 2 ) ] =
(" ");
}
=head2 Add saved text lines
to prefix_aref
if we have more than 3 input/output interactions
=cut
if ( $label_number_of > 3 ) {
$line_bump_prefix = ( $label_number_of - 3 ) * 3;
my $new_length_of_slurp =
$length_of_slurp + $line_bump_suffix + $line_bump_prefix;
my $new_end_prefix_line = $end_prefix_line + $line_bump_prefix + 1;
# print(
# "update, spec_changes,new_length_of_slurp, prefix_aref=$new_length_of_slurp\n"
# );
# print(
#"update, spec_changes,new_end_prefix_line= $new_end_prefix_line\n"
# );
@slurp[ ( $new_end_prefix_line - 1 )
.. ( $new_length_of_slurp - 1 ) ] =
@temp_array_prefix[ 0 .. ( $temp_array_length_prefix - 1 ) ];
}
elsif ( $label_number_of <= 3 ) {
# NADA;
}
else {
print("update, spec_changes, for prefix_aref unexpected value \n");
}
###############################################################################
=head2 add to
lib/App/SeismicUnixGui/developer/code/sunix/update.pm view on Meta::CPAN
$temp_array_length_file_dialog_type - 1 ) ] =
@slurp[ $end_file_dialog_type_line .. $new_length_of_slurp ];
# print("update,spec_changes, temp_array_file_dialog_type = @temp_array_file_dialog_type\n");
# recursively modify *_spec.pm file
for ( my $i = 0 ; $i < $label_number_of ; $i++ ) {
# print("update, spec_changes, L 1479, label_number=$label[$i]\n");
$slurp[ ( $start_file_dialog_type_line + $i ) ] =
("\t\$type[\$index[$i]] = \$file_dialog_type->\{_Data\};");
}
=head2 Add saved text lines
to file_dialog_type_aref
if we have more than 3 input/output interactions
=cut
if ( $label_number_of > 5 ) {
$line_bump_file_dialog_type = ( $label_number_of - 5 );
my $new_length_of_slurp =
$length_of_slurp +
$line_bump_suffix +
$line_bump_prefix +
$line_bump_file_dialog_type;
my $new_end_file_dialog_type_line =
$end_file_dialog_type_line + $line_bump_file_dialog_type + 1;
print(
"update, spec_changes,new_length_of_slurp, file_dialog_type_aref=$new_length_of_slurp\n"
);
print(
"update, spec_changes,new_end_file_dialog_type_line= $new_end_file_dialog_type_line\n"
);
@slurp[ ( $new_end_file_dialog_type_line - 1 )
.. ( $new_length_of_slurp - 1 ) ] =
@temp_array_file_dialog_type[ 0 .. (
$temp_array_length_file_dialog_type - 1 ) ];
}
elsif ( $label_number_of <= 5 ) {
# NADA;
}
else {
print(
"update, spec_changes, for file_dialog_type_aref unexpected value \n"
);
}
#################################################################################
=head2 add to
sub binding_index_aref lines in *_spec.pm file
=cut
my $start_binding_index_line = $update->{_start_binding_index_line};
my $end_binding_index_line = $update->{_end_binding_index_line};
print(
"update, spec_changes, start_binding_index_line =$update->{_start_binding_index_line}\n"
);
print(
"update, spec_changes, end_binding_index_line =$update->{_end_binding_index_line}\n"
);
=head2 Add lines to
binding_index_aref lines in *_spec.pm file
Intentionally start from the end of the *.spec file
=cut
$start_binding_index_line = $update->{_start_binding_index_line} - 1;
$end_binding_index_line = $update->{_end_binding_index_line} - 1;
=head2 save latter portion for addendum
to binding_index_aref
If file_dialog_type does not have more than 3 entries the line_bump_* = 0
=cut
$new_length_of_slurp =
$length_of_slurp +
$line_bump_suffix +
$line_bump_prefix +
$line_bump_file_dialog_type;
$temp_array_length_binding_index =
$new_length_of_slurp - $end_binding_index_line;
print(
"update,spec_changes, new_length_of_slurp = $new_length_of_slurp\n"
);
print(
"update,spec_changes, binding_index_aref temp_array_length_binding_index = $temp_array_length_binding_index\n"
);
@temp_array_binding_index[ 0 .. ( $temp_array_length_binding_index - 1 )
] = @slurp[ $end_binding_index_line .. $new_length_of_slurp ];
# print("update,spec_changes, temp_array_binding_index = @temp_array_binding_index\n");
# recursively modify *_spec.pm file
for ( my $i = 0 ; $i < $label_number_of ; $i++ ) {
# print("update, spec_changes, L 1591, label_number=$label[$i]\n");
my $index_out = $label[$i] - 1;
$slurp[ ( $start_binding_index_line + $i ) ] =
("\t\$index[$i] = $index_out; # inbound/outbound item is bound");
}
=head2 Add saved text lines
to binding_index_aref
if we have more than 4 input/output interactions
=cut
if ( $label_number_of > 4 ) {
$line_bump_binding_index = ( $label_number_of - 4 );
my $new_length_of_slurp =
$length_of_slurp +
$line_bump_suffix +
$line_bump_prefix +
$line_bump_file_dialog_type +
$line_bump_binding_index;
my $new_end_binding_index_line =
$end_binding_index_line + $line_bump_binding_index + 1;
print(
"update, spec_changes,new_length_of_slurp, binding_index_aref=$new_length_of_slurp\n"
);
print(
"update, spec_changes,new_end_binding_index_line= $new_end_binding_index_line\n"
);
@slurp[ ( $new_end_binding_index_line - 1 )
.. ( $new_length_of_slurp - 1 ) ] =
@temp_array_binding_index[ 0 .. (
$temp_array_length_binding_index - 1 ) ];
}
elsif ( $label_number_of <= 4 ) {
# NADA;
}
else {
print(
"update, spec_changes, for binding_index_aref unexpected value \n"
);
}
#################################################################################
=head2 write out
updated spec file
=cut
open( OUT, ">$spec_outbound[0]" )
or die("File $spec_outbound[0] not found");
$length_of_slurp = scalar @slurp;
print(
"update,writing out file, spec_changes, length_of_slurp = $length_of_slurp\n"
);
for ( my $i = 0 ; $i < $length_of_slurp ; $i++ ) {
# print ("$slurp[$i]\n");
print OUT $slurp[$i] . "\n";
}
close(OUT);
}
else {
print("update,spec_changes, a needed variable is missing\n");
print("update,spec_changes,program_name=$update->{_program_name}\n");
print("update,spec_changes,group_number=$update->{_group_number}\n");
print(
"update,spec_changes,spec_changes_base_file_name=$update->{_spec_changes_base_file_name}\n"
);
print("update,spec_changes,$changes_aref=changes_aref\n");
print(
"update,spec_changes,start_binding_index_line=$update->{_start_binding_index_line}\n"
);
print(
"update,spec_changes,start_prefix_line=$update->{_start_prefix_line}\n"
);
print(
"update,spec_changes,start_suffix_line=$update->{_start_suffix_line}\n"
);
print(
"update,spec_changes,end_suffix_line=$update->{_end_suffix_line}\n"
);
print(
"update,spec_changes,end_prefix_line=$update->{_end_prefix_line}\n"
);
}
return ();
}
1;
( run in 1.247 second using v1.01-cache-2.11-cpan-2398b32b56e )