####################################################################### # Location Variables # ####################################################################### #$url_of_the_form = "Forms/opsf.html"; $url_of_the_form = "Forms/input/input_opsf.html"; $location_of_mail_lib = "./Library/mail-lib.pl"; $location_of_setup_file = "opsf.setup.cgi"; #section 1 - defining fields #section 1.1 - range_variable_input { #section 1.2 - sub check_radius { #section 1.3 - sub check_date { #section 1.4 - sub ra_dec_conv { #section 2 - sub which_query { #section 3 - sub obs_name_sub { #section 4 - sub no_input { #section 5 - sub validate { #section 6 - sub print_no_row { #section 7 - sub no_input_input { ##input checker #section 8 - sub print_no_input_sub { #section 9 - sub print_no_file_name_sub { #section 10 - sub print_8_char_error_sub { #section 11 - sub print_bad_value_sub { #section 12 - sub check { ##input checker #section 13 - sub file_list { ##input subroutine #section 14 - sub quote_literals { #section 15 - sub individual_parameters { #section 16 - sub printrow ####################################################################### # Defining your Fields # ####################################################################### #section 1 # is used in section #2 and #12 @form_variables_base = ("origfile", "psf_file", "psf_orig", "xcenter", "ycenter", "xcorner", "ycorner", "ra_psf", "dec_psf", "peakint", "peakfit", "saturatd", "backgnd", "colortype", "colorval", "bvcolor", "spectral", "refspec", "psfscale", "pixfact", "focus", "v2_rms", "v2_p2p", "v3_rms", "v3_p2p", "detector", "instrume", "rootname", "filetype", "opt_elem", "filter", "aperture", "propaper", "repeller", "centera1", "centera2", "sizaxis1", "sizaxis2", "binaxis1", "binaxis2", "ccdgain", "bias", "fgslock", "expstart", "exptime", "targname", "ra_targ", "dec_targ", "proposid" ); # is used to build the query statement, and what parameters are to be # queried on @headers = (ORIGFILE, PSF_FILE, PSF_ORIG, XCENTER, YCENTER, XCORNER, YCORNER, RA_PSF, DEC_PSF, PEAKINT, PEAKFIT, SATURATD, BACKGND, COLORTYPE, COLORVAL, BVCOLOR, SPECTRAL, REFSPEC, PSFSCALE, PIXFACT, FOCUS, V2_RMS, V2_P2P, V3_RMS, V3_P2P, DETECTOR, INSTRUME, ROOTNAME, FILETYPE, OPT_ELEM, FILTER, APERTURE, PROPAPER, REPELLER, CENTERA1, CENTERA2, SIZAXIS1, SIZAXIS2, BINAXIS1, BINAXIS2, CCDGAIN, BIAS, FGSLOCK, EXPSTART, EXPTIME, TARGNAME, RA_TARG, DEC_TARG, PROPOSID ); # is used in section #2,#12,#15,#7,#4 @required_variables = ("origfile", "psf_file", "psf_orig", "xcenter", "ycenter", "xcorner", "ycorner", "ra_psf", "dec_psf", "peakfit_upper_limit", "peakfit_lower_limit", "peakint_upper_limit", "peakint_lower_limit", "peakfit", "saturatd", "backgnd", "colortype", "colorval_upper_limit", "colorval_lower_limit", "bvcolor_upper_limit", "bvcolor_lower_limit", "spectral", "refspec", "psfscale", "pixfact", "focus_upper_range", "focus_lower_range", "v2_rms", "v2_p2p", "v3_rms", "v3_p2p", "detector", "instrume", "rootname", "filetype", "opt_elem", "filter", "aperture", "propaper", "repeller", "centera1", "centera2", "sizaxis1", "sizaxis2", "binaxis1", "binaxis2", "ccdgain", "bias", "fgslock", "expstart_upper_range", "expstart_lower_range", "exptime_upper_range", "exptime_lower_range", "targname", "ra_targ", "dec_targ", "proposid" ); # used in section #1.1 %range_variables_hash = ( "peakfit_upper_limit" => "peakfit_lower_limit", "peakint_upper_limit" => "peakint_lower_limit", "colorval_upper_limit" => "colorval_lower_limit", "bvcolor_upper_limit" => "bvcolor_lower_limit", "focus_upper_range" => "focus_lower_range", "expstart_upper_range" => "expstart_lower_range", "exptime_upper_range" => "exptime_lower_range" ); # used in section #12 %required_variable_type = ( "origfile" => "char", "psf_file" => "char", "psf_orig" => "char", "xcenter" => "float", "ycenter" => "float", "xcorner" => "float", "ycorner" => "float", "ra_psf" => "float", "dec_psf" => "float", "peakint" => "float", "peakfit" => "float", "saturatd" => "char", "backgnd" => "float", "colortype" => "char", "colorval" => "float", "bvcolor" => "float", "spectral" => "char", "refspec" => "char", "psfscale" => "float", "pixfact" => "float", "focus" => "float", "v2_rms" => "float", "v2_p2p" => "float", "v3_rms" => "float", "v3_p2p" => "float", "detector" => "char", "instrume" => "char", "rootname" => "char", "filetype" => "char", "opt_elem" => "char", "filter" => "char", "aperture" => "char", "propaper" => "char", "repeller" => "char", "centera1" => "int", "centera2" => "int", "sizaxis1" => "int", "sizaxis2" => "int", "binaxis1" => "int", "binaxis2" => "int", "ccdgain" => "int", "bias" => "float", "fgslock" => "char", "expstart" => "float", "exptime" => "float", "targname" => "char", "ra_targ" => "float", "dec_targ" => "float", "proposid" => "int" ); # used in section #1.3 %month_conv = ( "jan" => "1", "feb" => "2", "mar" => "3", "apr" => "4", "may" => "5", "jun" => "6", "jul" => "7", "aug" => "8", "sep" => "9", "oct" => "10", "nov" => "11", "dec" => "12" ); $i = 0; $j = 0; $x_y_flag = "NO"; $ra_dec_flag = "NO"; $upper_flag = 0; #mjd/calendar date conversion flag initialization $lower_flag = 0; # parse out decision variable and file; load file into array and close file $doit = param('db_insert'); $FILE = param( 'filename' ); @file_line = <$FILE>; close ($FILE); $decide = param('query_decision'); #print "decide = $decide
"; $origfile = param('origfile'); #obs name to check for length #print "origggfile = $origfile
"; #print "ff=$ff
"; $ff = length ($origfile); ################### create the selection criteria ###################### $query_select_final = ""; $query_select_everything = param('query_select_everything'); #print "query_select_everything=$query_select_everything
"; @query_select = param('query_select'); #pulls out the elements to select on foreach $query_select (@query_select) { #print "vvvvv = $query_select
"; $query_select_final = $query_select_final . "," . $query_select; } $query_select_final =~ s/,$//; #strips off last comma $query_select_final =~ s/^,//; #strips off last comma #print "query_select_final = $query_select_final

