hummypkg
/
webif
5
3
Fork 4
Code Issues Pull Requests Releases 1 Activity
webif/webif/lib/rsv.class

1742 lines
39 KiB
Tcl
Raw Permalink Blame History

source /mod/webif/lib/setup
if {![exists -command class]} { package require oo }
if {![exists -command sqlite3.open]} { package require sqlite3 }
if {![exists -command binary]} { package require binary }
require settings.class system.class plugin svc.class
set binaryfields aulEventToRecordInfo
class rsv {
ulslot -1
ersvtype 0
hsvc 0
nsttime 0
szsttime "00000000000000"
nduration 0
erepeat 0
usevtid 0
szevtname {}
ulPreOffset 0
ulPostOffset 0
ulProgramId 0
ulSeriesId 0
ucVolume 0
ucInputMode 0
usChNum 0
ucRecKind 0
ucCRIDType 0
szCRID {}
szFPBRecPath {}
szRecordedProgCrid {}
szEventToRecord {}
aulEventToRecordInfo {}
bRecomRsv 0
usLastRecordedEvtId 0
eReady 0
szSvcName {}
usLcn 0
sort 0
action 0
_table ""
_origstart 0
}
proc {rsv dbhandle} {args} {
if {"-close" in $args} {
if {[info exists ::rsv::db]} {
catch {$::rsv::db close}
unset ::rsv::db
return 1
}
return 0
}
if {[info exists ::rsv::db]} {
return $::rsv::db
}
set ::rsv::db [sqlite3.open /var/lib/humaxtv/rsv.db]
$::rsv::db query {attach database '/var/lib/humaxtv/channel.db' as channel}
if {![file exists /var/lib/humaxtv/rsvp.db]} {
file copy /var/lib/humaxtv/rsv.db /var/lib/humaxtv/rsvp.db
set tdb [sqlite3.open /var/lib/humaxtv/rsvp.db]
$tdb query {drop table TBL_VERSION}
$tdb query {alter table TBL_RESERVATION rename to pending}
$tdb query {alter table pending add column action int}
$tdb query {delete from pending}
$tdb close
}
$::rsv::db query {attach database '/var/lib/humaxtv/rsvp.db' as pending}
# These are required to upgrade old tables.
catch { $::rsv::db query { alter table pending add column action int} }
# Add the skip table if missing
catch { $::rsv::db query {
create table if not exists pending.skip
(
ulslot int,
state text,
service_id int,
event_id int,
hSvc int,
start int,
ucCRIDType int,
szCRID text,
szSkipCRID text
);
}}
catch { $::rsv::db query {
create unique index pending.skipidx
on skip(
ulslot, state, service_id, event_id,
ucCRIDType, szCRID, szSkipCRID
);
} }
return $::rsv::db
}
alias {rsv cleanup} rsv dbhandle -close
rsv method status {} {
switch -- [system nugget schedule.timers.status $ulslot] {
"0,0" { return "idle" }
"1,1" { return "ready" }
"2,1" { return "arwatch" }
"2,2" { return "recording" }
default { return "unknown" }
}
}
rsv method aul {{filter false}} {
set aul {}
set xaul {}
if {$filter} { set xaul [$self skiplist] }
for {set i 0} {$i < [string length $aulEventToRecordInfo]} {
incr i 16} {
binary scan [string range $aulEventToRecordInfo $i $($i + 15)]\
iiii service start end event_id
if {"$service:$event_id" ni $xaul} {
catch {lappend aul [list $service $start $end $event_id]}
}
}
return $aul
}
proc {rsv mkaul} {e} {
$e get_channel_info
return [binary format iiii \
[$e get channel_hsvc] \
[$e get start] \
[$e end] \
[$e get event_id] \
]
}
proc {rsv buildaul} {auls} {
set newaul {}
foreach aul $auls {
lassign $aul _hsvc _start _end _eid
append newaul [binary format iiii \
$_hsvc $_start $_end $_eid]
}
return $newaul
}
rsv method setaul {s} {
set aulEventToRecordInfo $s
}
rsv method clear_ulslot {} {
set ulslot -1
}
rsv method isseries {} {
if {$ucRecKind == 4} { return 1 } else { return 0 }
}
rsv method issplit {} {
if {$ucRecKind == 2} { return 1 } else { return 0 }
}
rsv method _strip {str} {
return [system strip $str]
}
rsv method folder {} {
return [$self _strip $szFPBRecPath]
}
rsv method name {} {
set name [$self _strip $szevtname]
if {$name == ""} {
switch $ersvtype {
1 { set name "--- Unnamed reminder ---" }
2 { set name "--- Unnamed manual reminder ---" }
3 { set name "--- Unnamed recording ---" }
4 { set name "--- Unnamed manual recording ---" }
5 { set name "--- Wake-up ---" }
6 { set name "--- Sleep ---" }
7 { set name "--- Auto Update ---" }
11 { set name "--- DSO Event ---" }
default { set name "--- Unknown event type $ersvtype ---" }
}
}
return $name
}
rsv method padded {{l 0}} {
if {$ulPreOffset > 0 || $ulPostOffset > 0} {
if {$l} {
return [list $ulPreOffset $ulPostOffset]
} else {
return 1
}
} else {
if {$l} {
return {0 0}
} else {
return 0
}
}
}
rsv method channel_name {} {
return [string range $szSvcName 1 end]
}
rsv method szsttime_stamp {} {
set spaced [regsub {^(....)(..)(..)(..)(..)(..).*} \
$szsttime {\1 \2 \3 \4 \5 \6}]
set stamp 0
catch {set stamp [clock scan $spaced -format "%Y %m %d %H %M %S"]}
return $stamp
}
rsv method start {} {
if {[string range $szsttime 0 3] eq "0000"} { return $nsttime }
set tm [$self szsttime_stamp]
if {$tm > 0} { return $tm }
return $nsttime
}
rsv method end {} {
return $([$self start] + $nduration)
}
rsv method showing {} {
set now [clock seconds]
if {$nsttime - $ulPreOffset <= $now &&
$nsttime + $nduration + $ulPostOffset >= $now} {
return 1
}
return 0
}
rsv method icon {} {
set rsvicon ""
switch $ersvtype {
1 -
2 { set rsvicon "175_1_00_Reservation_Watch.png" }
3 -
4 { set rsvicon "175_1_11_Reservation_Record.png" }
5 { set rsvicon "745_1_10_Video_2Live.png" }
6 { set rsvicon "745_1_11_Video_1REC.png" }
7 { set rsvicon "345_6_08_ST_Ad_Hoc.png" }
}
return $rsvicon
}
rsv method RKIcon {} {
switch $ucRecKind {
2 { set RKIcon "178_1_26_Icon_Split.png" }
4 { set RKIcon "175_1_11_Series_Record.png" }
default {
switch $erepeat {
1 {set RKIcon "521_1_00_RP_Daily_C.png"}
2 {set RKIcon "521_1_00_RP_Weekly_C.png"}
3 {set RKIcon "521_1_00_RP_Weekdays_C.png"}
4 {set RKIcon "521_1_00_RP_Weekend_C.png"}
default {set RKIcon ""}
}
}
}
return $RKIcon
}
rsv method pendingicon {{width 30}} {
switch $action {
0 { set icon "add" }
1 { set icon "close" }
2 { set icon "ar" }
3 { set icon "pad" }
4 { set icon "folder" }
5 { set icon "skip" }
6 { set icon "refresh" }
}
return "<img class=va width=$width src=/img/$icon.png>"
}
rsv method iconset {{height 20}} {
set iconlist {}
set icon [$self icon]
if {$icon ne ""} {
lappend iconlist "<img src='/images/$icon' height=$height>"
if {$ersvtype == 3} {
if {[$self padded]} {
set padding "<- $($ulPreOffset / 60), $($ulPostOffset / 60) ->"
lappend iconlist \
"<img src=/img/pad.png height=$height
title=\"$padding\" alt=\"$padding\">"
} elseif {[$self status] eq "arwatch"} {
lappend iconlist \
"<img src=/img/aractive.gif height=$height>"
} else {
lappend iconlist \
"<img src=/img/ar.png height=$height>"
}
}
}
set icon [$self RKIcon]
if {$icon ne ""} {
lappend iconlist "<img src='/images/$icon' height=$height>"
}
return $iconlist
}
rsv method set {ivName val} {
set $ivName $val
}
rsv method setorigstart {o} {
set _origstart $o
}
rsv method set_delete {} {
set action 1
}
rsv method set_unpad {} {
set action 2
}
rsv method set_folder {name} {
set action 4
set szFPBRecPath $name
}
rsv method set_pad {{pre 60} {post 60}} {
set action 3
set ulPreOffset $pre
set ulPostOffset $post
}
rsv method set_refresh {} {
set action 6
set aulEventToRecordInfo ""
}
rsv method update_aul {new_event old_aul} {
# Add new_event (optional) to aulEventToRecordInfo and szEventToRecord
# remove old_aul (optional) from " "
# Maintain list in time order
set curauls [$self aul]
set ecrids [split $szEventToRecord "|"]
set evtaul {}
set insert 1
set start 0
# Do we have new event to add?
if {$new_event != 0 && $new_event !={}} {
set service_id [$new_event get channel_hsvc]
set start [$new_event get start]
set end [$new_event end]
set evtid [$new_event get event_id]
set evtaul [list $service_id $start $end $evtid]
set evtcrid [string toupper \
"1[$new_event get channel_crid][$new_event get event_crid]"]
set insert 0
}
# rebuild aul and events list with new event in correct order
lmap aul $curauls ecrid $ecrids {
#puts "$aul $ecrid"
if {$aul == $old_aul} {continue; #remove current entry}
if {$aul == ""} {continue; #null entry}
if {!$insert && $start <= [lindex $aul 1]} {
set insert 1
lappend newaul $evtaul
append newevnts "$evtcrid|"
}
lappend newaul $aul
append newevnts "$ecrid|"
}
# add to end if not inserted
if {!$insert} {
set insert 1
lappend newaul $evtaul
append newevnts "$evtcrid|"
}
set action 5
$self setaul [$self buildaul $newaul]
set szEventToRecord $newevnts
}
rsv method set_next_event {} {
# Update reservation next event info in ucVolume
if {[string length $aulEventToRecordInfo] >0} {
binary scan [string range $aulEventToRecordInfo 0 15] \
iiii service_id start end event_id
set dur $($end-$start)
if {$hsvc != $service_id ||
$nsttime != $start ||
$nduration != $dur ||
$usevtid != $event_id} {
set nduration $dur
set ucVolume "$service_id:$event_id:$start"
}
} else {
# The next event is not yet in the EPG
set time $([clock seconds] - 86400)
set ucVolume "$hsvc:$usLastRecordedEvtId:$time"
}
}
rsv method reset_next_event {} {
# Ensure our copy matches the updated reservation
if {$ucVolume != 0} {
lassign [split $ucVolume ":"] service_id event_id start
set hsvc $service_id
set nsttime $start
set usevtid $event_id
set ucVolume 0
}
}
rsv method set_skip {event} {
set action 5
$event get_channel_info
set event_hsvc [$event get channel_hsvc]
set service_id [$event get service_id]
set event_id [$event get event_id]
set crid [string toupper \
"[$event get channel_crid][$event get event_crid]"]
if {"1$crid" ni [split $szRecordedProgCrid "|"]} {
set szRecordedProgCrid "1$crid|$szRecordedProgCrid"
}
set szEventToRecord [string map "1$crid| {}" $szEventToRecord]
catch {
[rsv dbhandle] query {
insert or ignore into skip
(ulslot, state, ucCRIDType, szCRID, szSkipCRID,
service_id, event_id, start, hSvc)
values('%s', 'pending', '%s', '%s', '%s', %s, %s,
%s, %s)
} -1 $ucCRIDType $szCRID $crid $service_id $event_id [\
$event get start] $event_hsvc
}
set newaul ""
set next_event -1
foreach aul [$self aul] {
lassign $aul _hsvc _start _end _eid
if {$_hsvc == $event_hsvc && $_eid == $event_id} continue
# Track the next event which should be recorded.
if {$next_event == -1} {
set next_event $_eid
set next_hsvc $_hsvc
set next_time $_start
}
append newaul [binary format iiii \
$_hsvc $_start $_end $_eid]
}
set aulEventToRecordInfo $newaul
set nsttime [$event get start]
set nduration [$event get duration]
# Handle skipping the next up-coming instance.
if {$event_id eq $usevtid} {
# (mis)use some fields to hold the next event which
# should be recorded.
if {$next_event == -1} {
# The next event is not yet in the EPG
set time $([clock seconds] - 86400)
set ucVolume "$hsvc:$usLastRecordedEvtId:$time"
} else {
set ucVolume "$next_hsvc:$next_event:$next_time"
}
}
}
rsv method replace_skip {skiplist {debug false}} {
set action 5
set szRecordedProgCrid "1[join $skiplist |1]|"
# Remove episodes to be skipped from both szEventToRecord
# and aulEventToRecordInfo
set aul [$self aul]
if {![llength $aul]} return
set rec [lmap i \
[lrange [split $szEventToRecord |] 0 end-1] {
# Remove the initial CRID type
string range $i 1 end
}]
if {$debug} {
puts "_AUL: [llength $aul] $aul"
puts "_REC: [llength $rec] $rec"
}
# Should not happen but in this case the Humax software will
# sort it out in the background once it sees the new skiplist.
if {[llength $aul] != [llength $rec]} return
set skipnext 0
set i 0
foreach crid $rec {
if {$crid ni $skiplist} {
incr i
continue
}
if {$i == 0} { incr skipnext }
set aul [lreplace $aul $i $i]
set rec [lreplace $rec $i $i]
if {$debug} { puts " -- Removing $crid" }
incr i
}
if {$debug} {
puts " AUL: [llength $aul] $aul"
puts " REC: [llength $rec] $rec"
}
if {[llength $rec]} {
set szEventToRecord "1[join $rec |1]|"
set aulEventToRecordInfo [rsv buildaul $aul]
} else {
set szEventToRecord ""
set aulEventToRecordInfo ""
}
# Is the next scheduled recording to be skipped?
if {!$skipnext} return
if {$debug} { puts "Skip next event." }
if {[llength $aul]} {
lassign [lindex $aul 0] _hsvc _start _end _eid
set ucVolume "$_hsvc:$_eid:$_start"
} else {
# The next event is not yet in the EPG
set time $([clock seconds] - 86400)
set ucVolume "$hsvc:$usLastRecordedEvtId:$time"
}
}
rsv method apply_skip {service event} {
require epg.class
lassign [epg dbfetch dump -service $service -event $event] epg
if {$epg eq ""} {
error "Cannot find event in EPG."
}
$epg get_channel_info
# First check to see if there is already a pending skip for this
# event and, if so, update that one.
set crid [string toupper \
"[$epg get channel_crid][$epg get series_crid]"]
set table pending
set ev [rsv fetch $table $ersvtype $hsvc 0 $usevtid $crid]
if {$ev == 0} {
set table TBL_RESERVATION
set ev $self
$ev clear_ulslot
}
$ev set_skip $epg
if {[catch {$ev insert_deferred} msg]} {
error "Error during insert."
}
}
rsv method remove_pending {} {
[rsv dbhandle] query "delete from pending where ulslot = $ulslot"
}
rsv method fix_hsvc {} {
set c [svc channel $szSvcName]
if {$c == 0} { set c [svc load usLcn $usLcn] }
if {$c == 0} return
set hsvc [$c get hSvc]
}
proc {rsv find_hsvc} {lcn channel} {
set c [svc channel $channel]
if {$c == 0} { set c [svc load usLcn $lcn] }
if {$c == 0} { return 0 }
return [$c get hSvc]
}
rsv method cleanvars {} {
return [lsort [lmap i [$self vars] {
if {[string index $i 0] eq "_"} continue
function $i
}]]
}
rsv method insert {{table pending} {force 0} {defer 0}} {
set rsvdb [rsv dbhandle]
set now [clock seconds]
# In-progress check
if {!$force && $nsttime - $ulPreOffset <= $now} {
# Start time in the past
if {$nsttime + $nduration + $ulPostOffset >= $now} {
# Still showing
switch $action {
0 { # Add
# Ok if real-time scheduling in use.
if {![rsv rtsched]} {
throw 20 "Event already in progress."
return
}
}
default {
throw 20 "Event already in progress."
return
}
}
} elseif {$action == 0} {
throw 20 "Event has finished."
return
}
}
# Duplicate check - all tables
if {!$force && $action == 0 && $usevtid} {
foreach tab {pending TBL_RESERVATION} {
set rec [$rsvdb query "
select ulslot from $tab
where usevtid = '%s'
and hsvc = '%s'
" $usevtid $hsvc]
if {[llength $rec] > 0} {
throw 20 "Duplicate reservation."
return
}
}
}
# Find a spare slot.
if {$ulslot < 0} {
set slotlist [$rsvdb query "
select ulslot FROM $table
order by ulslot;
"]
if {[llength $slotlist] > 0} {
set slots [lmap i $slotlist {lindex $i 1}]
set max [lindex $i end]
for {set i 0} {$i < $max} {incr i} {
if {$i ni $slots} {
set ulslot $i
break
}
}
if {$ulslot < 0} { set ulslot $($max + 1) }
}
if {$ulslot < 0} { set ulslot 0 }
}
set fields [$self cleanvars]
foreach field {szSvcName usLcn sort} {
set df [lsearch $fields $field]
set fields [lreplace $fields $df $df]
}
if {$table ne "pending"} {
set df [lsearch $fields "action"]
set fields [lreplace $fields $df $df]
}
set vals {}
set bvals {}
foreach field $fields {
set f [$self get $field]
if {$field in $::binaryfields && [string bytelength $f] > 1} {
binary scan $f H* fx
lappend bvals $fx
lappend vals "X'%s'"
} else {
lappend bvals $f
lappend vals "'%s'"
}
}
set query "insert into ${table}("
append query [join $fields ","]
append query ") values("
append query [join $vals ","]
append query ");"
#puts $query
#puts $bvals
$rsvdb query "delete from ${table} where ulslot = $ulslot;"
$rsvdb query $query {*}$bvals
switch $action {
0 { set actstr "Scheduled" }
1 { set actstr "Unscheduled" }
2 { set actstr "Set AR" }
3 { set actstr "Set padding" }
4 { set actstr "Set folder name" }
5 { set actstr "Set skip" }
6 { set actstr "Refresh" }
default { set actstr "Unknown action $action" }
}
system plog activity "$actstr [$self name] @ $nsttime"
if {$table eq "pending" && !$defer} { rsv commit }
}
rsv method insert_deferred {{table pending}} {
return [$self insert $table 0 1]
}
proc {rsv list} {{table tbl_reservation} {extra ""} {class rsv}} {
set qstring "
select $table.*,
channel.TBL_SVC.szSvcName, channel.TBL_SVC.usLcn,
case when ersvtype > 3 then 1 else 0 end as sort1,
case when nsttime + nduration < [clock seconds]
then 0 else 1 end as sort2
from $table
left join channel.TBL_SVC
on $table.hSvc = channel.TBL_SVC.hSvc
"
if {$extra ne ""} { append qstring $extra }
append qstring "
order by sort1, sort2 desc, nsttime
"
#puts "QSTRING: ($qstring)"
set res [[$class dbhandle] query $qstring]
set records {}
foreach rec $res {
lappend rec _table $table
lappend records [$class new $rec]
}
return $records
}
proc {rsv count} {{table tbl_reservation}} {
return [llength [rsv list $table]]
}
proc {rsv lookuptab} {} {
set records {}
foreach tab {tbl_reservation pending} {
set res [[rsv dbhandle] query "
select usSvcId, usevtid, ucCRIDType, szCRID,
ucRecKind, aulEventToRecordInfo,
szRecordedProgCrid
from $tab left join channel.TBL_SVC
on $tab.hSvc = channel.TBL_SVC.hSvc
where ersvtype <= 3
"]
foreach rec $res {
if {$rec(ucRecKind) == 4} {
set p "S"
} else {
set p "E"
}
set records([\
string tolower "$rec(usSvcId):$rec(usevtid)"]) $p
if {$rec(szCRID) eq ""} continue
if {$rec(ucCRIDType) == 49} {
set p "E"
} elseif {$rec(ucCRIDType) == 50} {
set p "S"
} else {
continue
}
foreach r [split $rec(szRecordedProgCrid) "|"] {
if {$r != {}} {
set records([string tolower "\
$rec(szCRID):\
[string range $r 1 end]"]) "R"
}
}
set aul $rec(aulEventToRecordInfo)
if {[string length $aul]} {
for {set i 0} {
$i < [string length $aul]} {incr i 16} {
binary scan [string range \
$aul $i $($i + 15)] \
iiii service start end event_id
set records([
string tolower \
"$service:$event_id"]) $p
}
} else {
set records([
string tolower \
"$rec(usSvcId):$rec(szCRID)"]) $p
}
}
}
# Add all skipped episodes for all series
set skiplist [rsv _skiplist]
foreach skip $skiplist {
set records($skip) "X"
}
return $records
}
proc {rsv xlookuptab} {} {
set records {}
foreach tab {tbl_reservation pending} {
set res [[rsv dbhandle] query "
select $tab.szCRID, channel.TBL_SVC.hSvc
from $tab left join channel.TBL_SVC
on $tab.hSvc = channel.TBL_SVC.hSvc
where ersvtype <= 3
"]
foreach rec $res {
lappend records "$rec(hSvc)/[file tail $rec(szCRID)]"
}
}
return $records
}
proc {rsv entry} {{table TBL_RESERVATION} crid svc} {
set res [[rsv dbhandle] query "
select $table.*,
channel.TBL_SVC.szSvcName, channel.TBL_SVC.usLcn
from $table
left join channel.TBL_SVC
on $table.hSvc = channel.TBL_SVC.hSvc
where szCRID like '%%%s' and $table.hsvc = '%s'
" $crid $svc]
if {[llength $res] > 0} {
return [rsv new [lindex $res 0]]
}
return 0
}
proc {rsv fetch} {table ersvtype hsvc nsttime usevtid {crid ""} {extra ""}} {
set q "
select $table.*,
channel.TBL_SVC.szSvcName, channel.TBL_SVC.usLcn
from $table
left join channel.TBL_SVC
on $table.hSvc = channel.TBL_SVC.hSvc
where $table.ersvtype = '%s'
and $table.hsvc = '%s'
and $table.usevtid = '%s'
"
set params "$ersvtype $hsvc $usevtid"
if {$nsttime > 0} {
append q " and $table.nsttime = '%s' "
lappend params $nsttime
}
if {$crid ne ""} {
append q " and szCRID = '%s' collate nocase "
lappend params $crid
}
if {$extra ne ""} {
append q " $extra "
}
set res [[rsv dbhandle] query $q {*}$params]
if {[llength $res] > 0} {
return [rsv new [lindex $res 0]]
}
return 0
}
proc {rsv slot} {{table TBL_RESERVATION} slot} {
set res [[rsv dbhandle] query "
select $table.*,
channel.TBL_SVC.szSvcName, channel.TBL_SVC.usLcn
from $table
left join channel.TBL_SVC
on $table.hSvc = channel.TBL_SVC.hSvc
where ulslot = %s" $slot]
if {[llength $res] > 0} {
return [rsv new [lindex $res 0]]
}
return 0
}
proc {rsv rtsched} {} {
if {![system nuggeted]} { return 0 }
if {![[settings] rtschedule]} { return 0 }
return 1
}
proc {rsv commit} {{plugins 1}} {
if {![rsv rtsched]} return
rsv dbhandle -close
if {[catch {
exec /mod/boot/rsvsync -realtime >> /mod/tmp/rsvsync.log} msg]} {
puts "Scheduling: $msg"
} else {
system restartpending 0
if {$plugins} {
eval_plugins rts
}
}
}
proc {rsv construct} {event type} {
global ccrid
$event get_channel_info
set args {}
set args(ersvtype) 3
set args(hsvc) [$event get channel_hsvc]
set args(nsttime) [$event get start]
set args(nduration) [$event get duration]
set args(usevtid) [$event get event_id]
set args(szevtname) "\025[xconv [$event get name]]"
set args(eReady) 30
lassign [system padding] args(ulPreOffset) args(ulPostOffset)
set ccrid [string toupper [$event get channel_crid]]
# Fallback from series to event if there is no series CRID.
if {$type == 2 && [$event get series_crid] eq ""} {
set type 1
}
if {$type == 1} {
# Event
set args(ucCRIDType) 49
set args(ucRecKind) 1
set ecrid [$event get event_crid]
if {$ecrid ne ""} {
set args(szCRID) "$ccrid$ecrid"
set args(szEventToRecord) "1$args(szCRID)|"
set args(aulEventToRecordInfo) [rsv mkaul $event]
# Handle split events
if {[string match {*#*} $args(szCRID)]} {
set args(ucRecKind) 2
lassign [split $args(szCRID) "#"] crid imi
set args(szCRID) $crid
# TODO - check to see how many parts there
# are...
append args(szEventToRecord) \
$args(szEventToRecord)
}
}
} elseif {$type == 3} {
# Reminder
set args(ersvtype) 2
set args(szsttime) [clock format $args(nsttime) \
-format {%Y%m%d%H%M%S}]
} else {
# Series
set args(ucCRIDType) 50
set args(ucRecKind) 4
set args(szCRID) "$ccrid[$event get series_crid]"
set args(szFPBRecPath) "$args(szevtname)"
set events {}
set seen {}
set now [clock seconds]
set progs [lmap i [\
epg dbfetch dump -scrid [$event get series_crid] \
-service [$event get service_id] \
-sort start] {
if {[set ecrid [$i get event_crid]] eq ""} continue
if {[$i end] < $now} {
set args(usLastRecordedEvtId) [$i get event_id]
continue
}
if {$ecrid in $seen} continue
lappend seen $ecrid
lappend events [rsv mkaul $i]
list "1$::ccrid$ecrid"
}]
# set 1st event to record
binary scan [string range [lindex $events 0] 0 15] \
iiii service_id start end event_id
#puts "$service_id $start [clock format $end] $event_id"
set args(hsvc) $service_id
set args(nsttime) $start
set args(usevtid) $event_id
set args(nduration) $($end-$start)
set args(szEventToRecord) "[join $progs "|"]|"
set args(aulEventToRecordInfo) [join $events ""]
}
return [rsv new $args]
}
proc {rsv manual} {start end lcn type repeat {title ""}} {
set args {}
set args(ersvtype) $type
set args(erepeat) $repeat
set args(nsttime) $start
set args(szsttime) [clock format $args(nsttime) \
-format {%Y%m%d%H%M%S}]
set args(nduration) $($end - $start)
set c [svc load usLcn $lcn]
set args(hsvc) [$c get hSvc]
if {$title eq ""} {
set title [$c get szSvcName]
}
set args(szevtname) $title
set args(ucRecKind) 0
set args(usevtid) 0
set args(eReady) 30
return [rsv new $args]
}
proc {rsv backup} {file} {
set rsvdb [rsv dbhandle]
require epg.class
if {[catch { set fd [open $file w] } msg]} {
error "Error creating backup file. - $msg"
}
puts "Backing up scheduled recordings and events..."
set events [rsv list]
set fields [[rsv] cleanvars]
puts $fd "# version 2"
puts $fd "#\n# Schedule\n# [join $fields "\t"]"
foreach event $events {
puts " Backing up scheduled event '[$event name]'"
puts -nonewline $fd "event\t"
foreach f $fields {
set ret [$event get $f]
if {$f in $::binaryfields} {
binary scan $ret H* ret
}
puts -nonewline $fd "$ret\t"
}
puts $fd ""
}
puts "Done."
puts "Backing up channel favourites..."
puts " Names:"
puts $fd "#\n# Favourites"
# Favourite names
set favnames {}
loop i 1 6 {
set favname [system strip \
[system param FAV_CUSTOM_STR0$i Text]]
set idx $(1 << ($i - 1))
set favnames($idx) $favname
puts $fd "favname\t$i\t$idx\t$favname"
puts " $favname"
}
set grp 0
foreach res [$rsvdb query {
select eFavGroup,
TBL_FAV.eSvcType,
substr(szSvcName, 2) as szSvcName,
favIdx
from TBL_FAV join TBL_SVC using (hSvc)
order by eFavGroup, favIdx
}] {
if {$res(eFavGroup) != $grp} {
set grp $res(eFavGroup)
if {[dict exists $favnames $grp]} {
puts " Group $favnames($grp)"
} else {
puts " Group '$grp':"
}
}
puts " $res(szSvcName)"
puts $fd "fav\t$res(eFavGroup)\t$res(eSvcType)\t$res(szSvcName)\t$res(favIdx)"
}
puts "Done."
puts "Backing up skiplist..."
set skiplist [$rsvdb query {
select * from skip
order by ulslot, start
}]
if {[llength $skiplist]} {
# Add key line
set keys "#\n# Skiplist\n#"
foreach {k v} [lindex $skiplist 0] {
append keys " $k,"
}
puts $fd $keys
foreach skip $skiplist {
puts -nonewline $fd "skip\t"
foreach {k v} $skip {
puts -nonewline $fd "$v\t"
}
puts $fd ""
}
}
puts "Done."
puts "Backing up channel list..."
puts $fd "#\n# Channels by hSvc"
foreach channel [epg channellist hSvc] {
lassign $channel name hsvc
puts $fd "hsvc\t$hsvc\t$name"
}
puts $fd "#\n# Channels by LCN"
foreach channel [epg channellist usLcn] {
lassign $channel name uslcn
puts $fd "lcn\t$uslcn\t$name"
}
puts "Done."
close $fd
}
proc {rsv restore} {file} {
set rsvdb [rsv dbhandle]
if {![file exists $file]} {
error "Backup file <i>$file</i> does not exist."
}
if {[catch { set fd [open $file r] } msg]} {
error "Error opening <i>$file</i> - $msg"
}
set data [split [read $fd] "\n"]
set ver 1
set hsvcmap {}
set lcnmap {}
set favmap {}
# Check version, build maps for later.
foreach line $data {
if {[string match "# version *" $line]} {
set ver [lindex [split $line " "] 2]
puts "Backup version $ver"
}
lassign [split $line "\t"] tag f1 f2 f3 f4
switch -- $tag {
hsvc { set hsvcmap($f1) $f2 }
lcn { set lcnmap($f2) $f1 }
favname { set favmap($f2) $f3 }
}
}
set chanmap [lreverse $hsvcmap]
puts "Restoring scheduled events from <i>$file</i>..."
# Disable RTS until next restart.
system nugget quit
# Clear tables
foreach tab {TBL_RESERVATION pending skip} {
$rsvdb query {delete from %s;} $tab
}
set fields [[rsv] cleanvars]
######################################################################
# Restore events
foreach line $data {
set vals [split $line "\t"]
if {[lindex $vals 0] ne "event"} continue
set vars {}
set i 0
foreach f $fields {
if {$ver < 2 && $f eq "aulEventToRecordInfo"} {
continue
}
incr i
set val [lindex $vals $i]
if {$f in $::binaryfields} {
set val [binary format H* $val]
}
lappend vars $f $val
}
# Don't restore DSO events.
if {$vars(ersvtype) == 11} continue
set rsv [rsv new $vars]
# Need to fix up channel and CRID mappings in case something
# has changed during a channel scan.
puts " Restoring [$rsv name] ([$rsv get szSvcName])"
set bad 0
# First, the service number
set ohsvc [$rsv get hsvc]
if {$ohsvc > 0} {
set hsvc [$rsv fix_hsvc]
if {$hsvc == 0} {
puts " Cannot find channel, restore failed."
set bad 1
} elseif {$hsvc != $ohsvc} {
puts -nonewline " Service number has "
puts "changed $ohsvc -> $hsvc, fixing."
} else {
puts " No change in channel service."
}
}
if {!$bad} {
# Need to fix up the AUL table service IDs too.
set newaul ""
foreach aul [$rsv aul] {
# {service start end event_id}
lassign $aul ohsvc start end eid
if {![dict exists $hsvcmap $ohsvc]} {
# Should not happen
puts " Losing AUL entry ($ohsvc)."
continue
}
set lcn 0
set channame $hsvcmap($ohsvc)
if {[dict exists $lcnmap $channame]} {
set lcn $lcnmap($channame)
}
# Find the new hsvc if possible.
set _hsvc [rsv find_hsvc $lcn $channame]
if {$_hsvc eq ""} continue
puts -nonewline " AUL $channame ($ohsvc"
if {$ohsvc != $_hsvc} {
puts -nonewline " -> $_hsvc"
}
puts ")"
append newaul [binary format iiii \
$_hsvc $start $end $eid]
}
$rsv setaul $newaul
}
if {!$bad} {
if {[catch {$rsv insert pending 1 1} msg]} {
puts " Error inserting event, $msg"
}
}
puts ""
}
######################################################################
# Restore skiplist
puts "Restoring skiplist..."
set fields "ulslot state service_id event_id hSvc start
ucCRIDType szCRID szSkipCRID"
foreach line $data {
set vals [lrange [lassign [split $line "\t"] key] 0 end-1]
if {$key ne "skip"} continue
lassign $vals {*}$fields
# Map old hSvc to new
if {![dict exists $hsvcmap $hSvc]} {
# Should not happen
puts " Losing skip entry ($hSvc)"
continue
}
set chan $hsvcmap($hSvc)
puts " Restoring skip for $chan - $szSkipCRID"
# Fetch new hSvc and service_id
set c [svc channel $chan]
if {$c == 0} {
puts " Cannot find channel"
continue
}
set _hsvc [$c get hSvc]
set _service_id [$c get usSvcId]
if {$_hsvc eq "" || $_service_id eq ""} {
puts " Cannot map channel name to service."
continue
}
if {$hSvc != $_hsvc || $service_id != $_service_id} {
puts -nonewline " Service number has changed "
puts "$hSvc -> $_hsvc, fixing."
lset vals [lsearch $fields hSvc] $_hsvc
lset vals [lsearch $fields service_id] $_service_id
}
catch {$rsvdb query "
insert into skip([join $fields ,]) values (
[join [lrepeat [llength $fields] "'%s'"] ,]
);
" {*}$vals}
}
######################################################################
# Restore favourites
puts "Restoring favourite channels..."
$rsvdb query {delete from channel.TBL_FAV}
$rsvdb query {drop table if exists pending.fav}
$rsvdb query {create table pending.fav (
favIdx integer primary key unique,
hSvc integer(4),
eFavGroup integer(4),
[eSvcType] integer(4)
)}
$rsvdb query {drop table if exists pending.favnames}
$rsvdb query {create table pending.favnames (
idx integer primary key unique,
name string
)}
set grp 0
set inc 0
set lastidx 1
foreach line $data {
set vals [split $line "\t"]
if {[lindex $vals 0] eq "favname"} {
lassign $vals x num x name
$rsvdb query {
insert into
pending.favnames(idx, name)
values(%s, '%s')
} $num $name
continue
}
if {[lindex $vals 0] ne "fav"} { continue }
lassign $vals x group type chan idx
if {$idx eq ""} {
# This is to support old format backup files where
# the favourite index is not present.
set idx 0
} else {
if {$idx eq "-"} {
set idx $lastidx
incr inc
}
set lastidx $idx
incr idx $inc
}
if {$grp != $group} {
set grp $group
if {[dict exists $favmap $grp]} {
puts " Group $favmap($grp)"
} else {
puts " Group $grp"
}
}
puts " $chan"
set c [svc channel $chan]
if {$c == 0} {
puts " Cannot map channel name to service."
continue
}
set hsvc [$c get hSvc]
if {$hsvc eq ""} {
puts " Cannot map channel name to service."
continue
}
$rsvdb query {
insert into
pending.fav(favIdx, hSvc, eFavGroup, eSvcType)
values(%s, %s, %s, %s);
} $idx $hsvc $group $type
}
system restartpending
close $fd
}
# Returns an array of expanded events from the schedule.
# Array keys:
# 0: start
# 1: end
# 2: hSvc
# 3: event_id
# 4: Schedule ID (sid)
# 5: ucRecKind
# 6: class (live, pending)
proc {rsv allevents} {{xota 0}} {
set events [rsv list]
set pending [rsv list pending]
if {[llength $pending]} {
lappend events {*}$pending
}
set today [midnight]
set xevents {}
foreach e $events {
set seen 0
if {[$e get ersvtype] > 4} continue
if {[$e get action] ne "0"} continue
if {[$e start] < $today} continue
if {$xota && [$e get szevtname] eq "Disable OTA"} continue
set trailer [list \
[$e get ulslot] \
[$e get ucRecKind] \
[$e get _table] \
]
# Expand the events encoded in the AUL data.
foreach a [$e aul] {
lassign $a service start end event_id
if {$start == [$e start] && \
$end == [$e end]} {
incr seen
}
lappend xevents [list $start $end $service $event_id \
{*}$trailer]
}
if {$seen} continue
set start [$e start]
set end [$e end]
lappend xevents [list $start $end \
[$e get hsvc] [$e get usevtid] {*}$trailer]
set repeat [$e get erepeat]
switch $repeat {
1 -
3 -
4 {
# 1 Daily
# 3 Weekends
# 4 Weekdays
for {set i 0} {$i < 8} {incr i} {
incr start 86400
incr end 86400
# Sun == 0
set day [clock format $start -format "%w"]
# Weekdays Only
if {$repeat == 3 && ($day == 0 || $day == 6)} {
continue
}
# Weekends Only
if {$repeat == 4 && $day != 0 && $day != 6} {
continue
}
lappend xevents [list \
$start $end \
[$e get hsvc] [$e get usevtid] \
{*}$trailer]
}
}
2 {
# Weekly
lappend xevents [list \
$($start + 7 * 86400) \
$($end + 7 * 86400) \
[$e get hsvc] [$e get usevtid] \
{*}$trailer]
}
}
}
return $xevents
}
proc {rsv evaluate_conflicts} {events type thresh {debug 0}} {
set conflicts {}
set slots {0 0}
foreach ev $events {
lassign $ev start end hsvc eid sid
if {$debug} {
puts "<br>\nSLOTS: $slots"
puts "$ev - "
}
# Close off any open slots that have now finished.
for {set i 0} {$i < 2} {incr i} {
set v [lindex $slots $i]
if {$v eq "0"} {
if {$debug} { puts "\[$i] empty." }
continue
}
lassign $v xsid xend
if {$start >= $xend} {
lset slots $i 0
if {$debug} { puts "\[$i] finished $xend." }
} else {
if {$debug} { puts "\[$i] running $xend." }
}
}
# Find slot for recording
if {[lindex $slots 0] eq "0"} {
set uslot 0
} elseif {$thresh > 1 && [lindex $slots 1] eq "0"} {
set uslot 1
} else {
# Conflict detected
if {$debug} { puts " Conflict." }
if {$type eq "xlist"} {
set c "$sid$end"
for {set i 0} {$i < 2} {incr i} {
set v [lindex $slots $i]
if {$v eq "0"} continue
lassign $v xsid xend
lappend c "$xsid$xend"
}
} else {
set c "$sid"
for {set i 0} {$i < 2} {incr i} {
set v [lindex $slots $i]
if {$v eq "0"} continue
lassign $v xsid xend
lappend c "$xsid"
}
}
foreach x $c {
if {![dict exists $conflicts $x]} {
set conflicts($x) $c
}
}
# If this events ends later than the
# existing one in slot 0, then replace that
# with this one.
lassign [lindex $slots 0] xsid xend
if {$xend >= $end} continue
if {$debug} { puts " Replacing slot 0.<br>\n" }
set uslot 0
}
if {$debug} { puts " -> into slot $uslot" }
# Insert event into slot
lset slots $uslot [list $sid $end]
}
return $conflicts
}
proc {rsv newconflicts} {{thresh 1} {type "list"} {debug 0}} {
set events [lsort -index 0 -integer [rsv allevents]]
set conflicts [rsv evaluate_conflicts $events $type $thresh $debug]
if {$debug} { puts "<br>\nConflicts: $conflicts" }
if {$type eq "map"} { return $conflicts }
return [dict keys $conflicts]
}
proc {rsv checkconflict} {s d thresh {debug 0}} {
set events [rsv allevents]
lappend events [list $s $($s + $d) 0 0 -1]
set events [lsort -index 0 -integer $events]
set conflicts [rsv evaluate_conflicts $events 'list' $thresh $debug]
if {$debug} { puts "<br>\nConflicts: $conflicts" }
set ret {}
if {![dict exists $conflicts "-1"]} { return $ret }
foreach c [dict get $conflicts -1] {
if {$c eq "-1"} continue
set s [rsv slot $c]
set s [$s name]
lappend ret $s
}
return $ret
}
proc {rsv clearskip} {slot {start 0}} {
set q "delete from skip where ulslot = $slot "
if {$start} {
append q "and start = $start"
}
catch { [rsv dbhandle] query $q }
}
proc {rsv _skiplist} {{ulslot -1}} {
set dbh [rsv dbhandle]
set q "select group_concat(hSvc || ':' || event_id, ' ')
as list from skip where state = 'live'"
if {$ulslot >= 0} {
append q " and ulslot = $ulslot"
}
lassign [$dbh query $q] ret
return $ret(list)
}
rsv method skiplist {} {
return [rsv _skiplist $ulslot]
}
proc {rsv reassert_skips} {{debug false}} {
set rsvdb [rsv dbhandle]
set changes 0
# Remove any expired skips
$rsvdb query "delete from skip where start < [clock seconds]"
foreach s [$rsvdb query {
select ulslot, szCRID, group_concat(szSkipCRID) as skiplist
from skip
where state = 'live' and ulslot >= 0
group by 1, 2
order by ulslot, start
}] {
if {$debug} { puts "\n--> SKIP: $s" }
if {![dict exists $s ulslot]} continue
if {[catch { set r [rsv slot $s(ulslot)] }]} continue
if {$r eq "0"} {
if {$debug} { puts "Slot no longer in schedule." }
rsv clearskip $s(ulslot)
continue
}
if {[$r get szCRID] ne $s(szCRID)} {
if {$debug} { puts "Slot now for different series." }
rsv clearskip $s(ulslot)
continue
}
#if {$debug} { require classdump; classdump $r }
set toskip [split $s(skiplist) ,]
set rsvskip [lmap i \
[lrange [split [$r get szRecordedProgCrid] |] 0 end-1] {
# Remove the initial CRID type
string range $i 1 end
}]
# Build list of events in rsvskip which are not in toskip.
# These are entries which have been added as episodes have
# recorded.
set recskip [lmap i $rsvskip {
if {$i in $toskip} continue
function $i
}]
# Build a new skip list consisting of:
# Upcoming skipped events (in start order)
# Other events from existing list (recorded events)
# Always allow space for two of the "other events" if they
# are present.
set others [llength $recskip]
if {$others > 2} { set others 2 }
set skiplist [lrange $toskip 0 $(5 - $others - 1)]
lappend skiplist {*}$recskip
# Truncate to 5 entries
set skiplist [lrange $skiplist 0 4]
if {$debug} {
puts "TOSKIP: $toskip"
puts "RSVSKIP: $rsvskip"
puts "RECSKIP: $recskip"
puts "SKIPLIST: $skiplist"
}
if {$skiplist eq $rsvskip} {
puts "Skip list already correct, nothing to do."
continue
}
set ev [rsv fetch pending [$r get ersvtype] \
[$r get hsvc] 0 [$r get usevtid] $s(szCRID)]
if {$ev ne "0"} {
if {$debug} { puts "Found pending entry, skipping." }
continue
}
# Apply the new skiplist.
$r clear_ulslot
$r replace_skip $skiplist
#if {$debug} { require classdump; classdump $r }
$r insert_deferred
puts "Applied new skip list."
incr changes
}
if {$changes} {
if {$debug} { puts "Committing changes..." }
rsv commit
}
}
Reference in New Issue View Git Blame Copy Permalink