;+
; NAME:
;   CMRESTORE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Restore variables from an IDL SAVE file.
;
; CALLING SEQUENCE: (various)
;   CMRESTORE, filename                           (implicit)
;   CMRESTORE, filename, var1, var2, ..., [, NAMES=names]
;   CMRESTORE, filename, DATA=pointers, NAMES=names, PASS_METHOD='POINTER'
;   CMRESTORE, filename, DATA=handles,  NAMES=names, PASS_METHOD='HANDLE'
;   CMRESTORE, filename, DATA=structure,             PASS_METHOD='STRUCT'
;   
; DESCRIPTION: 
;
;   CMRESTORE is a replacement for the built-in IDL procedure RESTORE.
;   It restores variables and data from an existing IDL SAVE file,
;   written either by SAVE or CMSAVE.  The CMSV utility library must
;   be installed in your IDL path to use CMSAVE and CMRESTORE.
;
;   The primary advantage to CMRESTORE is the ability to selectively
;   restore only certain variables from the input file (based on
;   name).  CMRESTORE provides a number of ways to pass the data
;   between routines, typically using a pointer or structure, which
;   avoids the unsafe practice of restoring variables in the caller's
;   namespace.  However, CMRESTORE can restore variables into the
;   caller's namespace, but users should be aware that this capacity
;   is somewhat limited in IDL versions 5.2 and below.
;
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
; COMPATIBILITY:
;
;   -- File Format --
;
;   CMRESTORE should be able to read files written by SAVE and CMSAVE
;   from IDL version 4 to version 5.4.
;
;   CMRESTORE cannot restore objects, pointers, compressed files, or
;   data sets larger than 2 gigabytes.
;   
;   Data types available in newer versions of IDL, such as pointers
;   and long integers, will not be readable in older versions of IDL
;   which do not have those data types.
;
;   -- Calling Interface --
;
;   For the most part, all capabilities of CMRESTORE are available to
;   the user.  However, it should be noted that passing variables by
;   positional parameter is not available under IDL 4, unless NAMES is
;   used to name the variables explicitly.  Also, under IDL versions
;   5.2 and previous, it is not possible for CMRESTORE to restore
;   variables into the caller's name space if they are not yet
;   defined.
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.
;
; INPUTS:
;
;   FILENAME - the name of the SAVE file.
;              Default: none, this parameter must be specified.
;
;   VAR{i} - The values to be restored.  By default the save name is
;            taken from the named variables that are passed.  These
;            default names can be overridden by using the NAMES
;            keyword.
;
;            If no variables are passed as positional parameters, they
;            can still be saved using the DATA keyword.  By invoking
;            CMRESTORE without positional parameters or DATA,
;            CMRESTORE automatically will attempt to restore the
;            variables to the calling routine's name space (the
;            "implicit" technique).
;
;               NOTE: in IDL 5.2 and below, user routines are not
;               allowed to *CREATE* new variables in the caller's name
;               space.  CMRESTORE may fail if the variable in
;               undefined in the caller.  Therefore you must define it
;               before calling CMRESTORE.  The safer practice is to
;               use the VAR{i} positional parameters, or the DATA
;               keyword.
;
; KEYWORDS:
;
;   FILENAME - the name of the SAVE file.  The positional FILENAME
;              parameter takes precedence over the keyword FILENAME
;              parameter.
;
;              NOTE that if you pass variables as positional
;              parameters, then the first parameter *must* be the file
;              name, and the FILENAME *keyword* will be ignored.
;
;   PASS_METHOD - a scalar string, describing the method of passing
;                 data between the caller and CMRESTORE.  The keyword
;                 can take the value 'ARGUMENT', 'POINTER', 'HANDLE'
;                 or 'STRUCT'.  A value of 'ARGUMENT' indicates that
;                 data values will be passed by command line argument,
;                 and is the default.  Other values are described
;                 below.
;
;   DATA - A list of data elements to be restored from the output
;          file.  The data elements can be one of the following,
;          depending on the value of PASS_METHOD.  The means of
;          extracting the data, and the method of naming each
;          variable, are also indicated.
;
;            * PASS_METHOD='POINTER': An array of pointers to the variables
;                    Data: pointed-to value     Name: from NAMES keyword
;            * PASS_METHOD='HANDLE':  An array of handles to the variables
;                    Data: pointed-to value     Name: from NAMES keyword
;            * PASS_METHOD='STRUCT':  A structure containing data to be saved
;                    Data: tag value            Name: tag name
;
;          Data values are restored one by one, using the appropriate
;          name.  Note that any variables passed as positional
;          parameters will cause the DATA keyword to be ignored.
;
;          CMRESTORE will allocate any pointer or handle resources.
;          The calling routine is responsible for deallocating any
;          pointer or handle resources.
;
;   NAMES - a string array, giving the names for each variable.  
;
;           If the data are passed by positional parameters, the names
;           are assigned according to the position of the parameter in
;           the procedure call.  
;
;           If the data are passed by an array of pointers or handles,
;           then the names are assigned according to the position of
;           the data in the array.  In this case there is no other way
;           to supply the variable name.  NAMES is required.
;
;           If the data are passed in a structure, then the names are
;           assigned according to the position of the data in the
;           structure.  The values specified in the names keyword
;           override the tag names.
;
;   STATUS - upon return, an integer indicating the status of the
;            operation.  A value of 1 indicates success, while 0
;            indicates failure.  A failure condition does not
;            necessarily indicate that an individual variable could
;            not be restored; use the VARSTATUS keyword to detect such
;            situations.
;
;   VARSTATUS - upon return, an integer array indicating the status of
;               the restore operation for each variable.  A value of 1
;               at position i in the array indicates success for the
;               ith variable, while a value of 0 indicates failure.
;
;   ERRMSG - upon return, a string indicating the status of the
;            operation.  The empty string indicates success, while a
;            non-empty string indicates failure and describes the
;            error condition.
;
;   QUIET - if set, then the error message is returned to the calling
;           routine.  By default an error condition causes execution
;           to stop and the message to be printed on the console.
;
;   VERBOSE - if set, then a short message is printed for each
;             variable.
;
; EXAMPLE:
;
;   CMSAVE, VAR1, VAR2, FILENAME='test.sav'
;   CMSAVE, VAR1, VAR2, FILENAME='test.sav', NAMES=['A','B']
;
;     Save the data in VAR1 and VAR2 to the file test.sav.  In the
;     first case the saved variable names will be VAR1 and VAR2.  In
;     the second case the saved variable names will be A and B.
;
;   POINTERS = [ptr_new(VAR1), ptr_new(VAR2)]
;   CMSAVE, DATA=POINTERS, NAMES=['A','B'], FILENAME='test.sav'
;
;     Save the data in VAR1 and VAR2 to the file test.sav.  The saved
;     variable names will be A and B.
;
;   STRUCTURE = {A: VAR1, B: VAR2}
;   CMSAVE, DATA=STRUCTURE, FILENAME='test.sav'
;
;     Save the data in VAR1 and VAR2 to the file test.sav.  The saved
;     variable names will be A and B.
;
; SEE ALSO:
;
;   CMSAVE, SAVE, RESTORE
;
; MODIFICATION HISTORY:
;   Written, 14 May 2000
;   Documented, 22 Sep 2000
;   Restore into caller's name space now permitted, 11 Jan 2001
;   Documented "implicit" restore a little better, w/ errors, 01 Mar 2001
;   Make version checks with correct precision, 19 Jul 2001, CM
;   Restore with no args automatically does ALL, is this right?,
;     CM, 20 Aug 2001
;   Added notification about RSI License, 13 May 2002, CM
;   Handle the case of CMRESTORE, FILENAME, X properly, 03 Sep 2008, CM
;     (thanks to Sergey Koposov for reporting)
;   Report CMSVLIB version number when /VERBOSE is set, 22 Nov 2009,
;      CM
;   Change to accomodate lack of GDL functionality when restoring
;      all variables, 22 Nov 2009, CM
;
; $Id: cmrestore.pro,v 1.22 2009/11/22 23:31:00 craigm Exp $
;
;-
; Copyright (C) 2000-2001, 2008, 2009, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-