"; if ($query_select_everything eq "everything") { #replace default select with $query_select_final = "*"; # "*" @query_select=@headers; } #print "query_select_final=$query_select_final
"; ########################################################################### #print "I'm here in Master\n"; print "\n"; ###################################################################### # check range inputs # ####################################################################### #section 1.1 sub range_variable_input { foreach $range_variable (keys %range_variables_hash) { #print "range_variable_key = $range_variable
"; #print "range_variable_value = $range_variables_hash{$range_variable}
"; $range1 = param($range_variable); $range2 = param($range_variables_hash{$range_variable}); if ($range1 && !$range2 || !$range1 && $range2) { print "You've got to have both $range_variable and $range_variables_hash{$range_variable} inputs. See the help file for further information.
"; exit; } #print "vvvvalue1 = $range1
"; #print "vvvvalue2 = $range2
"; } } ###################################################################### # check radius inputs # ####################################################################### #section 1.2 sub check_radius { #check on x/ycenter and radius $value1 = param('xcenter'); $value2 = param('ycenter'); $value3 = param('x_y_center_radius'); if (!$value1 && $value2) { print qq~ Error in Processing Form ~; print "Error: You must enter a xcenter"; print qq~ ~; exit; } if ($value1 && !$value2) { print qq~ Error in Processing Form ~; print "Error: You must enter a ycenter"; print qq~ ~; exit; } if (!$value1 && !$value2 && $value3) { print qq~ Error in Processing Form ~; print "Error: You must enter a xcenter and a ycenter"; print qq~ ~; exit; } if ($value1 && $value2 && !$value3) { print qq~ Error in Processing Form ~; print "Error: You must enter a radius for x\ycenter pair "; print qq~ ~; exit; } #IF ALL THREE VALUES FOR X/Y/RADIUS ARE HERE, CALCULATE THE OFFSETS if ($value1 && $value2 && $value3) { #print "value1 = $value1
"; #print "value2 = $value2
"; #print "value3 = $value3
"; $x_y_flag = YES; $x_delta_plus = $value1 + $value3; #print "xplus = $x_delta_plus
"; if ($x_delta_plus > 2048) {print "You're xcenter_plus is out of bounds (>2048)
";} $x_delta_minus = $value1 - $value3; if ($x_delta_minus < 1) {print "You're xcenter_minus is out of bounds (<1)
";} $y_delta_plus = $value2 + $value3; if ($y_delta_plus > 2048) {print "You're ycenter_plus is out of bounds (>2048)
";} $y_delta_minus = $value2 - $value3; if ($y_delta_minus < 1) {print "You're ycenter_minus is out of bounds (<1)
";} } #CHECK ON RA_PSF, DEC_PSF, AND RA_DEC_RADIUS, EXISTENCE OF.......... @name = ('ra_psf', 'dec_psf', 'ra_dec_radius', ); for $name (@name) { $value = param ($name); push (@value, $value); # Look for non-blank character in parameter push (@undefined, $name) unless $value =~ /\S/; } #for $j (@undefined) {print "j=$j
";} if (@undefined && @undefined != @name) { $errmsg = 'You must enter a value for the following parameter: '; $errmsg =~ s/:/s:/ if @undefined > 1; $errmsg .= join (', ', @undefined); } if ($errmsg) {print "$errmsg
";exit;} } ###################################################################### # check date # ####################################################################### #section 1.3 sub check_date { #MAKE SURE EXPTIME IS FLOAT AND THAT IT EXISTS $upper_time = param('exptime_upper_range'); $lower_time = param('exptime_lower_range'); if ($upper_time =~ /^[+-]?\d+$/) { print "Error: upper_exptime must be a real number
"; exit; } if ($lower_time =~ /^[+-]?\d+$/) { print "Error: lower_exptime must be a real number
"; exit; } if (!$upper_time && $lower_time) { print "Error: You must enter a upper_exptime
"; exit; } if ($upper_time && !$lower_time) { print "Error: You must enter a lower_exptime
"; exit; } #MAKE SURE EXPSTART IS FLOAT AND THAT IT EXISTS $upper_date = param('expstart_upper_range'); $lower_date = param('expstart_lower_range'); #print "upper_expstart=$upper_date
"; #print "lower_expstart=$lower_date
"; if ($upper_date =~ /^[+-]?\d+$/) { print "Error: upper_expstart must be a real number
"; exit; } if ($lower_date =~ /^[+-]?\d+$/) { print "Error: lower_expstart must be a real number
"; exit; } if (!$upper_date && $lower_date) { print "Error: You must enter a upper_expstart
"; exit; } if ($upper_date && !$lower_date) { print "Error: You must enter a lower_expstart
"; exit; } #print "upper date = $upper_date
"; #print "lower date = $lower_date
"; if ($upper_date =~ /^+(JAN|FEB|MAR|APR|MAY|JUN|JUL|AUG|SEP|OCT|NOV|DEC)\s+\d\d?\s+\d\d\d?\d?$/i) { #print "You've got the calendar date
"; #$tmp_mjd = 40587; # mjd for jan 1 1970 #($month, $day, $year) = split (/ /, $upper_date); #foreach $month_conv (keys %month_conv) { # if ($month_conv eq $month) { # $month = $month_conv{$month_conv}; # } #} #print "month = $month
"; #print "day = $day
"; #print "year = $year
"; #$upper_tmp_date = day_number ($upper_date); #$final_upper_date = $upper_tmp_date + $tmp_mjd; $mjd_final_upper_date = julian_date (parse_date ($upper_date)); #print "mjd_final_upper_date = $mjd_final_upper_date
"; $upper_flag = 1; #if the date was a calendar date, it has come #thru here and has been converted...set this flag #to be used when constructing the select statement. } if ($lower_date =~ /^+(JAN|FEB|MAR|APR|MAY|JUN|JUL|AUG|SEP|OCT|NOV|DEC)\s+\d\d?\s+\d\d\d?\d?$/i) { # print "You've got the calendar date
"; #$tmp_mjd = 40587; # mjd for jan 1 1970 #($month, $day, $year) = split (/ /, $lower_date); #foreach $month_conv (keys %month_conv) { # if ($month_conv eq $month) { # $month = $month_conv{$month_conv}; # } #} #print "month = $month
"; #print "day = $day
"; #print "year = $year
"; #$lower_tmp_date = day_number ($lower_date); #$final_lower_date = $lower_tmp_date + $tmp_mjd; #print "final_upper_date = $final_upper_date
"; $mjd_final_lower_date = julian_date (parse_date ($lower_date)); #print "mjd_final_lower_date = $mjd_final_lower_date
"; $lower_flag = 1; #if the date was a calendar date, it has come #thru here and has been converted...set this flag #to be used when constructing the select statement. } if ($upper_date =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) { #print "You've got the decimal date
"; $mjd_final_upper_date = $upper_date; } if ($lower_date =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) { #print "You've got the decimal date
"; $mjd_final_lower_date = $lower_date; } } #end of sub check_date ###################################################################### # Bernie's date subroutines # ####################################################################### #---------------------------------------------------------------------- # Initialize constant arrays sub BEGIN { @day_names = qw (Sunday Monday Tuesday Wednesday Thursday Friday Saturday); @month_names = qw (January February March April May June July August September October November December); @month_length = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); $calendar_cell_width = 67; $calendar_cell_height = 50; $calendar_event_color = "#ffff99"; } #---------------------------------------------------------------------- # Parse a date string into day, month, year sub parse_date { my ($datestring) = shift; my ($month, $day, $year) = split (/[-\s,\/]+/, $datestring); $month = lc ($month); if ($month =~ /^\d+$/) { $month --; } else { my $match; for (my $i = 0; $i < @month_names; $i++) { $monthname = lc ($month_names[$i]); if ($monthname =~ /^$month/) { if (defined ($match)) { die "Ambiguous month: $month\n"; } else { $match = $i; } } } if (defined $match) { $month = $match; } else { die "Unrecognized month: $month\n"; } } die "Illegal date: $datestring\n" unless $month < 12 && $day <= month_length ($month, $year); return ($day, $month, $year); } #---------------------------------------------------------------------- # Return the modified julian date given the day, month, and year sub julian_date { return day_number (@_) + 40587; } #---------------------------------------------------------------------- # Return the day number for a Gregorian date between 1970 and 2099 sub day_number { my ($day, $month, $year) = @_; my ($daynum); # Calculate years since 1970 $year = y2k ($year); $year -= 1970; # Calculate days until Jan 1 of this year $daynum = 365 * $year + int (($year + 1) / 4); # Add number of days this year so far $daynum += $day + int ((3055 * ($month + 3)) / 100) - 92; # Correct for short February and leap year day $daynum += (($year + 2) % 4 == 0) - 2 if $month > 1; return $daynum; } #---------------------------------------------------------------------- # Return the number of days in a month sub month_length { my ($month, $year) = @_; my ($length); $year = y2k ($year); $length = $month_length[$month]; $length += 1 if ($year % 4) == 0 && $month == 1; return $length; } #---------------------------------------------------------------------- # Two digit to four digit year between 1970 and 2099 sub y2k { my ($year) = shift; if ($year < 70) { $year += 2000; } elsif ($year < 100) { $year += 1900; } elsif ($year < 1970 || $year > 2099) { die "Year out of range: $year\n"; } return $year; } ###################################################################### # ra & dec conversion # ####################################################################### #section 1.4 sub ra_dec_conv { $ra = param('ra_psf'); $dec = param('dec_psf'); $ra_dec_radius = param('ra_dec_radius'); # if ($ra =~ /^[+-]?\d+$/ || $dec =~ /^[+-]?\d+$/ || $ra_dec_radius =~ /^[+-]?\d+$/) { print qq~ Error in Processing Form ~; print "You can not use integers for ra/dec/radius!"; print qq~ ~; exit; } if ($ra =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ && $dec =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ && $ra_dec_radius =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/){ $convert_flag = "No"; } else { $convert_flag = "YES"; } #print "convert_flag = $convert_flag
"; if ($convert_flag eq "No") { $converted_ra = $ra; $converted_dec = $dec; $converted_ra_dec_radius = $ra_dec_radius; $final_ra_plus = $converted_ra + $converted_ra_dec_radius; $final_ra_minus = $converted_ra - $converted_ra_dec_radius; $final_dec_plus = $converted_dec + $converted_ra_dec_radius; $final_dec_minus = $converted_dec - $converted_ra_dec_radius; #print "converted ra = $converted_ra
"; #print "converted dec = $converted_dec
"; #print "converted ra_dec radius = $converted_ra_dec_radius
"; #print "
"; #print "final_ra_plus=$final_ra_plus
"; #print "final_ra_minus=$final_ra_minus
"; #print "final_dec_plus=$final_dec_plus
"; #print "final_dec_minus=$final_dec_minus
"; $ra_dec_flag = YES; } else { $converted_ra = $ra; #feed input and convert to decimal degrees #print "ra = $ra
"; #print "dec = $dec
"; #print "radius = $ra_dec_radius
"; $converted_ra = hms2deg ($ra); $converted_dec = dms2deg ($dec); $converted_ra_dec_radius = dms2deg ($ra_dec_radius); #print "converted ra = $converted_ra
"; #print "converted dec = $converted_dec
"; #print "converted ra_dec radius = $converted_ra_dec_radius
"; $ra_dec_flag = YES; $final_ra_plus = $converted_ra + $converted_ra_dec_radius; $final_ra_minus = $converted_ra - $converted_ra_dec_radius; $final_dec_plus = $converted_dec + $converted_ra_dec_radius; $final_dec_minus = $converted_dec - $converted_ra_dec_radius; #print "
"; #print "final_ra_plus=$final_ra_plus
"; #print "final_ra_minus=$final_ra_minus
"; #print "final_dec_plus=$final_dec_plus
"; #print "final_dec_minus=$final_dec_minus
"; sub dms2deg { $dms = shift; $deg = 0; if ($dms =~ s/\s*-//) { $factor = -1; } else { $factor = 1; } @part = split (/ /, $dms, 3); foreach $part (@part) { $deg += $part * $factor; $factor /= 60; } return $deg; } sub hms2deg { $dms = shift; $deg = 0; if ($dms =~ s/\s*-//) { $factor = -1; } else { $factor = 1; } @part = split (/ /, $dms, 3); foreach $part (@part) { $deg += $part * $factor; $factor /= 60; } $deg = $deg * 15; return $deg; } } } ###################################################################### # check which query # ####################################################################### #section 2 sub which_query { foreach $variable (@form_variables_base) { #print "variable1 = $variable\n"; #check on the query decision to determine the flow # if ($variable eq "query_decision") { # print qq~ # # # i'm here # # # ~; if ($decide eq "Submit Query") { $cmmd = qq|select $query_select_final from stis_psf where |; #print "query_select_final = $query_select_final
"; undef $where_clause; foreach $key (@required_variables) { $value = param($key); $value=~tr/a-z/A-Z/; # set all to uppercase #print "value = $value\n"; if ($value) { $where_clause .= " and " if $where_clause; $value2 = $value; $value2 = "'$value2'" unless $value2 =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/; #set $value with quotes unless tested out to be non-character #if "saturatd","colortyp","pixfact","detector","filetype","ccdgain" = ANY, #by pass using these for selection criteria in the where clause else #construct and append the where clause # also, if $x_y_flag eq 'YES', meaning xcenter,ycenter, and the radius are # all populated, then include this in the where clause #print "key=$key
"; #print "value2=$value2
"; #$value3 = $value2; #$value3 =~ s/'//g; if ($value2 eq "\'ANY\'") { $where_clause = $where_clause . "1 = 1"; } elsif ($key eq 'filter' && ($value2 eq "'25MAMA'" | $value2 eq "'F25LYA'" | $value2 eq "'F25ND3'" | $value2 eq "'F25ND5'" | $value2 eq "'F25NDQ1'" | $value2 eq "'F25NDQ2'" | $value2 eq "'F25NDQ3'" | $value2 eq "'F25NDQ4'" | $value2 eq "'F25QTZ'" | $value2 eq "'F25SRF2'" | $value2 eq "'F25MGII'" | $value2 eq "'F25CN270'" | $value2 eq "'F25CIII'" | $value2 eq "'F25CN182'" | $value2 eq "'50CCD'" | $value2 eq "'F28X50LP'" | $value2 eq "'F28X50OII'" | $value2 eq "'F28X50OIII'" | $value2 eq "'50CORON'")) { $where_clause .= "aperture = $value2"; } elsif ($key eq 'filter' && ($value2 eq "'BAR10'" | $value2 eq "'WEDGEA1.0'" | $value2 eq "'WEDGEA1.8'" | $value2 eq "'WEDGEA2.0'" | $value2 eq "'WEDGEA2.5'" | $value2 eq "'WEDGEA2.8'" | $value2 eq "'WEDGEB1.0'" | $value2 eq "'WEDGEB1.8'" | $value2 eq "'WEDGEB2.0'" | $value2 eq "'WEDGEB2.5'" | $value2 eq "'WEDGEB2.8'")) { $where_clause .= "propaper = $value2"; } elsif ($key eq 'peakfit_upper_limit') { $where_clause .= "peakfit <= $value2"; } elsif ($key eq 'peakfit_lower_limit') { $where_clause .= "peakfit >= $value2"; } elsif ($key eq 'peakint_upper_limit') { $where_clause .= "peakint >= $value2"; } elsif ($key eq 'peakint_lower_limit') { $where_clause .= "peakint <= $value2"; } elsif ($key eq 'colorval_upper_limit') { $where_clause .= "colorval <= $value2"; } elsif ($key eq 'colorval_lower_limit') { $where_clause .= "colorval >= $value2"; } elsif ($key eq 'bvcolor_upper_limit') { $where_clause .= "bvcolor >= $value2"; } elsif ($key eq 'bvcolor_lower_limit') { $where_clause .= "bvcolor <= $value2"; } elsif ($key eq 'focus_upper_range') { $where_clause .= "focus >= $value2"; } elsif ($key eq 'focus_lower_range') { $where_clause .= "focus <= $value2"; } elsif ($key eq 'expstart_upper_range') { #uses either the converted calendar or mjd value if ($upper_flag == 1) { $where_clause .= "expstart <= $mjd_final_upper_date"; } else { $where_clause .= "expstart <= $value2"; } } elsif ($key eq 'expstart_lower_range') { #uses either the converted calendar or mjd value if ($lower_flag == 1) { $where_clause .= "expstart >= $mjd_final_lower_date"; } else { $where_clause .= "expstart >= $value2"; } } elsif ($key eq 'exptime_upper_range') { $where_clause .= "exptime <= $value2"; } elsif ($key eq 'exptime_lower_range') { $where_clause .= "exptime >= $value2"; } elsif ($x_y_flag eq 'YES') { $where_clause .= "xcenter between $x_delta_minus and $x_delta_plus and ycenter between $y_delta_minus and $y_delta_plus"; } elsif ($ra_dec_flag eq 'YES') { $where_clause .= "ra_psf between $final_ra_minus and $final_ra_plus and dec_psf between $final_dec_minus and $final_dec_plus"; } else { $where_clause .= "$key = $value2"; } } # end of if (exists) } #end foreach $where_clause = "1 = 1" unless $where_clause; $cmmd = $cmmd . $where_clause; } else {exit;} print qq~ ~; } #} $cmmd; } ####################################################################### # check input # ####################################################################### #section 12 sub check { #check file input, create hash with required fields and values, and then run thru #char,int,real check routines #print "i'm in check
"; #print "doit=$doit
"; if ($doit eq "Send File of Datasets"){ foreach $line_blue (@file_line) { #reads first line of data..... chop $line_blue; $line_blue=~tr/a-z/A-Z/; # print "line_blue=$line_blue
"; @value_blue = split (/,\s*/, $line_blue); #removes comma and whitespace...pushes it into an array @value_blue = map (quote_literals ($_), @value_blue); #sub that quotes characters foreach $name_blue (@form_variables_base) { #populates a hash with name/value $value_blue = shift @value_blue; #pulls element off left side of list $hash{$name_blue} = $value_blue; # print "key=$name_blue,value=$hash{$name_blue}
"; #$name_blue->keyword,$hash{$name_blue}->value } foreach $name (keys %hash) { # print "NAME_next=$name,hash_value=$hash{$name}
"; if ($name eq "origfile") { #check origfile length .... # print "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
"; $ff=length($hash{$name}); # print "variable_name=$name
"; # print "variable_value=$hash{$name}
"; # print "length=$ff
"; if($save_name) { $save_name = $save_name . "," . $hash{$name}; } else { $save_name = $hash{$name}; } #print "save_name= $save_name
"; if ($ff < 20 || $ff >20) { print qq~ Results in writing to the database ~; print "Observation names must be 20 characters long(with quotes)
"; print "Nothing has been written to the database\n"; print qq~ ~; exit; } } if ($hash{$name} eq 'NULL') { #print "BBBBBBBBBB

