re-work skip behaviour

CONTROL/control

@@ -1,7 +1,7 @@
 Package: webif
 Priority: optional
 Section: web
-Version: 1.4.2-1
+Version: 1.4.2-2
 Architecture: mipsel
 Maintainer: af123@hpkg.tv
 Depends: tcpfix,webif-channelicons(>=1.1.25),lighttpd(>=1.4.39-1),jim(>=0.77),jim-oo(>=0.77),jim-sqlite3(>=0.77),jim-cgi(>=0.7-1),jim-binary(>=0.76),service-control(>=2.3),busybox(>=1.20.2-1),lsof(>=4.87),epg(>=1.2.6),hmt(>=2.0.10),ssmtp,cron-daemon(>=1.18.3-3),at(>=3.1.18),anacron,trm(>=1.1),openssl-command,nicesplice,id3v2,file,rsvsync(>=1.1.11),webif-charts(>=1.2-1),stripts(>=1.2.5-3),tmenu(>=1.21-2),ffmpeg(>=2.8),id3v2,multienv(>=1.6),tcpping(>=1.1),e2fsprogs,wireless-tools(>=29-1),dbupdate,recmon(>=2.0.7),hwctl,nugget(>=0.95),sqlite3(>=3.15.1),jim-xconv

webif/html/sched/list/index.jim