;; This utility function is only called under IDL 4
function arg_present, x
  return, 0
end

pro cmrestore,   filename0, filename=filename1, $
                  p0,  p1,  p2,  p3,  p4,  p5,  p6,  p7,  p8,  p9, $
                 p10, p11, p12, p13, p14, p15, p16, p17, p18, p19, $
                 p20, p21, p22, p23, p24, p25, p26, p27, p28, p29, $
                 verbose=verbose, all=all, restored_objects=restobj, $
                 status=status, varstatus=colstatus, mtimes=mtimes, $
                 names=names, data=data, pass_method=method, $
                 errmsg=errmsg, quiet=quiet, nocatch=nocatch, $
                 relaxed_structure_assignment=relax, version=revision
                  
  forward_function routine_names, ptrarr, ptr_new, handle_create, arg_present

  status = 0
  errmsg = ''
  colstatus = 0 & dummy = temporary(colstatus)  ;; Void out the status

  cmsvlib_version = '<unknown>'
  catch, catcherr
  if catcherr EQ 0 then lib = cmsvlib(/query, version=cmsvlib_version) else lib = 0
  catch, /cancel
  if lib EQ 0 then $
    message, 'ERROR: The CMSVLIB library must be in your IDL path.'

  revision = '$Revision: 1.22 $'
  ;; Extract the version number
  revision = stregex(revision,'\$'+'Revision: *([0-9.]+) *'+'\$',/extract,/sub)
  revision = revision(1)

  if keyword_set(verbose) then begin
     message, /info, 'CMRESTORE version '+revision, traceback=0
     message, /info, 'CMSV Library version '+cmsvlib_version(0), traceback=0
  endif

  if NOT keyword_set(nocatch) then on_error, 2
  kall = 0                      ;; NOTE: Ignoring ALL keyword!!

  n_par = n_params()
  nnames = n_elements(names)
  ver = double(!version.release)
  if n_elements(filename0) EQ 0 AND n_elements(filename1) EQ 0 then begin
      message, 'USAGE: CMRESTORE, filename, VAR1, VAR2, ...', /info
      return
  end
  ;; Now n_par refers to the number of positional variables (ie,
  ;; filename excluded)
  n_par = n_par - 1

  ;; Default processing
  if n_elements(filename0) GT 0 then filename = strtrim(filename0(0),2) $
  else                               filename = strtrim(filename1(0),2)

  ;; Input method
  if n_elements(method) EQ 0 then begin
      if n_par GT 0 then meth = 'ARGUMENT' $
      else               meth = 'STORE'
  endif else begin
      meth = strupcase(strtrim(method(0),2))
  endelse
  ;; Trim it down so that people don't have to type too many characters
  meth = strmid(meth, 0, 3)

  ;; Error checking on input method, depending on IDL version
  if meth EQ 'ARG' AND ver LT 5D AND nnames EQ 0 then begin
      errmsg = ('ERROR: in IDL 4 you cannot pass variables by argument '+ $
                'to CMRESTORE.')
      goto, PRE_CLEANUP
  endif
  ;; Implicit restore of ALL, if no names are provided
  if nnames EQ 0 AND n_par EQ 0 then kall = 1
  ;; GDL is incapable of restoring all variables without them being named.
  DEFSYSV, '!gdl', exists=is_it_gdl
  if is_it_gdl then begin
      if nnames EQ 0 then kall = 1
  endif

  ;; Extract some information about the calling routine
  lev = routine_names(/level)
  vlev = lev - 1

  ;; Note: if the user specified "ALL" then we set NNAMES to zero,
  ;; indicating that the number of variables to be returned is unknown
  ;; at present.
  if kall then nnames = 0L

  if n_par LT 1 AND meth NE 'STO' AND arg_present(data) EQ 0 then begin
      if ver GE 5D OR meth EQ 'ARG' then begin
          errmsg = ('ERROR: A way to return data must be specified.  Pass by'+$
                    ' argument (IDL >= 5), or using the NAMES/DATA keywords.')
          goto, PRE_CLEANUP
      endif
  endif

  ;; ---------------- Establish I/O parameters -------------------
  ;; Upon exit from this block, at least the following variables must
  ;; be set: (a) nvar = number of named variables, (b) vnames = names
  ;; of variables in SAVE file to be restored.
  
  ;; Special case: if keyword ALL is set, then nvar EQ 0, and vnames
  ;; is undefined.  It will be filled in later then.
  if meth EQ 'ARG' then begin
      ;; Now processing that depends on the data passing method.  The
      ;; "argument" method is via positional arguments.

      ;; Extract variables from positional parameters
      if kall EQ 0 then nnames = n_par
      if (kall EQ 0 AND nnames EQ 0) $
        OR (kall AND n_par LE 0) then begin
          errmsg = 'ERROR: Returnable variables must be specified.'
          goto, PRE_CLEANUP
      endif
      lev1 = strtrim(lev-1,2)
      nvar = nnames
      if nvar GT 0 then vnames = strarr(nvar)
      if NOT kall AND ver GE 5D then begin
          for i = 0L, nvar-1 do $
            dummy = execute('vnames(i) = (routine_names(p'+strtrim(i,2)+ $
                            ',arg_name='+lev1+'))(0)')
      endif
  endif else if meth EQ 'STO' then begin
      ;; This information is used to determine whether the variable
      ;; already exists in the caller.  If it doesn't, and we are in
      ;; IDL 5.2 or earlier, then we can't save it.
      cnames = strupcase(strtrim(routine_names(variables=vlev),2))

      nvar = nnames
      if nvar GT 0 then vnames = strarr(nvar)
      
  endif else begin

      ;; Instead of passing the data via positional parameters, they
      ;; can be set through the DATA keyword, but even there this can
      ;; be accomplished with several means: via pointers, via
      ;; handles, or using a structure.
      
      ;; Clear DATA in preparation for restore operation
      data = 0 & dummy = temporary(data)
      nvar = nnames
      if nvar GT 0 then vnames = strarr(nvar)

      if meth EQ 'POI' then begin               ;; POINTER TYPE
          ;; Construct an array of null pointers to start with
          if nvar GT 0 then data = ptrarr(nvar)
      endif else if meth EQ 'HAN' then begin     ;; HANDLE TYPE
          ;; Construct an array of invalid handles to start with
          if nvar GT 0 then data = lonarr(nvar)-1L
      endif else if meth EQ 'STR' then begin
          ;; Do nothing
      endif else begin
          errmsg = 'ERROR: PASS_METHOD must be one of ARGUMENT, POINTER, '+$
            'HANDLE or STRUCT'
          PRE_CLEANUP:
          status = 0
          if NOT keyword_set(quiet) then message, errmsg, /info
          return
      endelse
  endelse

  if kall EQ 0 then begin
      if nvar LE 0 then begin
          errmsg = 'ERROR: no variable names were specified'
          goto, PRE_CLEANUP
      endif else begin
          colstatus = lonarr(nvar)
      endelse
  endif

  ;; User-renamed variables.  These names will override any names
  ;; specified in positional parameters.
  if n_elements(names) GT 0 AND NOT kall then begin
      sz = size(names)
      if sz(sz(0)+1) NE 7 then begin
          errmsg = 'ERROR: NAMES must be a string array'
          goto, PRE_CLEANUP
      endif
      vnames(0) = strtrim(strupcase(names(*)),2)
  endif

  ;; Open the save file
  get_lun, unit
  cmsv_open, unit, filename, pp, access='R', status=status, errmsg=errmsg
  if status EQ 0 then goto, CLEANUP
  if keyword_set(verbose) then $
    message, 'Portable (XDR) SAVE/RESTORE file.', /info, traceback=0

  pp0 = pp  ;; Block pointer
  ivar = 0L ;; Number of variables that have been read successfully
  if n_elements(vnames) GT 0 then $
    found = lonarr(n_elements(vnames))

  ptr_index   = [0L]
  ptr_offsets = [0L]
  if ver GE 5D then ptr_data = [ptr_new()] $
  else              ptr_data = [0L]

  ;; Now begin the processing
  repeat begin
      ;; Read block from SAVE file
      bn = ''
      point_lun, unit, pp
      block = 0 & dummy = temporary(block)
      cmsv_rrec, block, pp1, bdata, unit=unit, next_block=pnext, /init, $
        block_type=bt, block_name=bn, status=status, errmsg=errmsg, offset=pp,$
        promote64=promote64
      if status EQ 0 then goto, CLEANUP
      eb = (bn EQ 'END_MARKER')

      ;; Examine each block type  -----

      errmsg = ''
      jfind = -1L
      case bn of 

          ;; Promote record header to 64-bits (compatibility)
          'PROMOTE64': if keyword_set(verbose) then begin
              message, 'File contains 64-bit offsets.', /info, traceback=0
          endif

          ;; Read time stamp record
          'TIMESTAMP': if keyword_set(verbose) then begin
              stamp = bdata
              message, 'Save file written by '+stamp.save_user+'@'+ $
                stamp.save_host+', '+stamp.save_date, /info, traceback=0
          endif
          
          ;; Read version record
          'VERSION': if keyword_set(verbose) then begin
              vers = bdata
              message, ('IDL version '+vers.release+' ('+vers.os+ $
                        ', '+vers.arch+')'), /info, traceback=0
              message, 'File format revision: '+ $
                strtrim(vers.format_version,2), /info, traceback=0
          endif

          ;; Read heap index record
          'HEAP_INDEX': begin
              ii = bdata
              ptr_index   = [ptr_index, ii]
              ptr_offsets = [ptr_offsets, ii*0L]
              if ver GE 5D then $
                ptr_data    = [ptr_data, ptrarr(n_elements(ii))]
          end

          ;; Read heap data - just store a file pointer for later
          ;;                  referral
          'HEAP_DATA': begin
              p2 = pp1
              cmsv_rvtype, block, pp1, vindex, /heap, unit=unit, $
                status=st1, errmsg=errmsg
              if st1 EQ 0 then goto, NEXT_BLOCK

              ;; VINDEX will be the heap variable number.  Once we
              ;; know this we can put the file offset into
              vindex = floor(vindex(0))
              wh = where(ptr_index EQ vindex, ct)
              if ct EQ 0 then goto, NEXT_BLOCK
              ptr_offsets(wh(0)) = pp + p2  ;; block address + offset
          end              

          ;; Read variable data, and store for return to caller
          'VARIABLE': begin
              ;; Read variable type
              cmsv_rvtype, block, pp1, vn, sz1, unit=unit, status=st1, $
                template=tpp1, errmsg=err1
              if vn EQ '' OR st1 EQ 0 then goto, NEXT_BLOCK
              if kall EQ 0 then begin
                  jfind = (where(vn EQ vnames, ct))(0)
                  if ct EQ 0 then goto, NEXT_BLOCK
                  found(jfind) = 1
              endif
              
              ;; Read variable data
              cmsv_rdata, block, pp1, sz1, val, template=tpp1, status=st1, $
                unit=unit, errmsg=errmsg, ptr_offsets=ptr_offsets, $
                ptr_index=ptr_index, ptr_data=ptr_data
              if st1 EQ 0 then goto, NEXT_BLOCK
              if sz1(0) GT 0 then arr = 1 else arr = 0
              if arr then begin
                  ;; If an array then reform to be sure dimensions are right
                  dims = sz1(1:sz1(0))
                  val = reform(val, dims, /overwrite)
              endif
              
              if kall then begin
                  ;; With ALL, we extend the vector at each variable
                  jfind = ivar & ii = strtrim(jfind,2)
                  if ivar EQ 0 then begin
                      anames = [vn]
                      colstatus = [0L]
                  endif else begin
                      anames = [anames, vn]
                      colstatus = [colstatus, 0L]
                  endelse
              endif
              
              ;; Now send the data to output, depending on the method
              case meth of 
                  'ARG': begin
                      ;; Position dependent parameter
                      if jfind GE n_par then goto, NEXT_BLOCK
                      ii = strtrim(jfind,2)
                      if arr EQ 0 then begin
                          dummy = execute('p'+ii+' = temporary(val)') 
                      endif else begin
                          dummy = execute('p'+ii+' = reform(val, dims, '+ $
                                          '/overwrite)')
                      endelse
                      if dummy EQ 0 then goto, NEXT_BLOCK
                  end
                  'STO': begin
                      ;; Store the data in caller.  Check for IDL 5.3
                      ;; compatibility.
                      jfind1 = where(vn EQ cnames, ct1)
                      if ver LT 5.3D AND jfind1(0) EQ -1 then begin
                          if keyword_set(quiet) EQ 0 then begin
                              message, 'WARNING: could not create variable '+$
                                vn+' in calling routine.', /info, traceback=0
                          endif
                          goto, NEXT_BLOCK
                      endif
                      dummy = routine_names(vn, val, store=vlev)
                  end
                  'POI': begin
                      ;; Pointer to data
                      if kall then begin
                          if ivar EQ 0 then data = ptrarr(1) $
                          else data = [data, ptr_new()]
                      endif
                      data(jfind) = ptr_new(val)
                  end
                  'HAN': begin
                      ;; Handle to data
                      if kall then begin
                          if ivar EQ 0 then data = [-1L] $
                          else data = [data, -1L]
                      endif
                      data(jfind) = handle_create(value=val, /no_copy)
                  end
                  'STR': begin
                      ;; Add data to structure
                      if n_elements(sdata) EQ 0 then $
                        sdata = create_struct(vn, val) $
                      else $
                        sdata = create_struct(sdata, vn, val)
                  end
              endcase
              
              colstatus(jfind) = 1
              if kall then ivar = ivar + 1
          end


          ELSE: dummy = 1
      endcase

      NEXT_BLOCK:
      if NOT keyword_set(quiet) then begin
          if errmsg NE '' then $
            message, errmsg, /info
          if keyword_set(verbose) AND jfind GE 0 then begin
              if colstatus(jfind) EQ 1 then $
                message, 'Restored variable: '+vn+'.', /info, traceback=0 $
              else $
                message, 'Unable to restore variable: '+vn+'.', /info, $
                traceback=0
          endif
      endif
      ;; Advance to next block
      if pp NE pnext then begin
          pp = pnext 
      endif else begin
          status = 0
          errmsg = 'ERROR: internal inconsistency'
      endelse
  endrep until bn EQ 'END_MARKER' OR status EQ 0

  ;; Clean up
  free_lun, unit

  DONE_RESTORE:
  if meth EQ 'STR' then begin
      ;; Put new struct data on output
      data = 0 & dummy = temporary(data)
      if n_elements(sdata) GT 0 then data = temporary(sdata)
  endif
  if kall then begin
      names = 0 & dummy = temporary(names)
      if n_elements(anames) GT 0 then names = anames
  endif

  if n_elements(found) GT 0 then begin
      wh = where(found EQ 0, ct)
      fmt = '(A,'+strtrim(ct,2)+'(A,:," "),".")'
      if ct GT 0 then begin
          errmsg = string("WARNING: the following variables were not found: ",$
                          vnames(wh), format=fmt)+'.'
          if NOT keyword_set(quiet) OR keyword_set(verbose) then $
            message, errmsg, /info, traceback=0
      endif
  endif

  if total(colstatus) GT 0 then begin
      status = 1
  endif else begin
      status = 0
      errmsg = 'ERROR: No variables were restored.'
      if meth EQ 'STO' AND ver LT 5.3D then begin
          errmsg = errmsg + '  NOTE: In IDL 5.2 and earlier the variable '+$
            'must first be defined by the caller in order to use the '+$
            '"implicit" restore technique.'
          message, errmsg, /info, traceback=0
      endif
  endelse

  return

  ;; 
  ;; Error handling routine, outside the normal call flow
  CLEANUP:
  catch, /cancel
  if n_elements(unit) GT 0 then free_lun, unit
  status = 0
  if errmsg NE '' AND NOT keyword_set(quiet) then message, errmsg, /info

  return
end