variable compat "2.1.b3"
# extract.itcl - avd-29-02-2004
#
# A modified version of Riley's extraction module
# assumes working MFS_FTP standard installation.
# standard disclaimer: don't bother Riley if it dosen't work
# support here: http://www.dealdatabase.com/forum/showthread.php?t=32049
###########################################################################################
## rc3105's ULTRA simple module for extracting recordings                                 #
## via tivoweb.  requires TiVoWebPlus 1.0rc4 or newer                                     #
## registers file handlers for tmf/ty & produces links                                    #
#  apologies to => # copyright (C) 2002-2004 Riley Cassel (rc3105@dealdatabase.com/forum) #
##                 ########################################################################
## tmf/ty/asx links produce {title}{episode}{channel}{fsid}.tmf/ty/asx
## ty is actually ty+ (with xml appended) & insertable via mfs_ftp
##
# Modifications by BTUx9 for TWP2.2
# - unified tmf and ty support
# - improved filesize calculation (files are no longer truncated under normal circumstances)
# - added support for .part.ty files to get single parts (from mfsbrowser, primarily)
# Modifications by SteveT
# - removed note about making TWP unresponsive (since BTUx9 fixed that above)
# - changed mfs_tarstream checks and calls to call mfs_uberexport directly
# - added bignum support for large file sizes

