650 lines
20 KiB
Plaintext
Executable File
650 lines
20 KiB
Plaintext
Executable File
#!/mod/bin/jimsh
|
|
# "schedchk = Check for recording schedule issues and attempt to fix them"
|
|
# author MymsMan based on webif functions by af123
|
|
|
|
source /mod/webif/lib/setup
|
|
require rsv.class epg.class system.class
|
|
|
|
|
|
proc log {msg {level 1}} {
|
|
if {$level > $::loglevel} return
|
|
puts $::logfd "[\
|
|
clock format [clock seconds] -format "%d/%m/%Y %H:%M:%S"\
|
|
] - SC $msg"
|
|
flush $::logfd
|
|
}
|
|
|
|
# let's mess with the internals - needs to be moved to rsv.class
|
|
rsv method set {ivName val} {
|
|
set $ivName $val
|
|
}
|
|
|
|
# Parse command options and apply defaults
|
|
proc checkopts {argv} {
|
|
global optarray
|
|
set settings [settings]
|
|
set parmerror 0
|
|
|
|
set ::autologlevel [$settings _nval_setting "autolog"]
|
|
set ::loglevel $::autologlevel
|
|
if {[info exists ::auto::logfd]} {
|
|
set logfd ::auto::logfd
|
|
}
|
|
|
|
# Read List of options with default values
|
|
source "/mod/webif/plugin/schedchk/optlist.jim"
|
|
# Override default from settings DB
|
|
foreach optl $optarray {
|
|
lassign $optl desc key defval helptxt
|
|
if {$defval eq "n"} {set defval 0}
|
|
if {$defval eq "y"} {set defval 1}
|
|
set ::opts($key) [$settings _nval_setting "schedchk_$key"]
|
|
if {$::opts($key)==0} {set ::opts($key) $defval}
|
|
}
|
|
|
|
# Handle text setting for oher options
|
|
set otheropts [$settings _tval_setting "schedchk_otheropts"]
|
|
if {$otheropts == 0} {set otheropts ""}
|
|
|
|
# Parse argument lists
|
|
foreach argl [list $otheropts $argv] {
|
|
set ::optlist ""
|
|
log "arg list $argl" 2
|
|
for {set ix 0} {$ix < [llength $argl]} {incr ix} {
|
|
set arg [lindex $argl $ix]
|
|
|
|
#check if option in optarray list
|
|
if {[string range $arg 0 0] == "-"} {
|
|
set argx [string tolower [string range $arg 1 end]]
|
|
if {[dict exists $::opts $argx]} {
|
|
incr ix
|
|
set val [lindex $argl $ix]
|
|
set nval $val
|
|
if {$val eq "y"} {set nval 1}
|
|
if {$val eq "n"} {set nval 0}
|
|
if {![string is double -strict $nval]} {
|
|
if {[string length $nval] == 0 ||
|
|
[string range $nval 0 0] == "-"} {
|
|
# Value omitted assume true
|
|
set nval 1
|
|
set val "y"
|
|
incr ix -1
|
|
} else {
|
|
log "Option $arg value ($val) is not y, n or numeric" 0
|
|
incr ix -1
|
|
set parmerror 1
|
|
continue
|
|
}
|
|
}
|
|
lappend ::optlist $arg
|
|
lappend ::optlist $val
|
|
set ::opts($argx) $nval
|
|
continue
|
|
}
|
|
}
|
|
|
|
# check other options
|
|
switch -- $arg {
|
|
-rsv -
|
|
--help -
|
|
-h {
|
|
set ::opt $arg
|
|
}
|
|
-hmt {
|
|
set ::opt $arg
|
|
incr ix
|
|
set file [lindex $argl $ix]
|
|
set ::file $file
|
|
|
|
if {[file isfile $file]} {
|
|
set ::ts [ts fetch $file]
|
|
if {$::ts == 0} { "Cannot process ($file) file is not valid recording" 0
|
|
set parmerror 1
|
|
continue
|
|
}
|
|
} else {
|
|
log "Cannot process ($file) file does not exist" 0
|
|
set parmerror 1
|
|
continue
|
|
}
|
|
}
|
|
default {
|
|
log "Unrecognized option: $arg" 0
|
|
set parmerror 1
|
|
continue
|
|
}
|
|
}
|
|
|
|
}
|
|
}
|
|
|
|
if {$::opts(d)} {
|
|
set ll $::loglevel
|
|
if {$::opts(d) > $ll} {set ll $::opts(d)}
|
|
set ::debug 1
|
|
set ::loglevel $ll
|
|
set ::auto::loglevel $ll
|
|
}
|
|
|
|
if {$parmerror} {
|
|
log "Parameter errors found"
|
|
exit
|
|
}
|
|
|
|
}
|
|
|
|
|
|
proc svcmap {} {
|
|
# establish rsv <-> epg service_id mapping
|
|
global svcmap svcdef
|
|
set svcmap {}
|
|
set svcdef {}
|
|
set svcdef(0) 0
|
|
lmap i \
|
|
[$::channeldb query {select hSvc, usSvcid, eVideoType from TBL_SVC}] \
|
|
{
|
|
set svcmap([lindex $i 1]) [lindex $i 3]
|
|
set svcdef([lindex $i 1]) [lindex $i 5]
|
|
}
|
|
set svckeys [array names svcmap]
|
|
}
|
|
|
|
proc conflict-list {} {
|
|
global conflicts
|
|
if {$::opts(noconflict)} {
|
|
log "-noconflict Bypassing automatic conflict resolution"
|
|
set conflicts {}
|
|
return
|
|
}
|
|
|
|
set conflicts [rsv newconflicts [system tuners] "xlist"]
|
|
if {[llength $conflicts] > 1} {
|
|
log "++++ [llength $conflicts] Conflicts exist +++" 1
|
|
log "$conflicts" 3
|
|
}
|
|
}
|
|
|
|
proc rsvscan {} {
|
|
global svcmap conflicts svcdef now thresh
|
|
svcmap
|
|
conflict-list
|
|
|
|
|
|
set resvs [rsv list]
|
|
|
|
# for each reservation
|
|
#
|
|
foreach resv $resvs {
|
|
set name [$resv name]
|
|
set def $svcdef([$resv get hsvc])
|
|
set s [$resv start]
|
|
set ds "[clock format $s -format {%d/%m/%y %H:%M}]"
|
|
set d [$resv get nduration]
|
|
set e $($s + $d)
|
|
set slot [$resv get ulslot]
|
|
|
|
lassign [$resv padded 1] sp ep
|
|
|
|
# Ignore manual recordings & reminders
|
|
if {[$resv get ersvtype] != 3} { continue}
|
|
# Has event passed
|
|
if {$now > $e + $ep} {
|
|
set ended 1
|
|
incr num_ended
|
|
} else {
|
|
set ended 0
|
|
}
|
|
|
|
set dresv "$ds [clock format $d -format {%H:%M}] === slot $slot === $name === [$resv channel_name]"
|
|
|
|
if {!$ended} {
|
|
log "Reservation - $dresv" 2
|
|
set elist [$resv aul]
|
|
set enum -1
|
|
set ecrids [split [$resv get szEventToRecord] "|"]
|
|
set ecrid [$resv get szCRID]
|
|
|
|
if {[llength $elist] > 0} {
|
|
#
|
|
# check each episode scheduled
|
|
#
|
|
foreach epsd $elist {
|
|
lassign $epsd service_id start end event_id
|
|
incr enum
|
|
set ecrid [lindex $ecrids $enum]
|
|
set epgcrid [string range $ecrid [string first "/" $ecrid] end]
|
|
set ecrid [string range $ecrid 1 end]
|
|
set dur $($end-$start)
|
|
set deps "[clock format $start -format {%d/%m/%y %H:%M}] [clock format $dur -format {%H:%M}] === slot $slot === $name === [$resv channel_name]"
|
|
|
|
if {$start > $thresh} {
|
|
log "Start > Threshold - $deps" 2
|
|
break
|
|
}
|
|
|
|
if {$start < $now} {
|
|
#
|
|
# Should be recording now, check if it is
|
|
#
|
|
log "Already started? Status = [$resv status ] - $deps" 1
|
|
# need to check whether it has actually started and schedule alternate if not recording
|
|
if {[$resv status]=="recording"} {
|
|
# Recording but is it actually growing
|
|
# How to associate recording with slot?
|
|
puts [system nugget recordings]
|
|
}
|
|
|
|
continue
|
|
}
|
|
|
|
set svc $svcmap($service_id)
|
|
# Retrieve epg record for the episode
|
|
set record [lindex [\
|
|
epg dbfetch dump -service $svc -event $event_id -sort ""] 0]
|
|
log "$service_id $start $end $svc $event_id $record $ecrid $epgcrid" 3
|
|
|
|
if {$record==""} {
|
|
#
|
|
# No epg rcord found for the episode - find alternate showing
|
|
#
|
|
log "+++ No matching epg entry ++++ $deps" 0
|
|
if {$::opts(nomissepg)} {
|
|
log "-nomissepg - Not checking for alternate" 1
|
|
continue
|
|
}
|
|
# look for an alternate showing
|
|
set others [epg dbfetch dump -crid $epgcrid -nocase 1 -sort "start" ]
|
|
#param "collate nocase"
|
|
log "$ecrid $epgcrid $ecrids $others" 32
|
|
set other [findAlternate $resv $others $start $def 1]
|
|
if {$other != ""} {
|
|
set ostart [$other get start]
|
|
set odur [$other get duration]
|
|
set oend $($ostart+$odur)
|
|
set oname [$other get name]
|
|
set ocname [$other get channel_name]
|
|
set dother "[clock format $ostart -format {%d/%m/%y %H:%M}] [clock format $odur -format {%H:%M}] === $oname === $ocname"
|
|
# attempt to schedule the alternate (inplace)
|
|
if {!$::opts(noinplace)} {
|
|
update_event $resv $other $epsd "$deps--->$dother" "Event Changed"
|
|
conflict-list
|
|
continue
|
|
}
|
|
# attempt to schedule the alternate (new even+skip)
|
|
if {[schedule $other $dother "Event Changed"]} {
|
|
if {![$resv isseries]} {
|
|
# delete single recording
|
|
cancel $resv $deps "Event Changed"
|
|
} else {
|
|
# move crid from scheduled to recorded
|
|
replaceskip $resv $ecrid $deps "Event Changed"
|
|
#refresh $resv $deps
|
|
}
|
|
conflict-list
|
|
continue
|
|
}
|
|
}
|
|
|
|
} else {
|
|
#
|
|
# Epg entry for the episode found
|
|
#
|
|
|
|
# Check that details match
|
|
|
|
set epgname [$record get name]
|
|
set def $svcdef([$record get channel_hsvc])
|
|
set deps "[clock format $start -format {%d/%m/%y %H:%M}] [clock format $dur -format {%H:%M}] === slot $slot === $epgname === [$record get channel_name]"
|
|
|
|
log "Episode $deps" 2
|
|
set ok 1
|
|
set reason "no reason"
|
|
if {$start != [$record get start]} {
|
|
set ok 0
|
|
set reason "Start Mismatch: $start != [$record get start"
|
|
log "+++ $reason +++ $deps" 1
|
|
}
|
|
if {$dur != [$record get duration]} {
|
|
set ok 0
|
|
set reason "Duration Mismatch: $dur != [$record get duration]"
|
|
log "+++ $reason +++ $deps" 1
|
|
}
|
|
set evt_crid [string toupper [$record get event_crid]]
|
|
if {$epgcrid != $evt_crid} {
|
|
set ok 0
|
|
set reason "Crid Mismatch: $epgcrid != $evt_crid"
|
|
log "+++ $reason +++ $deps" 1
|
|
}
|
|
if {!$ok && !$::opts(noepgchg)} {
|
|
if {!$::opts(noinplace)} {
|
|
update_event $resv $record $epsd "$deps" $reason
|
|
} else {
|
|
refresh $resv $deps $reason
|
|
}
|
|
conflict-list
|
|
}
|
|
|
|
# Check for conflicts
|
|
|
|
if {"$slot$end" in $conflicts} {
|
|
set ok 0
|
|
log "+++ Confict exists +++ $deps" 1
|
|
#set others [$record othertimes]
|
|
set others [epg dbfetch dump -crid $epgcrid -nocase 1 -sort "start" debug 1]
|
|
set other [findAlternate $resv $others $start $def 0]
|
|
if {$other != ""} {
|
|
set ostart [$other get start]
|
|
set odur [$other get duration]
|
|
set oend $($ostart+$odur)
|
|
set oname [$other get name]
|
|
set ocname [$other get channel_name]
|
|
set dother "[clock format $ostart -format {%d/%m/%y %H:%M}] [clock format $odur -format {%H:%M}] === $oname === $ocname"
|
|
|
|
# attempt to schedule the alternate
|
|
if {!$::opts(noinplace)} {
|
|
update_event $resv $other $epsd "$deps--->$dother" "Confict resolution"
|
|
conflict-list
|
|
continue
|
|
}
|
|
if {[schedule $other $dother "Confict resolution"]} {
|
|
if {![$resv isseries]} {
|
|
# delete single recording
|
|
cancel $resv $deps "Conflict resolution"
|
|
} else {
|
|
# skip conflicted epidode
|
|
skip $resv $svc $event_id $deps "Conflict resolution"
|
|
}
|
|
conflict-list
|
|
continue
|
|
}
|
|
}
|
|
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
log "+++ No episodes scheduled +++ $dresv" 1
|
|
}
|
|
} else {
|
|
log "Completed - $dresv" 2
|
|
# check for new series in same time slot
|
|
}
|
|
}
|
|
if {[llength $conflicts] > 1} {
|
|
log "++++ [llength $conflicts] Unresolved conflicts remain +++" 0
|
|
}
|
|
log "===============================================" 2
|
|
epg cleanup
|
|
}
|
|
# Scan others for a suitable alternate episode
|
|
proc findAlternate {resv others start definition sametime} {
|
|
# look for alternate with same definition HD/SD/radio
|
|
set other [scanAlternates $resv $others $start $definition $sametime 1]
|
|
if {$other == ""} {
|
|
# scan again wihout requiring matching definition
|
|
set other [scanAlternates $resv $others $start $definition $sametime 0]
|
|
}
|
|
return $other
|
|
}
|
|
|
|
# Scan others for a suitable alternate episode
|
|
proc scanAlternates {resv others start definition sametime samedef} {
|
|
global svcdef
|
|
|
|
foreach other $others {
|
|
set ostart [$other get start]
|
|
set odur [$other get duration]
|
|
set oend $($ostart+$odur)
|
|
set oname [$other get name]
|
|
set ocname [$other get channel_name]
|
|
set odef $svcdef([$other get channel_hsvc])
|
|
set dother "[clock format $ostart -format {%d/%m/%y %H:%M}] [clock format $odur -format {%H:%M}] === $oname === $ocname"
|
|
# same start time not suitable match for confilcts
|
|
if {$ostart == $start && !$sametime} {continue}
|
|
if {$ostart <= [clock seconds]} {continue}
|
|
# should favour same definition
|
|
if {$odef != $definition && $samedef} {continue}
|
|
log "Alternate Episode $dother" 2
|
|
set oconflicts [rsv checkconflict \
|
|
$ostart $odur \
|
|
[system tuners]]
|
|
# Should ignore conflicts with self
|
|
set cl [llength $oconflicts]
|
|
if {"$oname" in $oconflicts} {incr cl -1}
|
|
if {$cl >= [system tuners]} {
|
|
# Alternate has Conflicts
|
|
log "Alternate conflicts $oconflicts" 2
|
|
continue
|
|
}
|
|
return $other
|
|
}
|
|
return ""
|
|
}
|
|
|
|
# Create a new reservation
|
|
proc schedule {resv desc {reason ""} {type 1} } {
|
|
if {[$resv scheduled]} {
|
|
log "*** Already scheduled *** $desc === $reason" 0
|
|
return 1
|
|
}
|
|
if {$::opts(test)} {
|
|
log "*** Test mode =scheduled *** $desc === $reason" 0
|
|
return 1
|
|
}
|
|
set type 1
|
|
set r [rsv construct $resv $type]
|
|
if {[catch {$r insert pending} msg]} {
|
|
log "+++ Error while scheduling: $msg ++++ $desc === $reason" 0
|
|
return 0
|
|
} else {
|
|
log "*** scheduled *** $desc === $reason" 0
|
|
system restartpending
|
|
rsv commit
|
|
return 1
|
|
}
|
|
}
|
|
|
|
# Refresh a reservation
|
|
proc refresh {resv desc {reason ""}} {
|
|
if {$::opts(test)} {
|
|
log "*** Test mode =refreshed *** $desc === $reason" 0
|
|
return 1
|
|
}
|
|
set type 1
|
|
if {[catch {
|
|
$resv clear_ulslot
|
|
$resv set_refresh
|
|
$resv insert
|
|
} msg]} {
|
|
log "+++ Error while refreshing: $msg ++++ $desc === $reason" 0
|
|
return 0
|
|
} else {
|
|
log "*** refreshed *** $desc === $reason" 0
|
|
system restartpending
|
|
rsv commit
|
|
return 1
|
|
}
|
|
}
|
|
|
|
# Cancel reservation
|
|
proc cancel {resv desc {reason ""}} {
|
|
if {$::opts(test)} {
|
|
log "*** Test mode =cancelled *** $desc === $reason" 0
|
|
return 1
|
|
}
|
|
set type 1
|
|
if {[catch {
|
|
$resv clear_ulslot
|
|
$resv set_delete
|
|
$resv insert pending 0 1
|
|
} msg]} {
|
|
log "+++ Error while cancelling: $msg ++++ $desc === $reason" 0
|
|
return 0
|
|
} else {
|
|
log "*** cancelled *** $desc === $reason" 0
|
|
system restartpending
|
|
rsv commit
|
|
return 1
|
|
}
|
|
}
|
|
|
|
# Skip an episode - with apply_skip
|
|
proc skip {resv xservice xevent desc {reason ""}} {
|
|
if {$::opts(test)} {
|
|
log "*** Test mode =skipped *** $desc === $reason" 0
|
|
return 1
|
|
}
|
|
if {[catch {
|
|
$resv apply_skip $xservice $xevent
|
|
} msg]} {
|
|
log "+++ Error while skipping: $msg ++++ $desc === $reason" 0
|
|
return 0
|
|
} else {
|
|
log "*** skipped *** $desc === $reason" 0
|
|
system restartpending
|
|
rsv commit
|
|
return 1
|
|
}
|
|
}
|
|
|
|
# Skip an episode - with replace_skip
|
|
proc replaceskip {resv skipcrid desc {reason ""}} {
|
|
if {$::opts(test)} {
|
|
log "*** Test mode =skipped *** $desc === $reason" 0
|
|
return 1
|
|
}
|
|
if {[catch {
|
|
$resv clear_ulslot
|
|
$resv replace_skip [list $skipcrid]
|
|
$resv insert
|
|
} msg]} {
|
|
log "+++ Error while skipping: $msg ++++ $desc === $reason" 0
|
|
return 0
|
|
} else {
|
|
log "*** skipped *** $desc === $reason" 0
|
|
system restartpending
|
|
rsv commit
|
|
return 1
|
|
}
|
|
}
|
|
|
|
# Update reservation with new event details
|
|
proc update_event {resv other origaul desc {reason ""}} {
|
|
if {$::opts(test)} {
|
|
log "*** Test mode =Updated *** $desc === $reason" 0
|
|
return 1
|
|
}
|
|
set curauls [$resv aul]
|
|
set ecrids [split [$resv get szEventToRecord] "|"]
|
|
set hsvc [$other get channel_hsvc]
|
|
set start [$other get start]
|
|
set end [$other end]
|
|
set evtid [$other get event_id]
|
|
set othaul [list $hsvc $start $end $evtid]
|
|
set othcrid [string toupper "1[$other get channel_crid][$other get event_crid]"]
|
|
set newaul {}
|
|
set newevnts ""
|
|
log "$origaul-- $othaul -- $curauls $ecrids " 3
|
|
set insert 0
|
|
|
|
# rebuild aul and events list with new event in correct order
|
|
lmap aul $curauls ecrid $ecrids {
|
|
#puts "$aul $ecrid"
|
|
if {$aul == $origaul} {continue; #remove current entry}
|
|
if {$aul == ""} {continue; #null entry}
|
|
if {!$insert && $start <= [lindex $aul 1]} {
|
|
set insert 1
|
|
lappend newaul $othaul
|
|
append newevnts "$othcrid|"
|
|
}
|
|
lappend newaul $aul
|
|
append newevnts "$ecrid|"
|
|
}
|
|
# add to end if not inserted
|
|
if {!$insert} {
|
|
set insert 1
|
|
lappend newaul $othaul
|
|
append newevnts "$othcrid|"
|
|
}
|
|
log "$newevnts -- $newaul" 3
|
|
|
|
# update header with next event
|
|
lassign [lindex $newaul 0] service_id start end event_id
|
|
set dur $($end-$start)
|
|
if {[$resv get hsvc] != $service_id ||
|
|
[$resv get nsttime] != $start ||
|
|
[$resv get nduration] != $dur ||
|
|
[$resv get usevtid] != $event_id} {
|
|
$resv set nduration $($end-$start)
|
|
$resv set ucVolume "$service_id:$event_id:$start"
|
|
log "$desc update next episode [$resv get ucVolume]" 2
|
|
}
|
|
|
|
if {[catch {
|
|
$resv set action 5
|
|
$resv setaul [$resv buildaul $newaul]
|
|
$resv set szEventToRecord $newevnts
|
|
$resv insert
|
|
} msg]} {
|
|
log "+++ Error while updating: $msg ++++ $desc === $reason" 0
|
|
return 0
|
|
} else {
|
|
log "*** Updated *** $desc === $reason" 0
|
|
system restartpending
|
|
# Ensure our copy matches the updated
|
|
$resv set hsvc $service_id
|
|
$resv set nsttime $start
|
|
$resv set nduration $($end-$start)
|
|
$resv set usevtid $event_id
|
|
$resv set ucVolume 0
|
|
return 1
|
|
}
|
|
}
|
|
|
|
#----------------------------------------------------------------------------------------------------------
|
|
# Start of mainline
|
|
|
|
set ::optlist ""
|
|
set ::opt "-h"
|
|
set ::debug 0
|
|
global optarray
|
|
|
|
set logfd stdout
|
|
if {[info exists ::auto::logfd]} {
|
|
set logfd $::auto::logfd
|
|
}
|
|
|
|
# validate parameters
|
|
checkopts $argv
|
|
|
|
set now [clock seconds]
|
|
if {$::opts(thresh)} {
|
|
set thresh $($now + ($::opts(thresh)*60*60))
|
|
} else {
|
|
set thresh $($now + (9*24*60*60))
|
|
}
|
|
log "Threshold $::opts(thresh) = $thresh [clock format $thresh -format {%d/%m/%Y %H:%M:%S}]" 2
|
|
|
|
# process command
|
|
switch -- $opt {
|
|
-rsv { # "scan the recording schedule"
|
|
rsvscan
|
|
}
|
|
-h -
|
|
--help -
|
|
default { # Help
|
|
puts "schedchk = Check for recording schedule issues and attempt to fix them"
|
|
puts " "
|
|
puts "schedchk -h = produce this help"
|
|
puts "schedchk -rsv = scan the recording schedule"
|
|
|
|
puts ""
|
|
puts "Options Default (unless changed in Settings) "
|
|
foreach optl $optarray {
|
|
lassign $optl desc key default helptxt
|
|
puts [format "-%-11s %-4s = %s" $key $default $helptxt]
|
|
}
|
|
}
|
|
|
|
}
|