#!/usr/bin/perl -w { # makenetcdf.pl (from makematlab.pl) Aug 05 $version = "makenetcdf.pl version 1.1 5 Sep 11"; # 5 Sep 11 wjs v 1.1 # Preallocate error file so it can receive "out of disk space" error messages # 19 Jul 08 wjs v 1.0b # Use check_build_opt_env_var # Bug fix: code optionally uses nctest, but looks like it will # reject all files if nctest isn't around. Change that # 21 May 07 wjs v 1.0a # Add undef of global $open_pre_tag to get rid of "only 1 use" diagnostic require ("cgi-lib.pl"); require "wjs_web_perl_utilities.pl"; # Set up environment. Assume .pl routine is in our directory $build_opt_env = "./build-opt-env.pl"; &check_r_access($build_opt_env); require $build_opt_env; # Define form action routine and hidden html var name for that routine. $form_action = "form_action"; $form_action_routine = $ENV{"SCRIPT_NAME"} ? $ENV{"SCRIPT_NAME"} : "/jg/makenetcdf.pl"; # Check that build-opt-env set up things as expected $opthome = &check_build_opt_env_var('OPTHOME',$build_opt_env); $bindir = &abs_filespec($opthome,"Env var OPTHOME") . "/bin"; # Preallocation stuff. Assume .pl program is in our directory $copy_into_preallocated_file = "./copy_into_preallocated_file.pl"; &check_x_access($copy_into_preallocated_file); $preallocation_size = 10000; # html form variable names $alpha_list_form_var_name = "list_of_alpha_variables"; $object_form_var_name = "object_spec"; &ReadParse(*form_info); # Main purpose of putting form action routine on form as a hidden # variable is to distinguish between use of this program in the # "put the form up" and "process the form results" modes. The # consistency check is just on general principles - anyone who de- # liberately mis-routes things here can change the hidden value as well. if ( $after_submit = (defined $form_info{$form_action}) ) { ($form_info{$form_action} eq $form_action_routine) || &quit ("Submit action routine should be same as form value" , "Action = $form_action_routine; " . "Form value = $form_info{$form_action}" ); } if ($after_submit) { &process_form; } else { &print_form; } exit; } sub print_form { &printheader(); print "\n"; $title = 'Netcdf alpha variable selection page'; print "$title\n"; print "

$title

\n"; $object = &check_build_opt_env_var('OBJECT',$build_opt_env); print "
\n"; # Put object spec into form as hidden variable $ENV{'SUBSELS'} && ( $object .= "(" . $ENV{'SUBSELS'} . ")" ); $h = "input type=\"hidden\""; print "<$h name=\"$object_form_var_name\" value=\"$object\">\n"; # Put name of form action routine on form print "<$h name=\"$form_action\" value=\"$form_action_routine\">\n"; &print_select_alpha_variables ("$bindir/list",$object,$alpha_list_form_var_name,"FALSE"); print "

\n"; print "
\n"; exit; } sub process_form { # Try to get "creating..." msg on screen while work is going on use FileHandle; STDOUT->autoflush(1); &printheader(); print "\n"; $title = 'Netcdf generation results page'; print "$title\n"; print "

$title

\n"; print "
\n";
$open_pre_tag = 1;	# Global variable used by quit

$object = &get_form_var($object_form_var_name,'REQ','NOCHECK');
($status,$errmsg,undef,$object_name) = &parse_object_spec($object);
($status eq "OK") || 
		&quit ("Parsing problem $errmsg with object spec",$object);

