#!/usr/bin/perl # # Name: $OPTHOME/optbin/download-4 # Purpose: part of JGOFS data download package # split data into smaller files, get info file # pkg data and info for download # # Modification history: # Dec 98.clc. under development. # 981018.clc. add build-download-env.plx # 981223.clc. work on bulk=onebig, maxlev=0 # 990204.clc. get info file via LWP and getstore # 990210.clc. add PKZip support for Windows and Mac platforms # 990211.clc. modify HTML header lines # 990222-24.clc. work on naming of pkg file and $bundle cmd failure # 990305.clc. allow user to select listm options. # 990308.clc. add underscore separator in subdir and file names; # tar with no compression option; appearance mods; # color pallette # 990315.clc. work on maxlev>2 case. # 990322.clc. add subselection capability for one big file pkg type. # 990325.clc. use # instead of _ as param#value concatenator # Can not use: _ - ! # Should make this a variable $eqs = "=" # Would be nice to keep it single char so I can use tr # Pipe listm output to datafile (instead of eval) so I can # trap any listm errors. Assume listm errmsg =~ /^&x / # 990506.clc. still working on MOCNESS data object problems. # -990521. add err handling for data write errs. # 990527.clc and wjs. debugging Broken Pipe err - write_data subr # 990602.clc. replace write_data with system call to listm > file # 990610-14.clc. new ver listm. script err? change some STDERR msgs to DWNLD # in preparation for removing DBG msgs. # 990616.clc. pass subsels to download-problem; request feedback to dbasemgr; # update onebig section; improve 'onebig' err reporting # 990617.clc. one last attempt to trap, test & report listm errs. Success! # 990621.clc. cosmetic mods. # ###### download version 1.0 # 990621.clc. port to OO server for installation/testing. # 990623.clc. use list instead of listm. # 990624.clc. make objserver compatible with opt-build-env INFOSERVER; # get pkging/compression progs from ENV vars. # 990715.clc. OPTIONSERVER, direcpage to optsmenu changes. # 991122-30.clc. mods for merge with rest of oopt software; # dobject;subsdisp;tempdir;getinfo # 991201.clc. merge/debug with ooptserver on synthesis; dispobj; fmt header # 991206.clc. use OBJEXT to fix remote object bug # 991209.clc. $objnsels: allow object with subsels to be pkgd into multiple # files; DWNLDERR msgs; trap errs for determinant mismatch and # no data (ie. listovals is empty) # 991216.clc. work on objnsels; must pass subsels with obj; write_data subr # ###### download version 1.1 (991216) # 991229.clh. temporary fix to ameliorate problem with INFOSERVER used # in place of "real" info serving host. needs to be linked to # object rather than a static address defined at compile time. # # ===================================================================== require "cgi-lib.pl"; use File::Copy; use File::Path; use Cwd; use LWP::Simple; MAIN: { # # set up some variables # $protocol = "http://"; $logfile = "README"; # download status log file # color palette $credhi = "indianred"; $chdrbar1 = "skyblue"; $cgobar = "mediumaquamarine"; $dbasemgr = "$ENV{'SERVER_ADMIN'}"; # local database manager print STDERR " DWNLD: using script: $0 \n"; $now = `date`; # get local time print STDERR " DWNLD: $now \n"; # # These variables set by makefile from ENVars at install time # $jgtopdir = "/home/data1/www/optserver"; # top of JGOFS tree $jgbindir = "$jgtopdir"."/bin"; # JGOFS binary execs $jgscdir = "/jg"; # where are CGI scripts? $webimages = "http://optserv2.whoi.edu:80/images"; # where are web images? # $getinfo = "mvcodata.whoi.edu/jg/info"; # data doc file retrieval system $optsmenu = "http://optserv2.whoi.edu:80/jg/otheropt"; # JGOFS other options menu # # # which archive and compression (tar,compress,zip) programs to use # $bundle = "/bin/tar cf"; $pkgtype = ".tar"; $comp = "/usr/bin/compress"; $compext = ".Z"; $compgz = "/usr/sbin/gzip"; $compgzext = ".gz"; $pcbundle = "/usr/bin/zip -r"; $pcpkgtype = ".zip"; $pccomp = ""; # # listm options used to control info returned to script # Note: user determined listm options passed as $input{'listm_user'} # $list = "$jgbindir"."/list"; # which list program to use $listm_opts = "-n -f -c"; # ############################################################# # # Read in all the variables set by the form # &ReadParse(*input); # # Print the header # print &PrintHeader; print < Data download - final form.

Data download - final form

