# 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) #
##                 ########################################################################
## the recording link produces recfsid.tmf
## tmf/ty links produce {title}{episode}.tmf/ty
## ty is actually ty+ (with xml appended) & insertable via mfs_ftp
##

if {[file isdirectory "/var/hack/MFS_FTP"]} {
   set mfs_bin_dir "/var/hack/MFS_FTP"
} elseif {[file isdirectory "/var/hack/mfs_ftp"]} {
   set mfs_bin_dir "/var/hack/mfs_ftp"
} elseif {[file isdirectory "/var/mfs_ftp"]} {
   set mfs_bin_dir "/var/mfs_ftp"
}

if {[info exists mfs_bin_dir]} {

proc action_build_extract_page {chan path envr} {
   global mfs_path
   global mfs_bin_dir
   if {[string index $path 0] == "/"} { set path [string range $path 1 end] }
   if {$path == ""} {
      puts $chan [html_start "Riley's simple TMF/TY extract module - $mfs_path"]
      puts $chan "<I>NOTE: TivoWebPlus will be unresponsive during any data transfer.<BR>"
      puts $chan "One way to avoid this is to transfer the files using an FTP client.<BR>"
      regsub {:[0-9]*} $::HTTP_HOST {} ftp_url
      set ftp_url "ftp://$ftp_url:3105"
      puts $chan "This can be done by connecting to port <A HREF=\"$ftp_url\">3105</A> (after starting mfs_ftp).</I><BR>"
      puts $chan [html_table_start "" "" ""]
      puts $chan [tr "" [th "align=left" "\<small\>\[Date Recorded\]\</small\> &nbsp;Title - Episode \(Chan\)"] [th "" "tmf"] [th "" ".ty"]]
      ForeachMfsFile fsid name type "$mfs_path" "" {
	 set r_name [build_rec_name $fsid 0]
	 set d_name [build_rec_name $fsid 1]
	 puts $chan [tr "" [td [html_link "/$r_name.ty" "$d_name"]]  [td [html_link "/$r_name.tmf" "tmf"]] [td [html_link "/$r_name.ty" ".ty"]]]
      }
      puts $chan [html_table_end]
      puts $chan [html_end]
   }
}

proc fsid_from_name { rec_name } {
   global db mfs_path
   #puts stdout "looking for:\n   $rec_name"
   ForeachMfsFile fsid name type "$mfs_path" "" {
      #puts stdout "versus: $fsid"
      if { $rec_name == $fsid || $rec_name == "\{$fsid\}" } { return $fsid }
      set r_name [build_rec_name $fsid 0]
      #puts stdout "$r_name"
      if { $rec_name == $r_name } { return $fsid }
   }
   return ""
}

proc build_rec_name { rec_fsid {detail 0} } {
   global db tzoffset
   foreach var "title callsign episode recdate r_name" {set $var "" }
   RetryTransaction {
      set rec [db $db openid $rec_fsid]
      set showing [dbobj $rec get Showing]
      set program [dbobj $showing get Program]
      set title [sn [strim [dbobj $program get Title]]]
 
      # Find and set the Record Time and Date
      set Date [dbobj $showing get Date]
      set Time [dbobj $showing get Time]
      if { $Date != "" } {
	 set recsec [expr $Date * 86400 + $Time + $tzoffset]
      } else {
	 set recsec ""
      }
      set recdate "[clock format $recsec -format "%d/%m/%Y %I\:%M%p"]"
      
      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]]] }
   }
   if { $detail == 0 } {
      set r_name "\{$title\}\{$episode\}\{$callsign\}\{$rec_fsid\}"
   } else {
      set r_name "\<small\>\[$recdate\]\</small\> &nbsp;$title - $episode \<small\>\($callsign\)\</small\>"
   }
   return "$r_name"
}

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

proc setup_em_vars { } {
   global db mfs_path
   RetryTransaction { set version [dbobj [db $db open "/SwSystem/ACTIVE"] get Name] }
   if { [string range $version 0 0] < "3" } {
      set mfs_path "/Recording/NowShowing"
   } else {
      set mfs_path "/Recording/NowShowingByClassic"
   }
}

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