$alpha_list = &get_form_var($alpha_list_form_var_name,'OPT','STRING_LIST');
$alpha_list =~ s/\0/\,/g;
($before,$after) = ($alpha_list =~ /(.*)#NONE#(.*)/);
($before || $after) &&
	   &quit ("Cannot select an alpha " .
		"variable along with the 'no alpha variables' choice");

#   makenetcdf writes its diagnostics to stdout.  It writes nothing to
#   stdout in case of success.  Don't know what, if anything, will 
#   write to stderr.
$tempfile_name = "$object_name.netcdf";
$usetempdir = &check_build_opt_env_var('USETEMPDIR',$build_opt_env);
$tempfile = $errfile = $outfile =
	&abs_filespec($usetempdir,"Env var USETEMPDIR") . "/$tempfile_name";
$errfile .= ".err";
$outfile .= ".out";

$usetempaddr = &check_build_opt_env_var('USETEMPADDR',$build_opt_env);
$tempfile_url = $outfile_url = $errfile_url = "$usetempaddr/$tempfile_name";
$errfile_url .= ".err";
$outfile_url .= ".out";

(-e $tempfile) && (unlink $tempfile);
(-e $errfile) && (unlink $errfile);
(-e $outfile) && (unlink $outfile);

#   Preallocate error file
(open HANDLE,"> $errfile") || &quit("Cannot open $errfile for write.  Reason: $!");
(truncate HANDLE,$preallocation_size) || 
				&quit ("Cannot truncate $errfile to $preallocation_size bytes.  Reason: $!");
(close HANDLE) || &quit("Error closing $errfile.  Reason: $!");

$nctest = "$bindir/testnetcdf";

$command = "$bindir/makenetcdf";
&check_x_access ($command);
$command .= ' -maxwidth ';
$command .= '"' . $object . '" ' . $tempfile . ' "' . $alpha_list . '"';
$command .= "  > $outfile 2> $errfile";


print "Creating netcdf file...\n\n";

$! = $? = 0;
system $command;


#   OK - so what happened?  Don't really have a conclusive idea		
#     If makenetcdf main program is what errored, we'll have a non-zero	
#   exit status (250, I think).  However, not sure if netcdf lib can	
#   exit w/o returning to main pgm.  If it can, don't know status	
#   or if netcdf file was created.  If created, don't know if it's valid
#   (eg, what happens w/nc_open w/no nc_close? seems OK...)		
#     Under normal conditions, there will be neither stdout nor stderr	
#   output.  However, if there is such output, don't know if we could	
#   have a valid netcdf file.  We'll try an nc_open on it as a 		
#   (probably useless) test						

$ok_command = (($! == 0) && ($? == 0));
$ok_command || (print " *** Problem with $command\n\$! = $!; \$? = $?\n\n");

#   $errfile should exist since we created it, but be "empty"
#   Best guess is that if nothing was written to it, it will still be the size we made it.
#   For now, take a chance that the error message isn't exactly as long as preallocation size!
$size_errfile = (-e $errfile) ? (-s $errfile) : 0;
if (($size_errfile > 0) && ($size_errfile != $preallocation_size)) {
  if ($size_errfile > 10) {
    print "Error/diagnostic file exists\n";
  } else {
    print "Error/diagnostic file $errfile exists.  Contents follow\n\n";
    system ("cat $errfile");
  }
}
#   $outfile should exist (created by shell) but be empty
$size_outfile = (-e $outfile) ? (-s $outfile) : 0;
if ($size_outfile > 0) {
  if ($size_outfile > 10) {
    print "Error/diagnostic file exists\n";
  } else {
    print "Error/diagnostic file $outfile exists.  Contents follow\n\n";
    system ("cat $outfile");
  }
#   If $errfile is empty, but $outfile isn't, make $errfile point to
#   $outfile in case somebody browses .err files looking for trouble
#   Use a soft link to show that this .err file isn't "original"
  if ($size_errfile == 0) {
    unlink $errfile;
    symlink ($outfile,$errfile);
  }
}

#  $nctest returns 0 if $tempfile is legit netcdf; 1 if it's not; 2
#  if it wasn't called w/exactly 1 arg					
if ((-e $nctest) && (-x $nctest)) {
  $test_result = system ("$nctest $tempfile > /dev/null 2> /dev/null");
  $diagnostic = "Non-existent, empty, or improperly formatted";
} else {
  $test_result = 0;
  $diagnostic = "Non-existent or empty";
}
if (  ($test_result == 0) && ( -e $tempfile ) && ( ! -z $tempfile )   ) {
  print "\n" .
  	"Download netcdf file (Hold SHIFT key and Click to download)\n";
} else {
  &quit (" *** $diagnostic netcdf file\n");
}

print "
\n"; undef $version; # Global variable used in quit undef $open_pre_tag; # Global variable used in quit exit; }