ENDOFTOP # # get information passed in {input} array # $dobject = "$input{'dobject'}"; # jgofs object string $dobjext = "$input{'dobjext'}"; # jgofs object string with extension $dispobj = "$input{'dispobj'}"; # jgofs object+(QS) for display $subsels = "$input{'subsels'}"; # subselections list to pass along $subsdisp = "$input{'subsdisp'}"; # un-trigram'd subsels list for display $objnameonly = substr($dobject,rindex($dobject,"/")+1); $objnsels = "$dobject($subsels"; # object(sub,sels ; no final paren $user_confirm = "$input{'confirm'}"; $filesize = "$input{'bulk'}"; $maxlev = "$input{'maxlev'}"; $compress = "$input{'compress'}"; $listm_user = "$input{'listm_user'}"; $tempdir = "$input{'dtempdir'}"; # tmpdir/client_host $utility = "download"; # tmp = tmpdir/client_host/download # # make full options menu specifier with data object [and subsels] # $back_to_opts = "$optsmenu"."$dobjext"."?"."$subsels"; # get user selected name for packaged datafile if ( "$input{'customname'}" ne "") { $pkgname = "$input{'customname'}"; } else { $pkgname = "$input{'pkgname'}"; } # # sometimes I need to chop last char from pkgname (ie. from drop down list) # if last char of pkgname string is a non-alphanumeric then remove it chop $pkgname if ( substr($pkgname,-1,1) =~ /\W/ ); if ($user_confirm eq "yes") { # # user selections have been made and confirmed ... let's do it ... # print STDERR " DWNLD: Working on object: $dispobj \n"; print STDERR " DWNLD: dobject: $dobject \n"; print STDERR " DWNLD: dispobj: $dispobj \n"; print STDERR " DWNLD: objnsels: $objnsels \n"; # # if user has assigned a value to the level, use it # @determine = split("%",$input{'levelparams'}); # # make a new directory tree # flag determines if we remove this directory tree if it already exists # $flag="no"; $hostdir = make_directory($tempdir,$utility,$flag); $flag="yes"; $objdir = make_directory($hostdir,$objnameonly,$flag); $flag="no"; # # create README log file to keep track of progress during processing # $logfile = "$objdir"."/"."$logfile"; $badlog = &create_readme; # $badlog is TRUE if we fail to create a readme file print STDERR " DWNLDERR: could not create $logfile \n" if $badlog; # # The number of determinant parameter levels (maxlev) controls flow. # If there are 0 levels, user wants all data in one single file, so # we just drop right down to make_files subroutine. # However, for multiple levels, we need to get parameter lists: # If only 1 level, force one call to getallvalues . # If 2 levels, only need to getallvalues once. # If more than 2 levels, do getallvalues (#levels - 1) times # We must get all values at each user-selected level, but # we do level 0 and level 1 in first pass, level 1 and 2 next # and so on, so #passes = #levels-1 or maxlev-1 # Note: I could probably create a %filename{$selection} of filenames # indexed by selection string, but this could be done later # As we progress, build param#value strings # &add_note ("Locating data files. Report any errors here: "); @listovals = (); if ( $maxlev > 0 ) { # user wants data divided into multiple (moresmall) files # # get a list of all values at level 0 # @listovals = &get0values; # # Abort if we don't have a list of values; no point in continuing if (@listovals eq "") { &add_note ("\nSorry, unable to find any data for $dispobj"); &uh_oh ("Unable to find any data for $dispobj"); } $thislev=1; $param=$zp; if ( $maxlev == 1 ) { # number of levels = 1 # so we force thislev to be zero because we only have one level, # getallvalues and nullify the higher level selection criteria $thislev=0; @listovals = &getallvalues(); # What if @listovals is null? Should I call uh_oh and bail now too? $valu=""; } else { # number of levels > 1 while ( ($maxlev - $thislev) > 0 ) { @nextvals = (); foreach $val (@listovals) { # make subdirectories as we go through selection list $temp = $val; ($datadir = $temp) =~ tr/+/\//; $fulldirec = &make_directory($objdir,$datadir,$flag); @newvals=&getallvalues($val); # if @newvals is null (due to problem in &getallvalues) skip ahead # to next $val in @listovals if (@newvals) { @nextvals = (@nextvals,@newvals); } } $thislev++; @listovals = @nextvals; } } } # # Check whether we have data to process; if not, note in log and abort # if (@listovals eq "") { &add_note ("\nSorry, unable to find any data for $dispobj"); &uh_oh ("Unable to find any data for $dispobj"); } # # All seems OK - make the data file(s) # # should give user a progress report of data packaging status; frame? # Something like: # Creating individual files for $objnameonly data, please wait . . . # Packaging ... # &add_note ("\nOK ... START MAKING DATA FILES ... "); $data_status = &make_files; if ($data_status) { $status_msg = $data_status; $err_warning = "WARNING: data retrieval error"; } else { $err_warning = $status_msg = ""; } # # # # # # # # All data files have been processed. # # # # # # # # copy the documentation info file for this data object # $infoURL = ©_data_doc; $selection = ""; &add_note(" "); &add_note("Documentation info file written."); # # bundle up all the files for this object # &add_note("$dispobj data download request completed:"); &add_note(`date`); $datapkgfile = &bundle_em_up; # # tell user to download packaged file # print <Current object is: $dispobj