proc fsid_from_name { rec_name } {
  set id ""
  regexp {\{([0-9]+)\}[^\{]*$} $rec_name dum id
  return $id
}

aproc .asx {
  #~ global db
  eval_env
  set fsid [fsid_from_name $path]
  set title [file root [file tail $path]]
  if { $title != "" } {
    print_html_header_200 $chan "video/x-ms-asx" $last_modified
    puts $chan "<asx version=\"3.0\">"
    puts $chan "<title>TiVoWeb ASX file</title>"
    puts $chan "<entry>"
    puts $chan "<title>$title</title>"
    puts $chan "<author>TiVo Stream</author>"
    puts $chan "<ref href=\"tivo://$::ip_address/$fsid\" />"
    puts $chan "</entry>"
    puts $chan "</asx>"
  } else {
    #~ print_html_header_404 $chan
    return 404
  }
}

### djl - add support for streaming to vlc 0.9+ from mfs_ftp
aproc .pls {
  eval_env
  catch {set p [exec ps | grep "mfs_ftp" | grep -v grep]}
  if {![info exists p]} {
	 puts $chan [html_start][tag h3 "mfs_ftp not currently running"]
	 return 0
	}
  set fsid [fsid_from_name $path]
  set title [file root [file tail $path]]
  if { $title != "" } {
    print_html_header_200 $chan "audio/x-scpls" $last_modified
    puts -nonewline $chan "ftp://$::ip_address:3105/ty/$fsid.ty"
  } else {
    return 404
  }
}

variable mfs_bin_dir 0
if [has mfs_uberexport] {
  set mfs_bin_dir ""
} else {
  foreach dir {hack/MFS_FTP hack/mfs_ftp mfs_ftp} {
    if {[file isdirectory "/var/$dir"]} {
      set mfs_bin_dir "/var/$dir/"
      break
    }
  }
}
#puts mfs_bin_dir
if {$mfs_bin_dir != 0} {

proc action_extract {chan path envr} {
#  variable mfs_path
#DJL replaced with global value #RetryTransaction { set version [dbobj [db $::db open "/SwSystem/ACTIVE"] get Name] }
#DJL { [string range $version 0 0] < "3" } 
  set version $::version
  if { $version < "3" } {
    set mfs_path "/Recording/NowShowing"
  } else {
    set mfs_path "/Recording/NowShowingByClassic"
  }
  if {[string index $path 0] == "/"} { set path [string range $path 1 end] }
  if {$path == ""} {
    puts $chan [html_start "Download/Extract TMF/TY/ASX"]
    puts $chan [html_table_start "class='sortable'" "" ""]
    puts $chan [tr "" [th "\<small\>\[Date Recorded\]\</small\>"] [th "Title: Episode \(Chan\)"] [th "align=right" "Size<small>(MB)</small>"] [th "tmf"] [th "ty"] [th "asx"] [th "vlc"]]
    logit 0 mfs_path
    ForeachMfsFile fsid name type "$mfs_path" "" {
      foreach {r_name d_name s_name streamsize} [build_rec_info $fsid] break
      set rowstr ""
      append rowstr [td $d_name] [td [html_link "/$r_name.ty" "$s_name"]] [td "align=right" "&nbsp;$streamsize"] 
      append rowstr [td [html_link "/$r_name.tmf" "tmf"]] [td [html_link "/$r_name.ty" "ty"]] [td [html_link "/$r_name.asx" "asx"]] [td [html_link "/$r_name.pls" "vlc"]]
      puts $chan [tr "" $rowstr]
    }
    puts $chan [html_table_end]
    }
}

proc build_rec_info rec_fsid {
  global tzoffset
  foreach var "title callsign episode recdate r_name d_name s_name streamsize" {set $var "" }
  RetryTransaction {
    set rec [db $::db openid $rec_fsid]
    set showing [dbobj $rec get Showing]
    set streamsize [dbobj $rec get StreamFileSize]
    set program [dbobj $showing get Program]
    set title [sn [strim [dbobj $program get Title]]]

    set Date [dbobj $showing get Date]
    set Time [dbobj $showing get Time]

    catch { set episode [sn [strim [dbobj $program get EpisodeTitle]]] }
    catch { set station [dbobj $showing get Station] }
    catch { set callsign [sn [strim [dbobj $station get CallSign]]] }
  }
  # Find and set the Record Time and Date
  if { $Date != "" } {
    set recsec [expr $Date * 86400 + $Time + $tzoffset]
  } else {
    set recsec ""
  }
  set recdate "[clock format $recsec -format "%m/%d/%Y %I\:%M%p"]"

  if {$streamsize != ""} {
    set streamsize [expr $streamsize / 1024]
  }
  set r_name "\{$title\}\{$episode\}\{$callsign\}\{$rec_fsid\}"
  set d_name "\<small\>$recdate\</small\>"
  set s_name "$title: $episode \<small\>\($callsign\)\</small\>"
  return [list $r_name $d_name $s_name $streamsize]
}

########
# XML Recording Object Dumper by the glorious embeem
# updated by rc3105

proc dump_object { obj {id ""} {depth 10} {prefix ""}} {
#  variable info
  set p 4
  #outd $p "dump_object: \"$obj\" \"$id\" \"$depth\" \"$prefix\" "
  if { $depth == 0 } {return "** max depth **\n"}
  set output "" ; set fsid [dbobj $obj fsid] ; set subid [dbobj $obj subobjid]
  if { [info exists ::seen($fsid/$subid)] } { return {} }
  set ::seen($fsid/$subid) "$id"
  set otype [dbobj $obj type]
  if {[dbobj $obj primary]} {
    append output "$prefix<Object type=\"$otype\" id=\"$id\">\n"
    set endtag "</Object>"
  } else {
    append output "$prefix<SubObject type=\"$otype\" id=\"$id\">\n"
    set endtag "</SubObject>"
  }
  foreach attr [lsort [dbobj $obj attrs]] {
    if { [catch { dbobj $obj get $attr } attrs] } {
      #outd 1 "dump_obj: whoops, wacky db attr \"$attr\""
    } else {
      set atype [dbobj $obj attrtype $attr]
      switch -glob $attr {
        AuxInfos -
        ActualShowing -
        CancelReason -
        Deletion* -
        Expiration* -
        ErrorString -
        Index* -
        NSecondsWatched -
        NVisit -
        ProgramSource -
        RecordingBehavior -
        Score -
        State -
        Version {continue}
      }
      foreach a $attrs {
        switch $atype {
          object { append output [dump_object $a $attr [expr $depth-1] "$prefix "]; set a "" }
        }
        if { $a != "" } { append output "$prefix  <$attr>$a</$attr>\n" }
      }
    }
  }
  append output "$prefix$endtag\n"
  return "$output"
}

proc dump_xml { obj } {
  set version [dbobj [db $::db open "/SwSystem/ACTIVE"] get Name]
  set output "<?xml version=\"1.1\" tivoversion=\"$version\"?>\n"
  append output [dump_object $obj "_top"]
  unset ::seen
  return $output
}

proc print_errmsg {chan msg} {
  puts $chan "HTTP/1.1 200 Ok"
  puts $chan "Server: tivoweb/fun\nConnection: close"
  puts $chan "Accept-Ranges: bytes"
  puts $chan "Content-type: text/html"
  puts $chan ""

  puts $chan $msg
}

proc isInt { val } {
  return [regexp {^-?[1-9][0-9]*$|^-?0[xX][0-9a-fA-F]+$|^-?0[0-7]*$} $val]
}

#######
# file handlers serve_tmf & serve_ty based on tivodvlpr's ty-tar server

aproc .tmf {
  lappend env tmf 1
  return [action_.ty $chan $path $env]
}

aproc .ty {
  variable mfs_bin_dir
  set tmf 0
  eval_env
  set filename [file tail $path]
  set fsid [file root [file tail $filename]]
  set is_part [string match *.part.ty $path]
  set xml ""
  if $tmf {
    #~ set hsize 512
    set h ""
  } else {
    #~ set hsize 0
#    set h "#"
#    for {set i 10} [incr i -1] {} {append h $h}
#    6.3 system didn't like above syntax
    set h ""
    for {set i 1} {$i <= 512} {incr i} {append h "#"}
  }
  set fsid [fsid_from_name $fsid]
  logit fsid

  set total_size 0
  try { RetryTransaction {
    if $is_part { set part_files $fsid; set xml ""
    } else {
      set part_files {}
      set rec [db $::db openid $fsid]
      set xml "$h[dump_xml $rec]$h"
      set parts [dbobj $rec get Part]
      foreach part $parts {
        set file [dbobj $part get File]
        lappend part_files $file
      }
    }
    foreach f $part_files {
      foreach {blocksize blocks} [mfs streamsize $f] break
      set total_size [bignum_add $total_size [expr $blocks * $blocksize]]
    }
  } } catch errCode {logit errCode; return 404}
  set xsize [string length $xml]

  if $tmf {
    # add in tar headers and round up xml to blocksize (512)
    set xsize [expr (($xsize+1023) & 0xfffffe00)]
    set hsize 512
  } else {
    #~ incr xsize 1024
    set hsize 0
  }
  set total_size [bignum_add $total_size $xsize]
  set total_size [bignum_add $total_size [expr (128*1024+$hsize)*[llength $part_files]]]

  puts $chan "HTTP/1.1 200 Ok"
  puts $chan "Server: tivoweb/fun\nConnection: close"
  puts $chan "Accept-Ranges: none"
  #~ puts $chan "Accept-Ranges: bytes"
  puts $chan "Content-Length: $total_size"
  puts $chan "Content-type: application/[lindex {ty tmf} $tmf]"
  puts $chan ""

  set xmlf "/tmp/$fsid.xml"
  set pout [open $xmlf w]
  puts -nonewline $pout $xml
  close $pout
  if $tmf {
    exec bash -c "${mfs_bin_dir}mfs_uberexport -t -x $part_files" <$xmlf >@$chan &
  } else {
    exec bash -c "${mfs_bin_dir}mfs_uberexport -R $fsid ; cat $xmlf" >@$chan &
  }
  return 0
}

proc sn { line } {
  regsub -all -nocase {[^A-Z0-9_~@\#&\-\'{ }]} $line {} new_line
  return $new_line
}

#setup_em_vars
register_module "extract" "Extract" "Download/Stream recordings as TMF/TY/ASX"
}