App-SeismicUnixGui
view release on metacpan or search on metacpan
lib/App/SeismicUnixGui/misc/control.pm view on Meta::CPAN
my ($entry_value) = @_;
if ( defined $entry_value ) { # =0 case is OK
if ( $entry_value ne $empty_string ) {
my $exit_value;
# print("control,_get_no_quotes, entry_value = $entry_value\n");
# 1. remove double quotes if they exist
# anywhere in the line
$entry_value =~ tr/"//d;
# 2. remove extra single quotes if they exist at the start of the string
$entry_value =~ s/^'//;
# 3. remove extra single quotes if they exist at the end of the string
$entry_value =~ s/'$//;
$exit_value = $entry_value;
# print("control,_get_no_quotes, result: $exit_value\n");
return ($exit_value);
}
else {
# print("control,_get_no_quotes, equals $empty_string\n");
return ($empty_string);
}
}
else {
# print("control,_get_no_quotes, undefined value\n");
return ($empty_string);
}
}
=head2 sub _get_string_or_number
Put quotes on strings
Generally, file names are strings but
numeric names will be interpreted as numbers,
i.e., '1000.txt' will be seen as a number and not a file name
=cut
sub _get_string_or_number {
my ($entry_value) = @_;
my $program;
if ( length $entry_value ) {
# print(
# "1. control, _get_string_or_number, entering value to test = $entry_value\n"
# );
use Scalar::Util qw(looks_like_number);
# remove any exisitng quotes
my $clean_value = _get_no_quotes($entry_value);
if ( length( $control->{_prog_names_aref} )
&& ( length $control->{_flow_index} ) )
{
# CASE 1 Flow is previously saved to disk
# or to RAM, (e.g., either via "param_flows")
# list of program names in flow and currently
# active program is used
# A few programs have specific requirements
$program =
@{ $control->{_prog_names_aref} }[ ( $control->{_flow_index} ) ];
# print("2. control, _get_string_or_number, working with $program\n");
if (
length $program
and ( $program eq 'data_in'
or $program eq 'data_out' )
)
{
# print("CASE 1A control, _get_string_or_number, working with data_in, or data_out -- special cases\n");
# specific requirements for data_in and data_out in first item (index =0)
my $index = $control->{_parameter_index4array};
if ( length $index ) {
if ( $index == 0 ) {
# expected for index=0 in both data_in and data_out
# CASE 1A.1 always returns string
my $exit_value_as_string = '\'' . $clean_value . '\'';
# print("CASE 1A.1 control, _get_string_or_number, value into a string: $exit_value_as_string\n");
return ($exit_value_as_string);
}
else { # remaining parameters for data_in and data_out
# determine whether we have a string or a number
my $fmt = 0;
$fmt = looks_like_number($clean_value);
# print("2. control, _get_string_or_number, entry_value = $clean_value\n");
if ($fmt) {
# keep numbers as they are
# print(
# "CASE 1A.2, numbers, control, _get_string_or_number,$clean_value looks like a number\n"
# );
my $exit_value_as_number = $clean_value;
return ($exit_value_as_number);
}
else {
# print("CASE 1A.3 control, strings, _get_string_or_number, exit_value looks like string\n");
my $exit_value_as_string =
'\'' . $clean_value . '\'';
# print("control, get_string_or_number, value into a string: $exit_value_as_string\n");
return ($exit_value_as_string);
}
}
}
else {
print("control, _get_string_or_number, missing index \n");
}
} # for data_in and data_out
elsif ( length $program
and $program eq 'segyread' )
{
# CASE 1B ALWAYS exists as a string within quotes
my $exit_value_as_string = '\'' . $clean_value . '\'';
# print("CASE 1B control, _get_string_or_number,value = $exit_value_as_string\n");
}
elsif ( length $program
and $program eq 'suop2' )
{
# CASE 1C ALWAYS exists as a string within quotes
my $exit_value_as_string = '\'' . $clean_value . '\'';
# print("CASE 1C control, _get_string_or_number,value = $exit_value_as_string\n");
}
elsif ( ( length $program )
and ( $program ne 'data_in' )
and ( $program ne 'data_out' )
and ( $program ne 'segyread' )
and ( $program ne 'suop2' ) )
{
# determine whether we have a string or a number
# print(
#"CASE 1D control,_get_string_or_number, flow is already saved on disk or in RAM, \n
# (e.g., in param_flow_color_pkg') -- for most programs\n"
# );
# first remove any exisitng quotes
my $clean_value = _get_no_quotes($entry_value);
my $fmt = 0;
$fmt = looks_like_number($clean_value);
# print("control, _get_string_or_number, CASE 1C entry_value = $entry_value\n");
if ($fmt) {
# print(
#"CASE 1D.1, number, control, _get_string_or_number,$entry_value looks like a number\n"
# );
my $exit_value_as_number = $clean_value;
return ($exit_value_as_number);
}
else {
# print(
#"control, _get_string_or_number, exit_value does not look like a number \n"
# );
my $exit_value_as_string = '\'' . $clean_value . '\'';
# print(
#"CASE 1D.2, string, control, get_string_or_number, value into a string: $exit_value_as_string\n"
# );
return ($exit_value_as_string);
}
}
else {
# print("55. control, _get_string_or_number, entry_value = $clean_value\n");
# General, CASE 2 when flow is not yet saved
# to disk or RAM, (e.g., either via "param_flows")
# or disk
# print(
# "CASE 2 control,_get_string_or_number, flow not yet saved, without need for knowledge of program name or flow index \n"
# );
# determine whether we have a string or a number
my $fmt = 0;
$fmt = looks_like_number($clean_value);
if ($fmt) {
# print("CASE 2.1 control, _get_string_or_number,$clean_value looks like a number\n");
my $exit_value_as_number = $clean_value;
# print("561. control, _get_string_or_number, entry_value = $clean_value\n");
return ($exit_value_as_number);
}
else {
# print("control, _get_string_or_number, exit_value like a string\n");
my $exit_value_as_string = '\'' . $clean_value . '\'';
# print("CASE 2.2, control, get_string_or_number, value into a string: $exit_value_as_string\n");
return ($exit_value_as_string);
}
} # end CASES 2
}
elsif (not( length( $control->{_prog_names_aref} ) )
or not( ( length $control->{_flow_index} ) ) )
{
print(
"control, _get_string_or_number, no program name list or selected flow index\n"
);
return ($empty_string);
}
else {
# print("control,_get_string_or_number, missing program names and/or flow index\n");
#print("57. control, _get_string_or_number, entry_value = $clean_value\n");
# print(
# "control, _get_string_or_number, control->{_prog_names_aref}=$control->{_prog_names_aref},
# control->{_flow_index}=$control->{_flow_index}\n"
# );
print("control, _get_string_or_number, unexpected result\n");
return ($empty_string);
} # end test for program name and/or flow index
}
else {
# print("59. control,_get_string_or_number, missing entry_value=$clean_value, NADA\n");
return ($empty_string);
}
} # end sub
=head2 sub _get_string_or_number4aref
Put quotes on strings
=cut
sub _get_string_or_number4aref {
my ($array_ref) = @_;
if ($array_ref) {
lib/App/SeismicUnixGui/misc/control.pm view on Meta::CPAN
return ($exit_array_ref);
}
else {
print("control, get_no_quotes4array, bad array reference\n");
return ();
}
}
=head2 sub get_path_wo_last_slash
first check to see if a final slash
exists
=cut
sub get_path_wo_last_slash {
my ($self) = @_;
if ( length $control->{_path} ) {
my $path = $control->{_path};
my $last_character = substr( $path, -1 );
# print ("old path=$path\n\n");
if ( $last_character eq $forward_slash ) {
$path =~ s/\/$//;
# print ("path new $path\n\n");
}
else {
# print ("path unchanged $path\n\n");
}
my $result = $path;
# print("control,get_path_wo_last_slash, : $result\n");
return ($result);
}
else {
print("control, get_path_wo_last_slash, missing argument \n");
}
return ();
}
=head2 sub get_string_or_number
Put quotes on strings
=cut
sub get_string_or_number {
my ( $self, $entry_value ) = @_;
if ( defined($entry_value) ) {
if ( $entry_value ne $empty_string ) {
use Scalar::Util qw(looks_like_number);
# print ("control, get_string_or_number, entry_value: $entry_value\n");
# determine whether we have a string or a number
my $fmt = 0;
$fmt = looks_like_number($entry_value);
if ($fmt) {
# print("control, get_string_or_number,$entry_value looks like a number \n");
# do nothing
my $exit_value_as_number = $entry_value;
return ($exit_value_as_number);
}
else {
# print("control, get_string_or_number, exit_value does not look like a number \n");
my $exit_value_as_string = '\'' . $entry_value . '\'';
# print("control, get_string_or_number, value into a string: $exit_value_as_string\n");
return ($exit_value_as_string);
}
}
else {
# print("control,get_string_or_number, missing entry_value or empty\n");
return ($empty_string);
}
}
else { # empty string becomes: ''
# print("control,get_string_or_number, undefined entry value NADA \n");
my $exit_value_as_empty_string = '\'' . '\'';
# print ("control, get_string_or_number, value into a string: $exit_value_as_empty_string\n");
return ($exit_value_as_empty_string);
}
}
=head2 sub get_string_or_number_aref2
Put quotes on strings
=cut
sub get_string_or_number_aref2 {
my ( $self, $array_aref2 ) = @_;
# print("control,get_string_or_number_aref2, self=$self\n");
if ( length $array_aref2 ) {
my @array_of_arrays = @{$array_aref2};
my $num_progs4flow = scalar @array_of_arrays;
# print("\ncontrol, get_string_or_number_aref2, num_progs4flow=$num_progs4flow\n");
for ( my $prog_idx = 0 ; $prog_idx < $num_progs4flow ; $prog_idx++ ) {
my @array = @{ $array_of_arrays[$prog_idx] };
# print("1. control, get_string_or_number_aref2, array = @array\n");
@array = @{ _get_string_or_number4aref( \@array ) };
# print("control, get_string_or_number_aref2, out= @array\n");
$array_of_arrays[$prog_idx] = \@array;
# print("2. control, get_string_or_number_aref2, array = @array\n");
( run in 0.593 second using v1.01-cache-2.11-cpan-0bb4e1dffa6 )