"; $required_variable_type{$name} = $joe; } else { $joe = validate ($hash{$name}); #send to validate and check all values } #print "joe equals character_type = $joe
"; #print "$name,$hash{$name},$joe,$required_variable_type{$name}
"; #print "NAME=$name,REQUIRED_VARIABLE=$required_variable_type{$name}
"; if ($required_variable_type{$name} ne $joe) { $exit_flag=yes; print qq~ Results in writing to the database ~; print "Bad value for $name
"; print "Nothing has been written to the database
"; print qq~ ~; } #else {print "everything is okkkkkkk!!!!!!
";} } #end foreach3 } #end if1 if ($exit_flag eq "yes") {exit;} #form input, single row entry } elsif ($doit eq "Submit Input"){ print "you're in the wrong place


"; foreach $name (@required_variables) { if ($name eq "origfile") { #check origfile length .... $ff=length(param($name)); if ($ff < 18 || $ff >18) { &print_8_char_error_sub; } } $value = param($name);#print "value=$value\n"; $joe = validate ($value); if ($required_variable_type{$name} ne $joe) { &print_bad_value_sub; } } } #end elsif ($doit eq "Submit Input") return; } #end sub check ###################################################################### # observation name subroutine # ####################################################################### #section 3 sub obs_name_sub { if ($ff < 18 || $ff > 18) { print "ff=$ff
"; print qq~ Results in writing to the database ~; print "Observation names must be 18 characters longggg\n"; print qq~ ~; exit; } } ####################################################################### # print_no_row section subroutine # ####################################################################### #section 6 sub print_no_row { print qq~ build sql query
There isn't any data in the PSF Library that matches the query parameters supplied. Try again. ~; } ####################################################################### # print no input subroutine & no filename & 8 char # ####################################################################### #section 8 sub print_no_input_sub { print qq~ Error in Processing Form - Required Fields ~; print "You didn't supply any input"; print qq~ ~; exit; } #section 9 sub print_no_file_name_sub { print qq~ Error in Processing Form - Required Fields ~; print "You forgot to enter a file name"; print qq~ ~; exit; } #section 10 sub print_8_char_error_sub { print qq~ Results in writing to the database ~; print "Observation names must be 18 characters long\n"; print "Nothing has been written to the database\n"; print qq~ ~; exit; } #section 11 sub print_bad_value_sub { print qq~ Results in writing to the database ~; print "Bad value for $name\n"; print "Nothing has been written to the database\n"; print qq~ ~; exit; } ####################################################################### # get input from the form and build query # ####################################################################### #section 15 sub individual_parameters { $input_cmd = "insert into stis_psf values("; foreach $name (@required_variables) { $value = param($name); $value=~tr/a-z/A-Z/; $value = "'$value'" unless $value =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/; #set $value with quotes unless tested out to be non-character $input_cmd = $input_cmd . $value . ','; } chop $input_cmd; $input_cmd = $input_cmd . ')'; foreach $name (param()) { $value = param($name); push(@list,$value); } $input_cmd; #send cmd back to processor }#end subindividual_parameter ####################################################################### # subroutine validate # ####################################################################### # VALIDATE -- Test a data type validation subroutine #section 5 sub validate { my $value = shift; # Remove leading and trailing whitespace and quotes from the strings #print "im in validate
"; $value =~ s/^\s+//; $value =~ s/\s+$//; $value =~ s/"//g; # Start with most restrictive pattern and go to least # Numeric patterns from Perl cookbook, 2.1 # Date allows two digit year return 'int' if $value =~ /^[+-]?\d+$/; return 'float' if $value =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/; return 'date' if $value =~ /^+(JAN|FEB|MAR|APR|MAY|JUN|JUL|AUG|SEP|OCT|NOV|DEC)\s+\d\d?\s+\d\d\d?\d?$/i; return 'char'; } ####################################################################### # no input subroutine # ####################################################################### #section 7 sub no_input_input { if ($doit eq "Send File of Datasets"){ if (param( 'filename' ) eq ""){ &print_no_file_name_sub; } else { return;} } elsif ($doit eq "Submit Input"){ $flag=1; foreach $variable (@required_variables) { next if (param($variable) eq ""); $flag = 0; last; } if ($flag) { &print_no_input_sub; } #end if (flag) } #end if ($doit eq } #end of sub no_input ###################################################################### # no input subroutine for query # ####################################################################### #section 4 sub no_input { $flag=1; foreach $variable (@required_variables) { next if (param($variable) eq ""); $flag = 0; last; } if ($flag) { &print_no_input_sub; } } ####################################################################### # get input from a file and build insert command # ####################################################################### #section 13 sub file_list { foreach $element_red (@file_line) { #print "element=$element_red\n"; @value_red = split (/,\s*/, $element_red); # @value_red = map (quote_literals ($_), @value_red); $value_red = join (',', @value_red); # print "insert into stis_psf values ($value_red)\n"; push (@cmds,"insert into stis_psf values ($value_red)\n"); } @input_cmd = @cmds; return @input_cmd; } #end sub file_list.========================================= ####################################################################### # subroutine quote literals # ####################################################################### #section 14 sub quote_literals { $_ = shift; $_ =~ s/\s+$//; if ($_ eq 'NULL') {return $_;} $_ = "\"$_\""unless /^-?\d+\.?\d*$/; return $_; } ####################################################################### # printrow section subroutine # ####################################################################### #section 16 sub printrow { print qq~ build sql query

STIS PSF Library Results













origfile psf_file psf_orig xcenter ycenter
$data[0] $data[1] $data[2] $data[3] $data[4]
xcorner ycorner ra_psf dec_psf peakint
$data[5] $data[6] $data[7] $data[8] $data[9]
peakfit saturatd backgnd colortype colorval
$data[10] $data[11] $data[12] $data[13] $data[14]
bvcolor spectral refspec psfscale pixfact
$data[15] $data[16] $data[17] $data[18] $data[19]
focus v2_rms v2_p2p v3_rms v3_p2p
$data[20] $data[21] $data[22] $data[23] $data[24]
detector instrume rootname filetype
$data[25] $data[26] $data[27] $data[28]
opt_elem filter aperture propaper
$data[29] $data[30] $data[31] $data[32]
repeller centera1 centera2 sizaxis1
$data[33] $data[34] $data[35] $data[36]
sizaxis2 binaxis1 binaxis2 ccdgain
$data[37] $data[38] $data[39] $data[40]
bias fgslock expstart exptime
$data[41] $data[42] $data[43] $data[44]
targname ra_targ dec_targ proposid
$data[45] $data[46] $data[47] $data[48]
~; } ####################################################################### # The End # #######################################################################