#!/ldcg/bin/tclsh

##******************************************************************
##
## This is a utility for dumping the binary hash file created by
## the diskcache API. It will dump a nicely formatted summary of
## the frame files that are known to the diskcache API.
##
## Calling convention:
##
##    cacheDump $hashfile -tcl/text ifo-type,ifo-type start end
##
## Where the specifying of a hash filename is optional, defaulting
## to the value of ::DISKCACHE_HASHFILE_NAME_BINARY in the diskcache API
## resource file found in /ldas_outgoing/diskcacheAPI IF IT EXISTS.
##
## Where supplying an optional list of ifo/type pairs will
## cause cacheDump to return a complete listing of FILE NAMES
## that satisfy the ifo and type EXACTLY as specified. Note that
## a GPS beginning and ending timestamp are required when this
## form of the command is used.
##
## It can take several minutes to run given the current format
## of the hash file (LDAS-1.2.0).
##
## In some cases you may need to edit this file, but it will run
## as is at all official LDAS sites.
##
## email questions and problems to: pehrens@ligo.caltech.edu
##
##******************************************************************

set auto_path "/ldas/lib $auto_path"

;## we do this to make the genericAPI package happy.
set ::API diskcache

set msg "\nNOTE: cacheDump assumes that the LDAS runtime is installed\n"
append msg "under /ldas_outgoing, and will not run if the LDASapi.rsc\n"
append msg "and LDASdiskcache.rsc are not found!\n"
puts stderr $msg

;## default LDAS resource file locations.
;## yes, this is fragile and not very smart.
source /ldas_outgoing/LDASapi.rsc
source /ldas_outgoing/diskcacheAPI/LDASdiskcache.rsc

package require genericAPI
package require diskcacheAPI

if { [ string length [ lindex $argv 0 ] ] && \
    ! [ regexp -nocase -- {^-(tcl|text|h)} [ lindex $argv 0 ] ] } {
   set ::DISKCACHE_HASHFILE_NAME_BINARY [ lindex $argv 0 ]
   if { ! [ file exists $::DISKCACHE_HASHFILE_NAME_BINARY ] } {
      set err "The diskcache hashfile specified on the\n"
      append err "command line: '$::DISKCACHE_HASHFILE_NAME_BINARY'\n"
      append err "could not be found!\n\n"
      puts stderr $err
      exit
   }
} else {
   set default /ldas_outgoing/diskcacheAPI/$::DISKCACHE_HASHFILE_NAME_BINARY
}

if { ! [ info exists ::DISKCACHE_HASHFILE_NAME_BINARY ] } {
   set msg    "\nThe required variable ::DISKCACHE_HASHFILE_NAME_BINARY\n"
   append msg "was not defined in the diskcache API resource file\n"
   append msg "/ldas_outgoing/diskcacheAPI/LDASdiskcache.rsc,\n"
   append msg "and no value was passed on the command line.\n\n"
   append msg "please pass the name of the diskcache hash file\n"
   append msg "as the first argument to cacheDump.\n"
   puts stderr $msg
   exit
}

proc help { args } {
     set    err "\n\ncacheDump usage:\n\n"
     append err "     cacheDump \[ hashfile \] -tcl/text "
     append err "ifo-type,ifo-type start end\n\n"
     append err "where the hashfile defaults to the system\n"
     append err "hashfile:\n"
     append err "          $::default\n\n"
     append err "And '-tcl' or '-text' indicate the format of\n"
     append err "the output, with '-tcl' returning a tcl list,\n"
     append err "and '-text' returning a human readable format.\n"
     append err "By adding ifo-type pairs and a start and end time,\n"
     append err "an alternate mode is enabled that returns a\n"
     append err "verbose list of all matching FILE NAMES.\n\n"
     
     puts stderr $err
     exit
}

# additional preprocessing for PR #2694 functionality
proc preprocess { args } {
     if { [ llength $args ] == 1 } {
        set args [ lindex $args 0 ]
     }
     set t2 [ lindex $args end   ]
     set t1 [ lindex $args end-1 ]
     if { [ regexp -- {\d{9,10}-\d{9,10}} $t1-$t2 ] } {
        set pairs [ lindex $args   end-2 ]
        set args  [ lrange $args 0 end-3 ]
     } else {
        set t2    [ list ]
        set t1    [ list ]
        set pairs [ list ]
     }
     return [ list $args $pairs $t1 $t2 ]
}

proc parse { args } {
     
     if { [ llength $args ] == 1 } {
        set args [ lindex $args 0 ]
     }

     foreach [ list args pairs start end ] [ preprocess $args ] { break }
     
     switch -exact [ llength $args ] {
        0 {
           set format TEXT
           set hash $::default
          }
        1 {
           if {       [ regexp -nocase -- {^-+h}   $args ] } {
               help
           }
           if {       [ regexp -nocase -- {^-+tcl}  $args ] } {
              set format TCL_LIST
              set hash $::default
           } elseif { [ regexp -nocase -- {^-+text} $args ] } {
              set format TEXT
              set hash $::default
           } else {
              set format TEXT
              set hash [ lindex $args 0 ]
           }
          }
        2 {
           set hash [ lindex $args 0 ]
           set format [ lindex $args 1 ]
           set format [ lindex [ parse $format ] 0 ]
          }  
        default { help }
     }
     return [ list $format $hash $pairs $start $end ] 
}

foreach [ list format hash pairs start end ] [ parse $argv ] { break }

puts stderr "reading $hash"
puts stderr "this can take a while, please be patient!!"

if { ! [ file exists $hash ] } {
   return -code error "file does not exist: $hash"
}

updateFileExtList .gwf
readDirCache $hash

if { [ string length $end ] } {
   set data [ getFileNames [ split $pairs , ] $start $end ]
} else {
   set data [ getDirCache ]
}

puts stderr DONE!

if { [ string equal TCL_LIST $format ] } {
   ;## do nothing special
} elseif { [ string length $data ] > 100000000 } {
   set msg    "output string is longer than 100 million\n"
   append msg "characters, so I will output a Tcl formatted\n"
   append msg "string to avoid an out-of-memory error!"
   puts stderr $msg
   ;## pause to let the user read the message!!
   after 3000
} elseif { [ string equal TEXT $format ] } {
   regsub -all -- { \/} $data "\n\/" data 
} else {
   regsub -all -- { \/} $data "\n\/" data
}

puts stdout $data

exit
