webif/var/mongoose/lib/rsv.class

source /mod/webif/lib/setup

if {![exists -proc class]} { package require oo }
if {![exists -proc sqlite3.open]} { package require sqlite3 }
require settings.class system.class

set rsvdb [sqlite3.open /var/lib/humaxtv/rsv.db]
$rsvdb 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
}
$rsvdb query {attach database '/var/lib/humaxtv/rsvp.db' as pending}
# This is required to upgrade old tables and will be removed in a future
# version.
catch { $rsvdb query {alter table pending add column action int} }

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
}

require findhsvc

rsv method aul {} {
	if {![exists -proc binary]} { package require binary }
	set aul {}
	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
		catch {lappend aul [list $service $start $end $event_id]}
	}
	return $aul
}

rsv method clear_ulslot {} {
	set ulslot -1
}

rsv method isseries {} {
	if {$ucRecKind == 4} { return 1 } else { return 0 }
}

rsv method _strip {str} {
	if {[string range $str 1 2] eq "i7"} {
		set str [string range $str 3 end]
	}
	if {[string first "\025" $str] == 0} {
		set str [string range $str 1 end]
	}
	return $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 reminder ---" }
		    3 { set name "--- Unnamed 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 {} {
	if {$ulPreOffset > 0 || $ulPostOffset > 0} {
		return 1
	} else {
		return 0
	}
}

rsv method channel_name {} {
	return [string range $szSvcName 1 end]
}

rsv method icon {} {
	set rsvicon ""
	switch $ersvtype {
		1 { set rsvicon "175_1_00_Reservation_Watch.png" }
		2 { set rsvicon "175_1_00_Reservation_Watch.png" }
		3 { 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" }
	}
	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 "<- [expr $ulPreOffset / 60], [expr $ulPostOffset / 60] ->"
				lappend iconlist \
				    "<img src=/img/pad.png height=$height
				     title=\"$padding\" alt=\"$padding\">"
			} 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_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 remove_pending {} {
	$::rsvdb query "delete from pending where ulslot = $ulslot"
}

rsv method fix_hsvc {} {
	set _hsvc [get_channel_attr $szSvcName]
	if {$_hsvc eq ""} {
		set _hsvc [get_channel_attr_bylcn $usLcn]
	}
	set hsvc $_hsvc
}

rsv method insert {{table pending} {force 0}} {
	global rsvdb

	# Duplicate check - all tables
	if {!$force && $szCRID ne "" && $action == 0} {
		foreach tab {pending TBL_RESERVATION} {
			set rec [$rsvdb query "
				select ulslot from $tab
				where szCRID = '%s'
				and hsvc = '%s'
			" $szCRID $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 [lsort [$self vars]]

	foreach field {aulEventToRecordInfo 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 {}
	foreach field $fields {
		# Escape any quotes embedded in the data.
		regsub -all {'} [$self get $field] {''} f
		lappend vals "'$f'"
		#lappend vals "'[$self get $field]'"
	}

	set query "insert into ${table}("
	append query [join $fields ","]
	append query ") values("
	append query [join $vals ","]
	append query ");"

	$rsvdb query $query
}

proc {rsv list} {{table tbl_reservation} {extra ""}} {
	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 [$::rsvdb query $qstring]
	set records {}
	foreach rec $res {
		lappend records [rsv new $rec]
	}

	return $records
}

proc {rsv lookuptab} {} {
	set records {}
	foreach tab {tbl_reservation pending} {
		set res [$::rsvdb query "
			select usSvcId, usevtid, ucCRIDType, szCRID,
			    ucRecKind
			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("$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
			}
			set records([\
			    string tolower "$rec(usSvcId):$rec(szCRID)"]) $p
		}
	}

	return $records
}

proc {rsv xlookuptab} {} {
	set records {}
	foreach tab {tbl_reservation pending} {
		set res [$::rsvdb 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 [$::rsvdb 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 TBL_RESERVATION} ersvtype hsvc nsttime usevtid events} {
	set res [$::rsvdb 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 $table.ersvtype = '%s'
		and $table.hsvc = '%s'
		and $table.nsttime = '%s'
		and $table.usevtid = '%s'
		and $table.szEventToRecord = '%s'
	" $ersvtype $hsvc $nsttime $usevtid $events]

	if {[llength $res] > 0} {
		return [rsv new [lindex $res 0]]
	}
	return 0
}

proc {rsv slot} {{table TBL_RESERVATION} slot} {
	set res [$::rsvdb 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 cleanup} {} {
	catch {$::rsvdb close}
}

proc {rsv commit} {} {
	$::rsvdb query {begin transaction}
	foreach rec [rsv list pending] {
		if {[$rec get action] == 0} {
			$rec clear_ulslot
			$rec insert TBL_RESERVATION 1
		}
	}
	$::rsvdb query {delete from pending}
	$::rsvdb query {commit transaction}
}

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[$event get name]"
	set args(eReady)		30
	lassign [system padding] args(ulPreOffset) args(ulPostOffset)

	set ccrid [$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)|"
			# Handle split events
			if {[string match {*#?} $args(szCRID)]} {
				set args(ucRecKind)	2
				set args(szCRID) [
				    string range $args(szCRID) 0 end-2]
				# 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 progs [lmap i [epg fetch dump -scrid [$event get series_crid]] {
			if {[set ecrid [$i get event_crid]] eq ""} { continue }
			list "1$::ccrid$ecrid"
		}]
		set args(szEventToRecord)	 "[join $progs "|"]|"
	}

	return [rsv new $args]
}

proc {rsv backup} {file} {
	global rsvdb

	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 [lsort [[rsv] vars]]

	#puts $fd "# [join $fields "\t"]"

	foreach event $events {
		puts "  Backing up scheduled event '[$event name]'"
		puts -nonewline $fd "event\t"

		foreach f $fields {
			if {$f eq "aulEventToRecordInfo"} { continue }
			puts -nonewline $fd "[$event get $f]\t"
		}
		puts $fd ""
	}
	puts "Done."

	puts "Backing up channel favourites..."

	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)
			puts "  Group $grp"
		}
		puts "    $res(szSvcName)"
		puts $fd "fav\t$res(eFavGroup)\t$res(eSvcType)\t$res(szSvcName)\t$res(favIdx)"
	}
	puts "Done."

	close $fd
}

proc {rsv restore} {file} {
	global rsvdb

	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"
	}

	puts "Restoring scheduled events from <i>$file</i>..."

	$rsvdb query {begin transaction;}
	$rsvdb query {delete from TBL_RESERVATION;}

	set fields [lsort [[rsv] vars]]

	set data [split [read $fd] "\n"]

	foreach line $data {
		set vals [split $line "\t"]
		if {[lindex $vals 0] ne "event"} { continue }
		set vars {}
		set i 0
		foreach f $fields {
			if {$f eq "aulEventToRecordInfo"} { continue }
			incr i
			lappend vars $f [lindex $vals $i]
		}

		# 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]"

		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} {
			if {[catch {$rsv insert pending 1} msg]} {
				puts "    Error inserting event, $msg"
			}
		}
	}

	$rsvdb query {commit transaction;}

	puts "Restoring favourite channels..."
	$rsvdb query {begin transaction;}
	$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 autoincrement unique,
		hSvc integer(4),
		eFavGroup integer(4),
		[eSvcType] integer(4)
	)}

	set grp 0
	foreach line $data {
		set vals [split $line "\t"]
		if {[lindex $vals 0] ne "fav"} { continue }

		set group [lindex $vals 1]
		set type [lindex $vals 2]
		set chan [lindex $vals 3]
		set idx [lindex $vals 4]
		if {$idx eq ""} { set idx 0 }
		set hsvc [get_channel_attr $chan]

		if {$grp != $group} {
			set grp $group
			puts "  Group $grp"
		}

		puts "    $chan"

		if {$hsvc eq ""} {
			puts "        Cannot map channel name to service."
			continue
		}

		set query "
			insert into
			pending.fav(favIdx, hSvc, eFavGroup, eSvcType)
			values($idx, $hsvc, $group, $type);
		"

		$rsvdb query $query
	}

	$rsvdb query {commit transaction;}

	system restartpending

	close $fd
}