view release on metacpan or  search on metacpan

lib/App/SeismicUnixGui/misc/oop_prog_params.pm  view on Meta::CPAN

    
=cut

sub get_a_section {
	my ($self) = @_;

	my $control = control->new();

	my $prog_name = $oop_prog_params->{_prog_name};
	my $j         = 0;

	my @oop_prog_params;
	my $ok = 1;    #_get_exceptions();

	if ($ok) {

		$oop_prog_params[$j] =
		  " \t " . '$' . $prog_name . " \t \t \t \t " . "->clear();";

		# same as for values
		my $length  = scalar @{ $oop_prog_params->{_param_labels_aref} };
		my $version = $oop_prog_params->{_prog_version};

		for (
			my $param_idx = 0, $j = 1 ;
			$param_idx < $length ;
			$j++, $param_idx++
		  )
		{

			my $label = @{ $oop_prog_params->{_param_labels_aref} }[$param_idx];

			#			print(" 1. oop_prog_params, get_a_section, label = $label \n ");

			$label = $control->ors($label);

			#			print(" 2. oop_prog_params, get_a_section, label = $label \n ");

			my $value = @{ $oop_prog_params->{_param_values_aref} }[$param_idx];

			# Only, after the label has been cleaned (just above)
			_set_label_for_a_suffix($label);
			my $suffix = _get_suffix_for_a_label;

		 #			print(" 3. oop_prog_params, get_a_section, suffix=$suffix....\n ");

			_set_label_for_a_prefix($label);
			my $prefix = _get_prefix_for_a_label();

			#			print(" 4. oop_prog_params, get_a_section suffix =$prefix \n ");
			#            $control->set_value($value);
			#            $control->reset_suffix4loop();
			#            $control->set_suffix4oop($suffix);
			#            $value = $control->get_value4oop();

	    # print(" 4. oop_prog_params, get_a_section value =$value\n ");
	    
			if ( length $prefix && length $suffix ) {

			# print(" 1. oop_prog_params, get_a_section CASE #1 Both suffix and prefix are present\n ");
			# OUTPUT TEXT is set here
				$oop_prog_params[$j] =
					" \t " . '$'
				  . $prog_name
				  . " \t \t \t \t " . '->'
				  . $label
				  . '(quotemeta('
				  . $prefix
				  . $value . ').'
				  . $suffix . ');';

				# print(" 1. oop_prog_params, get_a_section CASE #1 OUTPUT TEXT: $oop_prog_params[$j] \n");
				# print(
# " 1. oop_prog_params, get_a_section CASE #1 suffix=$suffix---prefix=$prefix---value=$value---\n"
				# );

				#				 					. '.'
			}
			elsif ( !( length($prefix) ) && length($suffix) ) {

# print(" oop_prog_params, get_a_section CASE #2  No prefix but there is a suffix \n ");
# OUTPUT TEXT is set here
				$oop_prog_params[$j] =
					" \t " . '$'
				  . $prog_name
				  . " \t \t \t \t " . '->'
				  . $label
				  . '(quotemeta('
				  . $value
				  . $suffix . '));';

			}
			elsif ( $prefix && !($suffix) ) {

				# CASE 3
				#				print("CASE #3 : oop_prog_params,prefix but no suffix \n");
				# OUTPUT TEXT is set here first
				# First part is:
				$oop_prog_params[$j] =
					" \t " . '$'
				  . $prog_name
				  . " \t \t \t \t " . '->'
				  . $label
				  . '(quotemeta(';

				# check for multiple values
				my $length = scalar $value;

				#				print("2. oop_prog_params,get_a,section,value=$value\n");

				#  detect multiple values, if split by comma
				my @sub_values = split( /,/, $value );

			  # print("oop_prog_params,get_a,section,sub_values:@sub_values\n");
				my $num_values = scalar @sub_values;
				my $last_index = $num_values - 1;

			  # print("oop_prog_params,get_a,section,num_values:$num_values\n");

				if ( defined $num_values
					&& $num_values > 0 )
				{    # one value must exist

					if ( $num_values >= 2 ) {

						my $control = control->new();

						# de-tick sub-values for initial case
						my $i = 0;
						$control->set_infection( $sub_values[$i] );
						$sub_values[$i] = $control->get_ticksBgone();

# print("CASE #3A-1: oop_prog_params,get_a,section,de-ticked value:$sub_values[$i]\n");

						# PREFIX set here
						# Second part is for initial case:
						$oop_prog_params[$j] =
							$oop_prog_params[$j]
						  . $prefix . "'"
						  . $sub_values[$i] . "'" . ".','.";

# print("CASE #3A-1: oop_prog_params,get_a,section, parts 1-2 is $oop_prog_params[$j]\n");

						# de-tick sub-values for up-to penultimate case
						for ( $i = 1 ; $i < ( $num_values - 1 ) ; $i++ ) {

							$control->set_infection( $sub_values[$i] );
							$sub_values[$i] = $control->get_ticksBgone();

							# PREFIX set here
							# Third part is:
							$oop_prog_params[$j] =
								$oop_prog_params[$j]
							  . $prefix . "'"
							  . $sub_values[$i] . "'" . ".','.";

# print("CASE #3A-2: oop_prog_params,get_a,section, parts 1-r is $oop_prog_params[$j]\n");

						}

						# de-tick sub-values for last case
						$control->set_infection( $sub_values[$last_index] );
						$sub_values[$last_index] = $control->get_ticksBgone();

						# Final part has no comma
						$oop_prog_params[$j] =
							$oop_prog_params[$j]
						  . $prefix . "'"
						  . $sub_values[$i] . "'" . '));';

# print("CASE #3A-3: oop_prog_params,get_a,section,Final part is $oop_prog_params[$j]\n");

					}
					elsif ( $num_values == 1 ) {

	  # print(" oop_prog_params, get_a_section CASE #3B, single-value case\n ");

						# OUTPUT TEXT is set here
						# otherwise the prefix is set here , only ONCE
						$oop_prog_params[$j] =
						  $oop_prog_params[$j] . $prefix . $value . '));';

# print("CASE #3B: oop_prog_params,get_a,section,Complete:$oop_prog_params[$j]\n");

					}
					else {

						#						print("oop_prog_params,get_a,section,NADA\n");
					}

				}
				else {
					print(
"oop_prog_params,get_a,section,strange values, WARNING\n"
					);
				}

				# CASE _for_
			}
			elsif ( $suffix && !($prefix) ) {

 #				print(" Case 4 oop_prog_params, get_a_section = suffix but no prefix\n ");
 # OUTPUT TEXT is set here
				$oop_prog_params[$j] =
					" \t " . '$'
				  . $prog_name
				  . " \t \t \t \t " . '->'
				  . $label
				  . '(quotemeta('
				  . $value
				  . $suffix . '));';

			}
			elsif ( !($suffix) && !($prefix) ) {

 # CASE 5
# 				print(" oop_prog_params, get_a_section = CASE 5; neither suffix nor prefix\n ");
 # OUTPUT TEXT is set here
#				$oop_prog_params[$j] =
#					" \t " . '$'
#				  . $prog_name
#				  . " \t \t \t \t " . '->'
#				  . $label
#				  . '("'
#				  . $value . '");';
				  
				$oop_prog_params[$j] =
					" \t " . '$'
				  . $prog_name
				  . " \t \t \t \t " . '->'
				  . $label
				  . '(quotemeta('
				  . $value . '));';
#			    print(" oop_prog_params, get_a_section = CASE 5:  $oop_prog_params[$j]  \n ");
			}
			else {

				# CASE 6
				print(
" oop_prog_params, get_a_section prefix and suffixes are weird \n "
				);
			}

# print(" 2. oop_prog_params, get_a_section, label, value = $oop_prog_params[$j] \n ");
		}

		$oop_prog_params[$j] =
			" \t " . '$'
		  . "$prog_name " . '['
		  . $version . '] '
		  . " \t \t \t " . '= $'
		  . "$prog_name "
		  . '->Step();';
		return ( \@oop_prog_params );

	}
	else {

		# print(" oop_prog_params, get_a_section, data detected \n ");
		$oop_prog_params[0] = " \t " . 'place data here' . " \n ";
		return ( \@oop_prog_params );

	}    # no exceptions
}

sub set_many_param_labels {

	my ( $self, $param_labels_href ) = @_;

	if ($param_labels_href) {
		$oop_prog_params->{_param_labels_aref} =
		  $param_labels_href->{_prog_param_labels_aref};

		#		print(" oop_prog_params, set_param_labels, param_labels,
		#		@{ $oop_prog_params->{_param_labels_aref} } \n ");
	}
	return ();
}