proc dump_object { obj {id ""} {depth 10} {prefix ""}} {
   global 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 } {
   global db
   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.0 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

proc serve_tmf {chan filename head_req last_modified} {
   global db
   global mfs_bin_dir
   set fsid [file root [file tail $filename]]
   set part_files ""
   set tar_header_size 512
   set total_size 0
   set fsid [fsid_from_name $fsid]
   RetryTransaction {
      try { set rec [db $db openid $fsid] } catch errCode {set rec ""}
      if {$rec == ""} {
	 print_html_header_404 $chan
	 return
      }
      try { set parts [dbobj $rec get Part] } catch errCode {set parts ""}
      if {$parts == ""} {
	 print_html_header_404 $chan
	 return
      }
      foreach part $parts {
	 set file [dbobj $part get File]
	 append part_files "$file "
	 set part_size [mfs streamsize $file]
	 set blocksize [lindex $part_size 0]
	 set blocks [lindex $part_size 1]
	 set file_size [expr $blocks * $blocksize]
	 set total_size [expr $total_size + $file_size + $tar_header_size]
      }
      set xml "[dump_xml $rec]"
   }
   set xml_size [string length $xml]
   set total_size [expr $total_size + $xml_size + $tar_header_size]
   puts $chan "HTTP/1.0 200 Ok"
   puts $chan "Server: tivoweb/fun\nConnection: close"
   puts $chan "Accept-Ranges: bytes"
   puts $chan "Content-Length: $total_size"
   puts $chan "Content-type: application/tmf"
   puts $chan ""
   set pout [open "|$mfs_bin_dir/mfs_tarstream -x -s $part_files >@$chan" w]
   puts -nonewline $pout $xml
   close $pout
   unset xml
   flush $chan
   return ""
}

proc serve_ty {chan filename head_req last_modified} {
   global db
   global mfs_bin_dir
   set fsid [file root [file tail $filename]]
   set part_files ""
   set tar_header_size 0
   set total_size 0
   set fsid [fsid_from_name $fsid]
   RetryTransaction {
      try { set rec [db $db openid $fsid] } catch errCode {set rec ""}
      if {$rec == ""} {
	 print_html_header_404 $chan
	 return
      }
      try { set parts [dbobj $rec get Part] } catch errCode {set parts ""}
      if {$parts == ""} {
	 print_html_header_404 $chan
	 return
      }
      foreach part $parts {
	 set file [dbobj $part get File]
	 append part_files "$file "
	 set part_size [mfs streamsize $file]
	 set blocksize [lindex $part_size 0]
	 set blocks [lindex $part_size 1]
	 set file_size [expr $blocks * $blocksize]
	 set total_size [expr $total_size + $file_size + $tar_header_size]
      }
      set xml "[dump_xml $rec]"
   }
   set xml_size [string length $xml]
   set total_size [expr $total_size + $xml_size + $tar_header_size]
   puts $chan "HTTP/1.0 200 Ok"
   puts $chan "Server: tivoweb/fun\nConnection: close"
   puts $chan "Accept-Ranges: bytes"
   puts $chan "Content-Length: $total_size"
   puts $chan "Content-type: application/tmf"
   puts $chan ""
   set info(ty+) "################################"
   append info(ty+) $info(ty+); append info(ty+) $info(ty+)
   append info(ty+) $info(ty+); append info(ty+) $info(ty+)
   foreach part $part_files {
      exec $mfs_bin_dir/mfs_stream -s $part >@$chan 2> stderr
   }
   puts -nonewline $chan "$info(ty+)$xml$info(ty+)"
   unset info(ty+)
   flush $chan
   return ""
}

setup_em_vars
register_content_handler "tmf" "application/tmf" "" 1 serve_tmf
register_content_handler "ty" "application/ty" "" 1 serve_ty
register_module "build_extract_page" "Extract" "Download recordings as insertable files"

}