view release on metacpan or  search on metacpan

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

=head2 sub configs 

  read configuration parameter files
  for seismic unix modules
  and for tool (superflow) modules
  (not for user-built flows)

  TODO: since sub configs= sub params
        ONLY NEED TO USE ONE OF THEM 
        AMONG ANY PROGRAM

=cut

sub configs {
	my ( $self, $program ) = @_;

	my @parameter;
	my @value;

	if ( length $program ) {

		my $control = control->new();
		my ( $this, $eq );

		$this = $program;

#		print("readfiles,configs,this program is:$this\n");
		my ($t, $t_whole, $x, $line, $max_index );
		
		my $index=0;

		open( my $IN, '<', $this )
		  or die "readfiles,configs: Can't open parameter file: '$this' $!";

=pod

   set the counter
   uses the perl convention -- first index is 0
   readfiles contents of a file
   print ("\nThis file contains ($max_index +1) row(s) of data\n");	
   print("line $i is $line");
   print ("\nThis file contains $num_rows row(s) of data\n");
  regex:
   trim white spaces from both ends
   split on '=' and its surrounding spaces
   
    control does the following:
     # 1. remove double quotes if they exist
     #  anywhere in the line
	$x =~ tr/"//d;
			
     # 2. remove extra single quotes if they exist at the start of the string
     $x =~ s/^'//;
     		
    # 3. remove extra single quotes if they exist at the end of the string     							
	$x =~ s/'$//; 
	# print("after removing only a last single quote: $x\n ");
	     		# 4. determine whether we have a string or a number
			my $fmt	=	0;
			$fmt  	= 	looks_like_number($x);
			
			if ($fmt) {
				# printf("$x looks like a number \n");
				# do nothing
				
			} else {		
				# printf("$x does not look like a number \n");
				my $x_as_string = '\''.$x.'\'';
				print (" Made $x into a string: $x_as_string\n");
				$x				= $x_as_string;
			}

=cut

		while ( $line = <$IN> ) {

#			print("1. readfiles,configs:raw line $index is $line\n");
			chomp($line);

   # skip lines starting where first non-white character is
   # modify 'm' starts ^ and ends $ as pertaining to each line and not each file
#      print("2. readfiles,configs:chomped line num is $line\n");
			next if $line =~ /^\s*#/m;

#	print("3.0 readfiles,configs:these lines have no starting '#' is $line\n");

			# trim white spaces from both ends
			$line =~ s/^\s+|\s+$//g;

#	print("3-1. readfiles,configs white spaces removed from ends,line is $line\n");

			# split line using =
			( $t_whole, $x ) = split( /\s+=\s*/, $line );
			$t = $t_whole;    # redundant in long run unless the
							  # following changes

#			print("3-1b. readfiles,configs $t\t$x \n");

			$x = $control->get_no_quotes($x);

#			print("3-1b. readfiles,configs $t\t$x \n");

			$x = $control->get_string_or_number($x);

#			print("3-1c. readfiles,configs $t\t$x \n");

			# only print out lines that are not empty
			if ($t) {

# print("3-2. readfiles,configs, line: $line\n parameter name, value: $t,$x\n");

				# save value and increment index
				# only if there is something to keep

				# test for "bad" x values
				if ( not defined $x ) {

#					print( "readfiles,configs, x is undefined\n");
					# print("                    replace x=$x  with ''\n");
					$x = '';

				}
				elsif ( $x eq "''" ) {