Download your packaged $objnameonly data now.
$err_warning

An information file for your data set is included in package
as well as a README file $status_msg 

  Return to Plotting and Other Options menu

This is a trial system. Please help us improve it by giving us some feedback. We would like to know what you liked/didn't like, what worked/failed. Please consider sending us some mail. Thank you. ENDOFTEXT $now = `date`; # get local time print STDERR "\nData DWNLD: $dispobj request completed\n"; print STDERR "Data DWNLD: at $now \n"; print STDERR "Data DWNLD: === end of script $0 === \n\n"; } else { # # user confirm indicated a problem ... find out what they want to do # &bad_confirmation } # # Close html file cleanly. # print &HtmlBot; } sub get0values { $zerovals = `$list $listm_opts \"$objnsels,$determine[0])\"`; chomp $zerovals; # # handle any error msg returned from list program and exit immediately. # &uh_oh ($zerovals) if $zerovals =~ /^&x /; @zerovals = split(' ',$zerovals); # # first value that is output by list is the name of the parameter # $zp=shift @zerovals; # # does it match with what we THINK we are getting? # if ($zp ne "$determine[0]") { print STDERR " DWNLDERR: data access problem: $zp does not equal $determine[0] \n"; &mis_match("$zp","$determine[0]"); &uh_oh("Data access problem: $zp does not equal $determine[0]"); } # # Remove dulplicates from zerovals array # @zerovals = unique_vals(@zerovals); # # # Build selection list # Add a param#value pair to selection list for every item in the list # foreach $item (@zerovals) { $paramlist = "$zp"."#"; push(@sel_list,"$paramlist"."$item"); } return (@sel_list); } sub getallvalues { # the previous selection list of parameters is passed in, one at a time my $presel=pop @_; # change parameter list from param#value back into param0=val0,param1=val1 format ($selection = $presel) =~ tr/#+/=,/ ; $d=$determine[$thislev]; # # this section determined by value of maxlev which is GE 1 # if ( $maxlev == 1 ) { # # prepend determinant parameter onto list of zerovals @vallist = ($param,@zerovals); } else { # # OK ... maxlev is > 1, so we still need to get more info # remember to remove all leading whitespace from params # need some error handling here; trap any listm error and bail # $vallist = `$list $listm_opts \"$objnsels,$selection,$d)\"`; chomp $vallist; # # handle any error msg returned from list program and exit immediately. # &uh_oh ($vallist) if $vallist =~ /^&x /; @vallist = split (' ',$vallist); } # # first value in list is the name of the parameter, rest are values # $determinant=shift @vallist; # # does it match with what we THINK we are getting; if not then abort # if ($determinant ne "$determine[$thislev]") { &mis_match("$determinant","$determine[$thislev]"); &uh_oh("Data access problem: $determinant does not equal $determine[$thislev]"); } # # Remove dulplicates from vallist array # @vallist = unique_vals(@vallist); # # keep the values for each parameter in a hash of lists (arrays) # Need to make a hash of vallist arrays. See Camel book pg 266-268 # Note: key modified to be param+value (ie. leg+1 = leg1) otherwise # if duplicate value found at different level, higher level # would replace previous level at that value (station1 over leg1) # Also, need to save selection list from each level parameter # How do I build param_list for lev 0 -> maxlev-2 when maxlev > 2 ? # $pvalkey = "$param"."_"."$which"; $keep{$pvalkey} = [ @vallist ]; # # Build selection list # Add a param#value pair to selection list for every item in the list # $paramlist = "$presel"."+"."$d"."#"; @sel_list = (); foreach $item (@vallist) { push(@sel_list,"$paramlist"."$item"); } return (@sel_list); } sub make_files { @all_selections = @listovals; if ( $filesize eq "onebig" ) { # # This can probably be combined into one operation regardless of # one vs multifile, but for initial testing phase, keep em separate ... (clc) # user requests all data in single data file # $filename = "$objnameonly".".all"; $fullfile = "$objdir"."/"."$filename"; print STDERR " DWNLD: create $filesize data file: $fullfile \n"; print STDERR " DWNLD: for $dispobj \n"; # # write the data to a file # &write_data($objnsels,$subsels,$fullfile); # # check data file for errors # &add_note ("... checking $filename"); $status = &check_data ($fullfile); } else { # user requests data divided into multiple (moresmall) data files; # make data files (directory hierarchy already exists) # foreach $selection (@all_selections) { $selection =~ s/^\+//; # remove leading + (maxlev=1) $temp = $selection; # make filename and selection list from param#value pairs ($filename = $temp) =~ tr/+/\//; # replace + with / $selection =~ tr/#+/=,/; # replace # with = and + with , $fullfile = "$objdir"."/"."$filename"; print STDERR " DWNLD: do listm $objnsels,$selection) \n"; print STDERR " DWNLD: to $fullfile \n"; # # write the data to a file # &write_data($objnsels,$selection,$fullfile); # # check data file for errors # $status = &check_data ($fullfile); # } } return "$status"; } sub write_data { my ($listobj,$selection,$datafile) = @_; # # Use the list program to get data listing: # Write data out to a file; listm doesn't return bad status if &x error, # but it does exit listm. Errors go to STDOUT. Must capture errs to a file # otherwise they cause a "malformed header from script" error that generates # an httpd "500 Internal Server Error" preventing download-4 screen from being # displayed. Send STDOUT to $datafile too, so error msg ends up in file and # user is aware there was an error. # if ($selection) { $listobj = "$listobj,$selection)"; } else { $listobj = "$listobj)"; } &add_note ("... creating: $filename"); &add_note ("... for: $listobj"); eval { system "$list $listm_user \"$listobj\" > $datafile" }; &add_note ("... Error: $@ \n") if $@; } sub check_data { # # check file for errors; report total number of data records in file # my ($datafile) = @_; open (FLIN, "< $datafile") || &uh_oh ("Error opening $datafile for read : $!"); $nrec = 0; $err_found = 0; $! = 0; while ( ) { $nrec ++; if ( $_ =~ /^&x / ) { # we found an error msg in the datafile; set err report verbage $err_found = "which includes an important error report."; $nrec --; # decrement num recs read by 1 for errmsg line &add_note ("... $filename aborted at line $nrec : $_"); &add_note ("... Previous line was: $prevln"); print STDERR " DWNLDERR: listm errormsg= $_ \n DWNLDERR: after $prevln \n"; } $prevln = "$_"; # save last line of data read } &add_note ("... Read error after record $nrec : $!") if ( $! != 0 ); &add_note ("... $nrec lines of data in $filename. \n"); # done checking file, close it. close (FLIN) || &add_note ("... Error on CLOSE: $filename : $? "); # return "$err_found"; } sub unique_vals { my @list = @_; # Remove dulplicates from an array, order doesn't matter; # see Perl Cookbook (Bighorn Sheep book) pg. 102 # Extracting unique elements from a list (straightforward method - # slower but more easily understood) %seen = (); @uniq = (); foreach $item (@list) { unless ( $seen{$item} ) { # we have a unique one; keep it $seen{$item} = 1; push(@uniq, $item); } } return @uniq; } sub make_directory { my ($parent, $dirname, $cleanup) = @_; umask(022); # # check that the parent string has a slash at end # if (substr($parent,-1,1) ne "/") { $parent.="/"; } # # if it's cleanup time and this directory already exists, # get rid of it and entire tree if ( $cleanup eq "yes" && -d "$parent$dirname" ) { eval { rmtree("$parent$dirname") }; print STDERR "DWNLDERR: delete $parent$dirname failed: $@ \n" if $@; } # # mode used by mkdir looks at lowest 9 bits # eval { mkdir "$parent$dirname",493 }; print STDERR " DWNLDERR: mkdir $parent$dirname failed: $@ \n" if $@; return "$parent$dirname"; } sub bundle_em_up { chdir "$objdir"; $tardir = cwd(); # # determine which archiving and compression routines to use # if ( index($compress,"tar") > -1 ) { # use UNIX type utilities # UNIX compress selected by default (use ./* to avoid warning msg) $all = "./*"; if ( $compress eq "targz" ) { $comp = "$compgz"; $compext = "$compgzext"; } else { if ( $compress eq "tar" ) { $comp = ""; } } } else { # use PC/Mac type utilities $all = "."; $bundle = "$pcbundle"; $pkgtype = "$pcpkgtype"; $comp = "$pccomp"; } # OK ... do bundle and optional compression # $tarfile = "$pkgname"."$pkgtype"; print STDERR " DWNLD: doing: $bundle $tarfile $all \n"; eval { system "$bundle $tarfile $all " }; print STDERR " DWNLDERR: $tarfile problem: $@ \n" if $@; $fnlpkg = "$tarfile"; # compress archive file if user requested it if ("$comp") { $compfile = "$tarfile"."$compext"; print STDERR " DWNLD: doing: $comp $tarfile to make $compfile \n"; eval { system "$comp $tarfile " }; $fnlpkg = "$compfile"; } print STDERR " DWNLD: pkgd data: $tardir/$fnlpkg \n"; return "$tardir"."/"."$fnlpkg"; } sub copy_data_doc { # copy the info (documentation) file for this data object chdir "$objdir"; $docfile="$objnameonly".".htm"; # build infofile name from object name # must handle local and remote objects differently ($objpath,$localobj,@objpart) = split("/",$dobject); if ($localobj) { # object is on local host: /ob/je/ct $host = "$ENV{'SERVER_NAME'}"; $objpath = "/"."$localobj"; $start = 0; } else { # object is on remote host: //host.name.dom/ob/je/ct $host= "$objpart[0]"; $start = 1; } # # fix for static INFOSERVER - get info-serving host from object # # $objserver = "$protocol"."$getinfo" $objserver = "$protocol"."$host"."/jg/info"; for $num ($start .. $#objpart) { $objpath = "$objpath"."/"."$objpart[$num]"; } $infofile = "$objserver"."$objpath"; print STDERR " DWNLD: getting $infofile \n"; if (head("$infofile")) { # OK, we found the info file, so retrieve and print it to a local file getstore "$infofile","$docfile"; } else { # # does it make sense to re-try with a staticly defined INFOSERVER # $infofile = "$protocol"."$getinfo"."$objpath"; if (head("$infofile")) { getstore "$infofile","$docfile"; } else { print STDERR " DWNLDERR: Error getinfo: $dobject info file not found \n"; } } return "$infofile"; } sub bad_confirmation { # user was unhappy with selections, and did not confirm them # what do they want to do now? if ($user_confirm eq "help") { # user gives up and has asked for help $button="Help"; $submit_msg=" to submit a request for assistance, "; print <OK ... let's give up on this one ...