@@ -185,7 +185,8 @@ proc eventrow {event {table TBL_RESERVATION}} {
 			<span class=footnote>(Last: $ds)</span>"
 		puts "</td><td>--:--:--</td>"
 	} else {
-		set elist [$event aul true]
+		set elist [$event aul]
+		set skiplist [$event skiplist]
 		set ds "[clock format $s -format {%a %d %b %Y %H:%M}]"
 		puts "<td nowrap class=\"va"
 		if {$n > $e} { puts -nonewline " blood" }
@@ -244,6 +245,10 @@ proc eventrow {event {table TBL_RESERVATION}} {
 					append xcl " pinkshade"
 				}
 
+				if {"$service_id:$event_id" in $skiplist} {
+					append xcl " strike"
+				}
+
 				puts "<span class=\"$xcl\">"
 				if {$service_id in $svckeys} {
 				  puts "<a class=event href=#

webif/html/sched/rpc/info.jim

@@ -81,9 +81,9 @@ if {$crid != ""} {
 	[$event get szCRID]"
 	puts "</a></td></tr>"
 }
-puts "<tr><th>Events</th><td>"
+proc cridlist {events} {
 	set flag 0
-foreach ev [split [$event get szEventToRecord] "|"] {
+	foreach ev $events {
 		if {$ev eq ""} { continue }
 		set ev [string range $ev 1 end]
 		if {$flag} { puts "<br>" }
@@ -96,10 +96,14 @@ foreach ev [split [$event get szEventToRecord] "|"] {
 		    $ev"
 		puts "</a>"
 	}
+
+}
+puts "<tr><th>Events</th><td>"
+cridlist [split [$event get szEventToRecord] |]
+if {[$event get szRecordedProgCrid] ne ""} {
+	puts "<tr><th>Recorded events<br>(Skip List)</th><td>"
+	cridlist [split [$event get szRecordedProgCrid] |]
 	puts "</td></tr>"
-puts "<tr><th>Accepted</th><td>"
-if {[$event get aulEventToRecordInfo] ne ""} {
-	puts "Yes"
 }
 puts "</td></tr>"
 puts "</table>"

webif/html/sched/visual/index.jim

@@ -95,7 +95,7 @@ foreach p $pending {
 #      6:      class (live, pending)
 
 # Filter events array
-set skip [rsv skiplist]
+set skip [rsv _skiplist]
 if {[llength $skip]} {
 	set events [lmap i $events {
 		lassign $i x x s e

webif/lib/bin/skips

@@ -0,0 +1,7 @@
+#!/mod/bin/jimsh
+
+source /mod/webif/lib/setup
+require rsv.class
+
+rsv reassert_skips true
+

webif/lib/rsv.class

@@ -115,7 +115,7 @@ rsv method status {} {
 rsv method aul {{filter false}} {
 	set aul {}
 	set xaul {}
-	if {$filter} { set xaul [rsv skiplist $ulslot] }
+	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)]\
@@ -137,6 +137,17 @@ proc {rsv mkaul} {e} {
 	]
 }
 
+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
 }
@@ -327,7 +338,7 @@ rsv method set_refresh {} {
 	set aulEventToRecordInfo ""
 }
 
-rsv method set_skip {event {persist true}} {
+rsv method set_skip {event} {
 	set action 5
 
 	$event get_channel_info
@@ -343,7 +354,6 @@ rsv method set_skip {event {persist true}} {
 		set szRecordedProgCrid "1$crid|$szRecordedProgCrid"
 	}
 	set szEventToRecord [string map "1$crid| {}" $szEventToRecord]
-	if {$persist} {
 	catch {
 		[rsv dbhandle] query {
 			insert or ignore into skip
@@ -354,7 +364,6 @@ rsv method set_skip {event {persist true}} {
 		} -1 $ucCRIDType $szCRID $crid $service_id $event_id [\
 		  $event get start] $event_hsvc
 	}
-	}
 
 	set newaul ""
 	set next_event -1
@@ -392,7 +401,74 @@ rsv method set_skip {event {persist true}} {
 	}
 }
 
-rsv method apply_skip {service event {persist true}} {
+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
 
@@ -412,7 +488,7 @@ rsv method apply_skip {service event {persist true}} {
 		set ev $self
 		$ev clear_ulslot
 	}
-	$ev set_skip $epg $persist
+	$ev set_skip $epg
 	if {[catch {$ev insert_deferred} msg]} {
 		error "Error during insert."
         }
@@ -1320,13 +1396,15 @@ proc {rsv checkconflict} {s d thresh {debug 0}} {
 	return $ret
 }
 
-proc {rsv clearskip} {slot} {
+proc {rsv clearskip} {slot {start 0}} {
-	catch {
+	set q "delete from skip where ulslot = $slot "
-		[rsv dbhandle] query {delete from skip where ulslot = %s} $slot
+	if {$start} {
+		append q "and start = $start"
 	}
+	catch { [rsv dbhandle] query $q }
 }
 
-proc {rsv skiplist} {{ulslot -1}} {
+proc {rsv _skiplist} {{ulslot -1}} {
 	set dbh [rsv dbhandle]
 
 	set q "select group_concat(hSvc || ':' ||  event_id, ' ')
@@ -1338,59 +1416,97 @@ proc {rsv skiplist} {{ulslot -1}} {
 	return $ret(list)
 }
 
-proc {rsv reassert_skips} {} {
+rsv method skiplist {} {
-	set rsvdb [rsv dbhandle]
+	return [rsv _skiplist $ulslot]
+}
 
+proc {rsv reassert_skips} {{debug false}} {
+	set rsvdb [rsv dbhandle]
 	set changes 0
-	set now [clock seconds]
+
+	# Remove any expired skips
+	$rsvdb query "delete from skip where start < [clock seconds]"
+
 	foreach s [$rsvdb query {
-	    select * from skip
+	    select ulslot, szCRID, group_concat(szSkipCRID) as skiplist
+	    from skip
 	    where state = 'live' and ulslot >= 0
-	    order by ulslot, service_id, event_id
+	    group by 1, 2
+	    order by ulslot, start
 	}] {
+		if {$debug} { puts "\n--> SKIP: $s" }
 		if {![dict exists $s ulslot]} continue
-		set r [rsv slot $s(ulslot)]
+		if {[catch { set r [rsv slot $s(ulslot)] }]} continue
 		if {$r eq "0"} {
-			# Slot no longer exists.
+			if {$debug} { puts "Slot no longer in schedule." }
 			rsv clearskip $s(ulslot)
 			continue
 		}
 		if {[$r get szCRID] ne $s(szCRID)} {
-			# Slot is now for a different recording.
+			if {$debug} { puts "Slot now for different series." }
 			rsv clearskip $s(ulslot)
 			continue
 		}
 
-		if {$s(start) < $now} {
+		#if {$debug} { require classdump; classdump $r }
-			# Recording time passed
+
-			rsv clearskip $s(ulslot)
+		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
 		}
 
-		if {[$r get usevtid] != $s(event_id) &&
+		set ev [rsv fetch pending [$r get ersvtype] \
-		    $s(start) > $now + 86400} {
+		     [$r get hsvc] 0 [$r get usevtid] $s(szCRID)]
+		if {$ev ne "0"} {
+			if {$debug} { puts "Found pending entry, skipping." }
 			continue
 		}
 
-		#puts "S: $s"
+		# Apply the new skiplist.
-		#require classdump; classdump $r
+		$r clear_ulslot
-
+		$r replace_skip $skiplist
-		if {"1$s(szSkipCRID)" in [\
+		#if {$debug} { require classdump; classdump $r }
-		    split [$r get szRecordedProgCrid] "|"]} {
+		$r insert_deferred
-			puts "Skip already in place."
+		puts "Applied new skip list."
-			continue
-		}
-		# Need to re-assert skip.
-		if {[catch {$r apply_skip $s(service_id) $s(event_id) false} \
-		    msg]} {
-			puts $msg
-		} else {
-			puts "Re-applied skip."
 		incr changes
 	}
-	}
 	if {$changes} {
-		puts "Commit."
+		if {$debug} { puts "Committing changes..." }
 		rsv commit
 	}
 }