if {![exists -proc class]} { package require oo } source /mod/webif/lib/setup require tdelete set dmsfile /mnt/hd2/dms_cds.db class ts { file "" base "" title "" synopsis "" definition "" channel_num 0 channel_name "" start 0 end 0 flags "" error "" guidance "" bookmarks 0 schedstart 0 scheddur 0 } ts method duration {{raw 0}} { set d [expr $end - $start] if {!$raw} { set d $($d / 60) } return $d } ts method size {} { file stat $file st return $st(size) } ts method _parse {line} { set vars [split $line "\t"] lassign [split $line "\t"] \ title synopsis definition channel_num channel_name \ start end flags_list guidance bookmarks schedstart scheddur set flags [split [string range $flags_list 0 end-1] ,] } ts method bookmarks {} { return [exec /mod/bin/hmt -bookmarks $file] } ts method flag {f} { if {$f in $flags} {return 1} else {return 0} } ts method unlock {} { set cmd [list /mod/bin/hmt -lock $file] exec {*}$cmd return 1 } ts method lock {} { set cmd [list /mod/bin/hmt +lock $file] exec {*}$cmd return 1 } ts method unenc {} { set cmd [list /mod/bin/hmt -protect $file] exec {*}$cmd return 1 } ts method enc {} { set cmd [list /mod/bin/hmt +protect $file] exec {*}$cmd return 1 } ts method set_new {} { set cmd [list /mod/bin/hmt +new $file] exec {*}$cmd return 1 } ts method set_watched {} { set cmd [list /mod/bin/hmt -new $file] exec {*}$cmd return 1 } ts method setfile {f} { set file $f } proc {ts parse} {file line} { set e [ts new] $e setfile $file $e _parse $line return $e } proc {ts exec} {file} { set raw 0 set cmd [list /mod/bin/hmt] lappend cmd "-p" lappend cmd $file #puts "CMD -$cmd-" return [exec {*}$cmd] } proc {ts fetch} {file {checked 0}} { # Check that this is a .ts file which has at least one sidecar # file (.nts) if {!$checked} { if {[file extension $file] ne ".ts"} { return 0 } if {![file exists "[file rootname $file].nts"]} { return 0 } } return [ts parse $file [ts exec $file]] } ts method delete {} { set root [file rootname $file] # Protect special characters in root. # In particular [] characters which are used a lot # for torrent names. regsub -all {([\\["$])} $root {\\\1} root foreach f [glob -nocomplain "${root}.*"] { tdelete $f puts "Removed $f
" } return 1 } ts method move {dst {touch 0} {force 0}} { set root [file rootname $file] regsub -all {([\\["$])} $root {\\\1} root foreach f [glob -nocomplain "${root}.*"] { set nf "$dst/[file tail $f]" while {[file exists $nf]} { set nf "$dst/_[file tail $nf]" } file rename $f $nf if {$touch} { exec /mod/bin/busybox/touch $nf } } return 1 } ts method copy {dst} { set root [file rootname $file] regsub -all {([\\["$])} $root {\\\1} root foreach f [glob -nocomplain "${root}.*"] { file copy $f "$dst/[file tail $f]" } return 1 } ts method settitle {newtitle} { if {[string length newtitle] > 48} { return } exec /mod/bin/hmt "+settitle=${newtitle}" $file } ts method dlnaloc {} { set mime "video/ts" if {![file exists $::dmsfile]} { return {} } if {[catch {set db [sqlite3.open $::dmsfile]}]} { return {} } set url "" set rfile [file normalize $file] if {[catch {set muri [$db query " select tblresource.mimetype, contenturi from tblresource join tblmedia using (mediaid) where localurl = '%s'" $rfile]}]} { set muri "" } if {$muri ne ""} { set rec [lindex $muri 0] set xuri [lindex $rec 3] set mime [lindex $rec 1] set url "http://$::env(HTTP_HOST):9000/web/$xuri" } $db close if {$url ne "" } { return [list $url $mime] } else { return {} } } proc {ts renamegroup} {from to} { set dir [file dirname $from] set root [file rootname $from] # Catch from string without a . character in it if {$root eq $from} { return } # Protect special characters in root. In particular [] characters # which are used a lot for torrent names. regsub -all {([\\["$])} $root {\\\1} root foreach f [glob -nocomplain "${root}.*"] { set ext [file extension $f] #puts "rename $f \"${dir}/${to}${ext}\"" file rename $f "${dir}/${to}${ext}" } exec /mod/bin/hmt "+setfilename=$to" "${dir}/${to}.hmt" set ndir [file normalize $dir] if {![catch {set db [sqlite3.open $::dmsfile]}]} { catch { set x [lindex [$db query {select mediaid from tblMedia where localUrl = '%s'} [file normalize $from]] 0] lassign $x key mediaid if {$mediaid ne ""} { $db query {update tblMedia set localUrl = '%s' where mediaid = %s} "${ndir}/{$to}.ts" $mediaid $db query {update tblMedia set title = '%s' where mediaid = %s} "{$to}.ts" $mediaid } } $db close } }