ENDOFTEXT foreach $item (sort keys %input) { print " \n"; } } else { # user wants to bo back and try again $button="Try again"; $submit_msg=" to go back and remake $objnameonly selections, "; print <OK ... let's go back and try working on the $objnameonly data again ... ENDOFTEXT } # # also give them the option of returning to a previous location # print <Press $submit_msg

... or perhaps you would like to go back to the Plotting and Other Options menu and start over again or use your browser's 'Go' menu to return and relocate the data object.

ENDOFTEXT } sub create_readme { # make a README logfile for this data request open (LOGF, ">"."$logfile") ; print LOGF "README file for requested data object: $dispobj \n"; $now = `date`; # get local time print LOGF "$now \n"; close LOGF; return $? ; } sub add_note { my (@comment)= @_; # # add comment to the log file if ( -w "$logfile" ) { open (LOGF, ">>"."$logfile") ; print LOGF "@comment \n"; close LOGF; } } sub mis_match { my ($det_act, $det_exp)= @_; # # $det_act is the actual parameter name found by list # $det_exp is the user-specified parameter we expected to match # # We need to notify user of a problem. # annotate an error log file for user if ( -w "$logfile" ) { open (ERRTXT, ">>"."$logfile") ; print ERRTXT "Working on: $selection \n"; print ERRTXT " unable to process request due to parameter mismatch: \n"; print ERRTXT " user selected parameter [ $det_exp ] is not equal to\n"; print ERRTXT " [ $det_act ] the actual parameter found in the data object\n"; close ERRTXT; } } sub uh_oh { # # We encountered a fatal error. Inform user with copy of # error message, close the html page and exit this program. # @errmsg = @_ ; $errsta = "0"; print STDERR " DWNLDERR: Download Fatal Error Condition: \n"; print STDERR " DWNLDERR: @errmsg \n"; &add_note ("Fatal error msg: @errmsg"); print < @errmsg

There may be additional information about the processing status.
Please return to the Plotting and Other Options menu
  or try using your browser's 'Go' menu to return and relocate the data object.

  or press to submit a request for assistance.

ENDOFSUB # # Close html file cleanly and exit this program. # print &HtmlBot; exit; }