### $Id: afs_subs.pm,v 1.1 2004/09/20 18:15:03 glennh Exp glennh $ ### Author: Glenn Hamell ### NAME: afs_subs.pm # This software is Copyright (C) 2005 ACE Science Center, # California Institute of Technology. The software is provided to you # without charge, and with no warranty. You may give away copies of # this software, including sources, provided that this notice is included # in all the files. # ### ### ### CALLING SEQUENCE: use afs_subs ; ### ### PURPOSE: ### co-locate common routines employed by the "afs" pgms. ### ### ### MODIFICATION HISTORY: ### ===================== ### 2005Apr04-AJD-can now handle upper-case instrument names on cmdline ### 2004Oct04-GRH-Addedf error of date parsing in ### gen_hidden_value_str. ### 2004Sep28-GRH-integrated plotting cmd line params: ### stacked, overplot, logarithmic, linear, samerange, ### multirange, x_day, x_year, x_epoch, x_records, ### -ytitle, -title, url ### Depends upon "afs_init_info.txt" ### ### 2004Sep20-GRH-Move the subroutines into a ".pm" module. ### Added hook for an "error handler". This needs to be developed. ### Most mods relate to the passing of arguments by reference. ### Another area was the transfer of tables of constants from ### the program script into a reference file. ### The idea: the reference file will live at ASC. ### As instruments are added, the distributed pgm will not have ### to be updated; just add & modify tables in the reference ### file back at the ASC. ### 2004Sep13-Glenn Hamell Created. ### ################################################### package afs_subs; require Exporter; use Cwd; our @ISA = qw( Exporter ); our @EXPORT = qw( afs_init_rv get_known_instruments get_cmdline_parms get_instyp_avgtyp set_ASCurl is_valid_inst_avg Error_Handler get_afs_h_file gen_hidden_value_str scanHtbl_for build_rqst_parms build_hidden_parms_rqst get_sel_parms remove_header ); #========= begin Error_Handler =========== sub Error_Handler { # Generalized Error Handler - mostly still evolving # Expects named arg pairs as: MSG => "Text of msg goes here" # SYNTAX: # $msg="BAD instrument name or BAD inst/avg combination: '" . $instyp . "'"; # $msg=$msg . " '" . $avgtyp . "'"; # Error_Handler( MSG => $msg ); die "Parameters to Error_Handler should be even" if @_ % 2 ; my %args = @_; if( $args{MSG} ) { printf STDOUT "\n$args{MSG}\n\n"; } } #-------- end Error_Handler ------------ #========= GEN_HIDDEN_VALUE_STR ============== sub gen_hidden_value_str { ($instyp, $avgtyp, $parms_r, $Hpn_r, $Hval_r, $avg_types, $avg_time_rv) = @_; # Construct strings for "POST" params: # of "hidden" values... # filename fragment values for: # VDATA_NAME, f_name # Also setup values for: # avg_time, vh_start &/or vh_end values # Recover references to @parms, @Hpn & @Hval arrays my $vdn = '' ; # Working string for vdata_name my $i = -1 ; # Index into Hpn tbl my $is = -1 ; # Save index into Hval for start day my $ip = -1 ; # Index into parms tbl (i.e. cmdline) my $atv = 0 ; # Avg time value used in "action"request my $yr = 0 ; # Used in calc year_of_data my @fields = () ; # Used in calc year_of_data my $low_DOY= '' ; # Used in formatting DOY (day-of-year) #Look for (dash) parms in the cmdline (start & end dates), etc. # (this section must precede the construction of $fn below) for( $ip=0; $ip<=$#$parms_r; $ip++ ) { if( $$parms_r[ $ip ] =~ m/^[-]/ ) { # if start time, find index into H tbl and set the value if( $$parms_r[ $ip ] eq '-s' ) { # Start date flag? if( ($i = scanHtbl_for( 'vh_start', $Hpn_r )) > -1 ) { $yr = $$parms_r[ $ip + 1 ] % 100 ; $yr = "0" . $yr if( $yr < 10 ) ; $$Hval_r[ $i ] = $yr . '/' ; # Ensure no leading zeros in DOY value $low_DOY = $$parms_r[ $ip + 2 ] ; $low_DOY =~ s/^0*// ; $$Hval_r[ $i ] = $$Hval_r[ $i ] . $low_DOY ; $is = $i ; next; } } # if end time, find index into H tbl and set the value if( $$parms_r[ $ip ] eq '-e' ) { if( ($i = scanHtbl_for( 'vh_end', $Hpn_r )) > -1 ) { $yr = $$parms_r[ $ip + 1 ] % 100 ; $yr = "0" . $yr if( $yr < 10 ) ; $$Hval_r[ $i ] = $yr . '/' ; # Ensure no leading zeros in DOY value $low_DOY = $$parms_r[ $ip + 2 ] ; $low_DOY =~ s/^0*// ; $$Hval_r[ $i ] = $$Hval_r[ $i ] . $low_DOY ; next; } } } } # Setup YEAR OF RQSTD DATA @fields = split "\/", $$Hval_r[ $is ] ; # Strip off the two digit year if( $#fields < 0 ) { $msg="Error in parsing Start/End Dates"; Error_Handler( MSG => $msg ); return; } $year_of_data = $fields[ 0 ] % 100 ; if( $year_of_data < 50 ) { $year_of_data += 2000 ; } else { $year_of_data += 1900 ; } # DEVELOP the HDF VGROUP Data Name $vdn = $instyp ; $vdn =~ tr/a-z/A-Z/ ; # Chk for (special case of) swics if( lc $instyp eq "swics" ) { $vdn = "SS"; # SWICS/SWIMS ver2 } $vdn = $vdn . '_data_' . $avgtyp; if(( $i=scanHtbl_for( 'vdata_name', $Hpn_r ) ) > -1 ) { $$Hval_r[ $i ] = $vdn ; } my $fn = '' ; $fn = $vdn ; $fn =~ tr/A-Z/a-z/ ; # For MAG & SWEPAM data intervals of: # 16sec & 4min, use year length data files; # hourly and daily, use full mission length files if( $instyp eq 'mag' ) { if( ($avgtyp eq '16sec') or ($avgtyp eq '4min') ) { $fn_dsgn = '_year' . $year_of_data ; # Designate yearly data file $i = scanHtbl_for( 'hdfref', $Hpn_r ) ; $$Hval_r[ $i ] = ";tag=1962,ref=3,s=0" ; } if( ($avgtyp eq '1hr') or ($avgtyp eq '1day') ) { $fn_dsgn = '' ; # Designate mission length file $i = scanHtbl_for( 'hdfref', $Hpn_r ) ; $$Hval_r[ $i ] = ";tag=1962,ref=6,s=0" ; } } if( $instyp eq 'swepam' ) { if( $avgtyp eq '64sec') { $fn_dsgn = '_year' . $year_of_data ; # Designate yearly data file $i = scanHtbl_for( 'hdfref', $Hpn_r ) ; $$Hval_r[ $i ] = ";tag=1962,ref=3,s=0" ; } if( ($avgtyp eq '1hr') or ($avgtyp eq '1day') ) { $fn_dsgn = '' ; # Designate mission length file $i = scanHtbl_for( 'hdfref', $Hpn_r ) ; $$Hval_r[ $i ] = ";tag=1962,ref=3,s=0" ; } } if( $instyp eq 'epam' ) { if( $avgtyp eq '5min') { $fn_dsgn = '_year' . $year_of_data ; # Designate yearly data file $i = scanHtbl_for( 'hdfref', $Hpn_r ) ; $$Hval_r[ $i ] = ";tag=1962,ref=6,s=0" ; } if( ($avgtyp eq '1hr') or ($avgtyp eq '1day') ) { $fn_dsgn = '' ; # Designate mission length file $i = scanHtbl_for( 'hdfref', $Hpn_r ) ; $$Hval_r[ $i ] = ";tag=1962,ref=3,s=0" ; } } if( $instyp eq 'swics' ) { $fn =~ s/^ss/ssv2/; # SWICS/SWIMS ver2 if( $avgtyp eq '1hr') { # SWICS 1hr... $fn_dsgn = '_year' . $year_of_data ; # Designate yearly data file $i = scanHtbl_for( 'hdfref', $Hpn_r ) ; $$Hval_r[ $i ] = ";tag=1962,ref=3,s=0" ; # Ensure user has not requested any of the 2hr parameters (34-43) # for each param in cmd line get index of match in Hpn tbl for( $ip=0; $ip<=$#$parms_r; $ip++ ) { if( ($i = scanHtbl_for( $$parms_r[ $ip ], $Hpn_r )) > -1 ) { if( $$Hval_r[ $i ] > 33 ) { # 1hr params max out at 33 $$parms_r[ $ip ] .= "NA_"; # Pre-pend "NA_" to user param } } } } if( $avgtyp eq '2hr' ) { $fn_dsgn = '_year' . $year_of_data ; # Designate yearly data file $i = scanHtbl_for( 'hdfref', $Hpn_r ) ; $$Hval_r[ $i ] = ";tag=1962,ref=3,s=0" ; } } $fn = $fn . $fn_dsgn . '.hdf' ; if(( $i=scanHtbl_for( 'f_name', $Hpn_r ) ) > -1 ) { $$Hval_r[ $i ] = $fn ; } # Set the Average Time Interval value into the H table if( ($i = scanHtbl_for( 'avg_time', $Hpn_r )) > -1 ) { for( $ip=0; $ip<=$#$avg_types; $ip++ ) { if( $avgtyp eq $$avg_types[ $ip ] ) { $$Hval_r[ $i ] = $$avg_time_rv[ $ip ] ; last; } } } } #------------- end gen_hidden_value_str ------------- #========= SCAN_HTBL_FOR ============== sub scanHtbl_for { # Arguments: a string to scan for and a ref to a tbl to be scanned. # ex: $i = scanHtbl_for( 'avg_time', $Hpn_r ); # Returns index into (ex: Hpn) tbl or -1 (not found). my $s = $_[ 0 ] ; $Hpn_r= $_[ 1 ] ; my $i = $#$Hpn_r ; while( lc $s ne lc $$Hpn_r[ $i ] ) { $i-- ; last if( $i < 0 ) ; } return( $i ); } #------------- end scanHtbl_for ------------- #========= begin AFS_INIT_RV =========== sub afs_init_rv { # Init given arrays # Caller supplies references to arrays to be filled my ( $rtyp, $refval, $flags_r ) = @_; # (@avg_types, @avg_time_rv, %flags) $reflags=$flags_r; # Make $reflags global (%flags) $dbug = $$reflags{ dbug }; # RETRIEVE INFO TABLE FROM ACE WEB SITE my $fname = "./afs_init_info.txt"; use LWP::Simple; # This is way cool my $doc = get 'http://www.srl.caltech.edu/ACE/ASC/DATA/afs/' . $fname; if(( $dbug ) || ( getcwd() eq "/users/asc/afs/gh_ex" )) { $doc = `cat $fname`; } # MAKE INTO TABLE (PSEUDO FILE) @lines_init_info = split "\\n", $doc ; # open FH, "<$fn" or die "Can't open $fn \n $! \n"; #read entire file (array s/b global) # @lines_init_info = ; # close FH; my @lines = get_section_info( "avgtyp_refvals" ); foreach ( @lines ) { # go thru file for value pairs chomp; printf STDERR "avgtyp_refvals: '$_'\n" if( $dbug ); if(( length( $_ ) > 0 ) && # ignore lines comment lines ( $_ !~ /^\#/ )) { # ignore blank lines $_ =~ s/\s+//g ; @field = split /,/ ; push( @$rtyp, "$field[0]" ); #return vals thru call push( @$refval, $field[1] ); } } } #--------- end afs_init_rv ----------- #========= begin GET_SECTION_INFO =========== sub get_section_info { # Scans the @lines_init_info array for the named section # returning an array of lines from that section # ignores blank & comment lines. my $sect_name = $_[0]; # recover the name my @flds = (); my @lines=(); my $hdr = 'SECTION_HEADING'; my $ln = ""; # Scan for a SECTION_HEADER my $idx=0; foreach ( @lines_init_info ) { # Each line in "file" if( $_ =~ /$hdr/ ) { # Header?? chomp; $_ =~ s/\s+/ /g ; # Rmv extra spaces @flds = split ; # Get the fields if( $flds[1] eq $sect_name ) { # Section name we want?? $idx++; # Move past header line # Read loop while(( $idx <= $#lines_init_info ) && # more lines?? ( $lines_init_info[$idx] !~ /$hdr/ )) { # new Section_Header? $ln = $lines_init_info[$idx]; chomp $ln; if(( length( $ln ) <= 0 ) || # Blank line?? ( $ln =~ /^\#/ )) { # Comment ?? $idx++; next; } $ln =~ s/,\s+/,/g ; push( @lines, $ln ); # save line $idx++; # move on to next line } return( @lines ); } } $idx++; } printf STDERR "\nERR get_section_info: \n"; printf STDERR " Did not find '$sect_name'\n\n"; return( -1 ); } #-------- end get_section_info ------------ #========= begin GET_KNOWN_INSTRUMENTS =========== sub get_known_instruments { # Init given array my $ref = $_[0]; my $i = 0; ### ADD TO THIS LIST...AS CODING DEVELOPS/EVOLVES # @$ref = ( 'mag', 'swepam' ); my @lines = get_section_info( "known_instruments" ); foreach ( @lines ) { chomp; $_=~s/\s+//g ; @flds = split /,/ ; $$ref[$i++] = $flds[0]; } $ref = \@lines; } #-------- end get_known_instruments ----------- #========= begin GET_CMDLINE_PARMS =========== sub get_cmdline_parms { # Save cmdline args into a local table & return table my ( $fields ) = $_[0] ; # Pass-by-reference # Recover debug flag $dbug = $$reflags{ dbug }; @$fields = (); my $nfields = $#ARGV + 1; printf STDERR "nfields=$nfields \n" if( $dbug ) ; my $i = 0; while( $i < $nfields ) { $fields->[ $i ] = $ARGV[ $i ] ; printf STDERR "fields[%d]=%s\n",$i,$fields->[$i] if( $dbug ) ; # Rmv redundant names dealing with avg interval $fields->[ $i ] =~ s/hourly/1hr/ ; $fields->[ $i ] =~ s/daily/1day/ ; $fields->[ $i ] =~ s/Hourly/1hr/ ; $fields->[ $i ] =~ s/Daily/1day/ ; # Liberalization... "seconds" field may be requested as "sec" if( $fields->[ $i ] eq "sec" ) { $fields->[ $i ] = "seconds" ; } $i++; } # Check if plotting...set appropriate flags foreach ( @ARGV ) { if( lc $_ eq "plot" ) { $$reflags{ plot } = 1; } if( lc $_ eq "url" ) { $$reflags{ url } = 1; $$reflags{ plot } = 1; } } #if not plotting, ck for presence of plot option terms if( not $$reflags{ plot } ) { my $a = ""; my @f = (); my @p_opt = (); @po_tbl = get_section_info( "plot_option_tbl" ); CK_PLT_OPT: foreach ( @po_tbl ) { # prepare plot option words for compare @f = split /,/ ; foreach $a ( @ARGV ) { # scan cmdline args if( lc $a eq $f[0] ) { $$reflags{ plot } = 1; last CK_PLT_OPT; } } } } if( $dbug ) { for( $i=0; $i < $nfields; $i++ ) { printf STDERR "'$fields->[$i]' \n" ; } } } ###-------- end get_cmdline_parms -------------------- #========= GET_INSTYP_AVGTYPE ============== sub get_instyp_avgtyp (\@\@\@) { # The individual cmdline parameters are passed by reference into this routine. # Returns the instrument type & the instrument average my ($parms_r, $known_instruments_r, $avg_types_r) = @_; # Go thru cmdline parms for instrment type & time avgs string matches # Something like: mag ... then 1hr or 64sec, etc. # # The cmdline arg list is exhaustively scanned. # This means a subsequent appearance of an instrument # type (or time average) will supercede the previous # occurrance of instrument type (or time average). # # Note that the cmdline value "ion" will be converted to "64sec". my $instyp = '' ; my $inst = '' ; my $avgtyp = '' ; my $avg = '' ; my $p = '' ; my $lcp = '' ; # handle upper- and lower-case # Develop the H filename INSTRUMENT_TYPE: $inst = $instyp; foreach $inst ( @$known_instruments_r ) { foreach $p ( @$parms_r ) { # go thru parms of cmdline $lcp = lc $p; if (( $p eq $inst ) || ( $lcp eq $inst )) { $instyp = $inst ; } } } AVG_TYPE: foreach $avg ( @$avg_types_r ) { # go thru time avg types foreach $p ( @$parms_r ) { # go thru parms of cmdline $lcp = lc $p; if (( $p eq $avg ) || ( $lcp eq $avg )) { $avgtyp = $avg ; } } } $avg = "64sec" if( $avg eq "ion" ) ; return( $instyp, $avgtyp ); } #--------- end get_instyp_avgtyp ----------------------- #========= begin SET_ASCURL =========== sub set_ASCurl ( $ ) { my $inst = $_[0] ; # Develop the URL string my $N = ""; my $V = ""; my %url_h ; my @lines= get_section_info( "ASCurl" ); foreach ( @lines ) { # Build hash tbl $_=~s/\s+//g; my ($N,$V) = split /,/ ; $url_h{$N} = $V; } return( $url_h{ path } . $url_h{ $inst } ); } #-------- end set_ASCurl -------------------- #========= begin IS_VALID_AVG =========== sub is_valid_inst_avg ( $$\@ ) { # Determine if the given the instype and avgtyp and # combination is legitimate. # The @known_instruments is also given and the instyp is validated. # Returns 0 if OK; 1 if Bad Combo. my ($instyp,$avgtyp,$inst_r) = @_; # Retrieve params passed my $ins=""; # my $avg=""; my @lines = (); my @flds = (); # Get valid avgs from info file @lines = get_section_info( "valid_averages" ); foreach ( @lines ) { chomp; $_=~s/\s+//g ; # Remove all spaces @flds = split /,/ ; if( $flds[0] eq $instyp ) { # shift @flds; # Remove 1st field (inst name) leaving avgs for( my $i=1; $i<=$#flds; $i+=2 ) { # if( $avg eq $avgtyp ) { if( $flds[$i] eq $avgtyp ) { $flags{ avg_time } = $flds[$i] ; $flags{ file_dur } = $flds[$i+1] ; # used to help build data filename return( 0 ); } } } } # if we get to here - there's a bad instrument name or avg combo return( 1 ); } #-------- end is_valid_inst_avg ------------ #========= GET_AFS_H_FILE ============== sub get_afs_h_file { # Recover params passed from caller my ($instyp,$Hpn_r,$Hqn_r,$Hval_r) = @_; # Recover debug flag $dbug = $$reflags{ dbug }; # INIT H file string tables # cmdline parm for instrument type is $instyp & time avgs is $avgtyp # something like: mag, swepam,... & 1hr, 64sec, etc. my $fname = '' ; my $pn = '' ; my $qn = '' ; my $val = '' ; my $Hcnt = 0 ; my @Hlines = (); # Develop the H filename $fname = "afs_h_" . $instyp . "\.txt" ; printf STDERR "DBUG:get_afs_h_file: fname='$fname' \n" if( $dbug ) ; # GET the modified H file FROM ACE WEB SITE use LWP::Simple; # This is way cool my $doc = get 'http://www.srl.caltech.edu/ACE/ASC/DATA/afs/' . $fname; if((getcwd() eq "/users/asc/afs/gh_ex") && ($instyp eq "swics")) { $doc = `cat $fname`; } printf STDERR "\$doc from web: \n $doc \n" if($dbug); # MAKE INTO TABLE (PSEUDO FILE) @Hlines = split "\\n", $doc ; my $lnknt = 0 ; my $found_end=0 ; #count occurrance of "_endlist_"; 0=init while( 1 ) { # Copy All (parsed) strings into the H tables #Get cmdline parm name, "POST"request name, "POST"value ($pn, $qn, $val) = get_one_DATA_line( \$Hcnt, \@Hlines ) ; $pn =~ tr/A-Z/a-z/ ; # Ensure lower case chars (for comparisons) $$Hpn_r[$lnknt] = $pn ; # Parameter Name $$Hqn_r[$lnknt] = $qn ; # Query Name $$Hval_r[$lnknt] = $val ; # Value if( $pn eq '_endlist_' ) { # Terminating line for this section? $found_end++; # There are two sections last if( $found_end > 1 ) ; } # Chk if SWICS 1hr, skip (fewer params than SWICS 2hr) as necessary $lnknt++; } # APPEND PLOT OPTION WORDS, if in plot mode if( $$reflags{ plot } ) { @po_lines = get_section_info( "plot_option_tbl" ); foreach ( @po_lines ) { ($pn, $qn, $val) = split /\,/ ; push( @$Hpn_r, $pn ); push( @$Hqn_r, $qn ); push( @$Hval_r,$val); } } # SET RETRIEVE_TYPE Value: # 1=Plot, 2=file download(used for afs), 3=text on screen(not for afs) $i = scanHtbl_for( "retrieve_type", $Hpn_r ); if( $$reflags{ plot } == 1 ) { $$Hval_r[ $i ] = 1; } else { $$Hval_r[ $i ] = 2; } printf STDERR "DBUG:get_afs_h_file: retrieve_type=$$Hval_r[ $i ] \n" if( $dbug ) ; } #------ end get_afs_h_file ------------------------- #========== begin get_one_DATA_line ================ sub get_one_DATA_line { #read one line from the "@Hlines" pseudo file #Returns the parsed values: param name, reqst name, value #SYNTAX: # ($pn, $qn, $val) = get_one_DATA_line( \$Hcnt, \@Hlines ) ; my ($Hcnt_r, $Hlines_r) = @_ ; my $line_valid = 0 ; my $linein = '' ; my @field = () ; LINE: while( $$Hcnt_r <= $#$Hlines_r ) { $linein = $$Hlines_r[ $$Hcnt_r++ ] ; if( length( $linein ) < 2 ) { #empty line ? next LINE ; } if( $linein =~ m/^[\#\s]/ ) { #comment/blank line next LINE ; } if( $linein =~ m/^__DATA__/ ) { #header line next LINE ; } last; } chomp $linein ; $linein =~ s/,\s+/,/g ; # remove leading spaces @field = split /,/ , $linein, 3 ; # get the 3 fields return( $field[0], $field[1], $field[2] ); } #-------- end get_one_DATA_line -------------------- #======== BUILD_RQST_PARMS() ===================== sub build_rqst_parms { my ($parms_r,$Hpn_r,$Hqn_r,$Hval_r,$t_r)=@_; # Go through supplied parms...use "H" tbl to help gen strings # Build hidden (required/default) params. build_hidden_parms_rqst($Hpn_r,$Hqn_r,$Hval_r,$t_r) ; get_sel_parms( $parms_r,$Hpn_r,$Hqn_r,$Hval_r,$t_r ) ; } ###------- END build_rqst_parms ------------------------- #========== begin GET_SEL_PARMS ==================== sub get_sel_parms { my ($cmdlst_r,$Hpn_r,$Hqn_r,$Hval_r,$t_r) = @_ ; # Recover debug flag $dbug = $$reflags{ dbug }; # Return string of selected params (ref cmdline parms) my $s = ''; my $i = 0; my @fld= (); my $p = ''; my $lnknt = 0 ; my $eq_sign_here = 0; # 0=No my $nelem_t = 0; #Used to determin if match was found in push loop my $cmdidx = -1; # Go thru cmdline params and supply strings for "POST" request line # For each element in cmdlist, find match in param list & # generate add'l request string foreach my $c ( @$cmdlst_r ) { $cmdidx++; # Used to ref subsequent elem in cmdlst printf STDERR "DBUG:get_sel_parms: c='$c' \n" if( $dbug ) ; $eq_sign_here = 0; # 0=No if( $c =~ m/=/ ) { # If "=" in supplied string, use supplied value $eq_sign_here = 1 ; #1=Yes, it's present @fld = split( /=/, $c ) ; $c = $fld[0] ; printf STDERR "DBUG:get_sel_parms: fld0='$fld[0]' fld1='$fld[1]' \n" if( $dbug ) ; } $nelem_t = $#$t_r; # Last index of the "t" array $i = 0; foreach my $p ( @$Hpn_r ) { if( $p eq lc $c ) { if( not $eq_sign_here ) { push @$t_r, "$$Hqn_r[$i]" ; if(( lc( $c ) =~ "-title" ) || ( lc( $c ) =~ "-ytitle" )) { # Assign VALUE from the input string push @$t_r, trim_quotes( $$cmdlst_r[ $cmdidx+1 ] ); } else { push @$t_r, "$$Hval_r[$i]" ; } } else { push @$t_r, "$$Hqn_r[$i]" ; push @$t_r, "$fld[1]" ; } printf STDERR "DBUG:get_sel_parms: '@$t_r' \n" if( $dbug ) ; last; } $i++; } } } ###------- END get_sel_parms ------------------------- #======= begin TRIM_QUOTES() =================== sub trim_quotes { # Remove the surrounding blanks & quotes my $s = ''; $s = $_[0] ; $s =~ s/^\s+// ; $s =~ s/\s+$// ; $s =~ s/^[\'\"]// ; $s =~ s/[\"\']$// ; return( $s ); } ###------- END trim_quotes ------------------------- #======= begin CK_T() =================== sub ck_t { # Get index into @t matching word passed in argument my $idx = -1; for( $idx=0; $idx<=$#t; $idx++ ) { last if( $t[ $idx ] =~ $_[0] ) ; } return( $idx ); } ###------- END ck_t ------------------------- #======= begin BUILD_HIDDEN_PARMS_RQST() =================== sub build_hidden_parms_rqst { # Sets hidden params & default values my ($Hpn_r,$Hqn_r,$Hval_r,$t_r)=@_; # Recover debug flag $dbug = $$reflags{ dbug }; my $s = ''; my $pn = ''; my $qn = ''; my $val= ''; # my $caltech = 'http://www.srl.caltech.edu/' ; my $lnknt = 0 ; while( 1 ) { #Get first(next) parm name, request name, value $pn = $$Hpn_r[$lnknt]; printf STDERR "build_hidden_parms_rqst: pn='$pn'\n" if( $dbug ) ; last if( $pn eq '_endlist_' ) ; # Terminating line for this section? if( $pn eq "action" ) { #skip action line, info from set_ASCurl $lnknt++; next; } else { push @$t_r, "$$Hqn_r[$lnknt]" ; push @$t_r, "$$Hval_r[$lnknt]" ; } $lnknt++; } } #-------- end build_hidden_parms_rqst -------------------- #========= REMOVE_HEADER ============== sub remove_header { $res_r = $_[0]; # Points to response from server # There is unwanted info at the beginning of the RESPONSE # Return the first line with & all that follows my @lines = split "\n", $$res_r ; my $i = 0; my $is= 0; for( $i=0; $i <= $#lines; $i++) { if( $lines[$i] =~ m// ) { $is = $i ; last; } } $$res_r = ""; for( $i=$is; $i <= $#lines; $i++) { $$res_r = $$res_r . $lines[$i] . "\n" ; } } #------------- end remove_header -------------