#!/tvbin/tivosh
#
#  Copyright 2002 G.R. Souther
#
# Version 1.11
#
# Version History
#
# version 1.11 - Dropped procedure html_form_checkbox, as a version
#   is included in tivoweb v.1.9.4 beta 4. This version will work with
#   v.1.9.4 beta 4, but will not work in prior versions of tivoweb.
#
# version 1.1 - Changes save/restore channel map to use sub-lineup
#   and channel short name as opposed to fsid-s, which can not
#   work properly after tivo changes the lineup. This version will
#		work in versions after 1.9.4 beta 3 and prior.  It will also 
#   work with v.1.9.4 beta 4 and beyond, but will break other tivoweb
#		functions.
#
# Numerous older versions exist
#
# Tivo SW v 2.5.1, 3.0

source /tvlib/tcl/tv/mfslib.tcl

if {[MfsFileExists /Headend] && $::version <= 3} {

proc action_BACdisplay {chan path env} {

  # Display a page with lineups, and checkboxes
  # All "Active" channels will have their channel numbers reset to the
  # channel numbers in the selected lineups.  No changes are made to channels
  # which don't exist in the checked lineups.
  #
  # This is part of what happens when you select a "master" lineup in the setup screen.
  # Doing it this way does NOT clear channels you watch, etc.  No channels are created,
  # or deleted.  Only the channel number is changed.

  global ChannelInfo
  global LineUpNames
  global ActiveChannels

  listchannels

  puts $chan [html_start "Commit Changes to Active Master Lineup"]
  puts $chan [html_form_start "POST" "/BuildActiveChannels/"]
  puts $chan [html_table_start "" "Select Sub-Lineups to Use" "COLSPAN=2"]
  set LineupNumber 1
  foreach Lineup $LineUpNames {
    puts $chan [tr "" [td "COLSPAN=2" "<INPUT NAME='L$LineupNumber' TYPE='checkbox' CHECKED> $Lineup"]]
    incr LineupNumber
  }
  puts $chan [html_table_end]
  puts $chan [html_form_input "submit" "BuildActiveChannels" "Commit Changes"]

}

proc action_BuildActiveChannels {chan path env} {
  
  # This will take all the channels in the lineups passed via CGI
  # and set the channel number in the "active channel list" channel object
  # to the channel in the "lineup" channel object
  
  global ChannelInfo
  global LineUpNames
  
  listchannels
  
  eval $env
  
  puts $chan [html_start "Commit Results"]
  
  set LineupNumber 1
  foreach Lineup $LineUpNames {
    set ProcessLineup [info exists L$LineupNumber]
    if {$ProcessLineup} {
      lappend LineUpsToUse $Lineup
    }
    incr LineupNumber
  }
  
  if {![info exists LineUpsToUse]} {
    puts $chan "<B> Failure - I'm not a mind reader</B>"
    return
  }
  
  BuildActiveChannelList
  
  set GotOne 0
  set failure 0
  foreach chaninfo $ChannelInfo {
    set ThisChannelsLineup [lindex $chaninfo 2]
    if {[lsearch $LineUpsToUse $ThisChannelsLineup]!=-1} {
      set channelnumber [lindex $chaninfo 1]
      set channelname [lindex $chaninfo 0]
      set channellongname [lindex $chaninfo 5]
      
      set activechan [ActiveChannelInfo $channelname $channellongname]
      set CurrentNumber [lindex $activechan 2]
      set object [lindex $activechan 3]
      if {$CurrentNumber!=$channelnumber} {
        puts $chan "Applying change for [lindex $chaninfo 0] [lindex $chaninfo 1] (Was $CurrentNumber) object $object<br>"
        set GotOne 1
        set result [changenum $object $channelnumber "Applying"]
        if {$result!=1} {
          set failure 1
        }
      }
    }
  }
  
  if {!$GotOne} {
    puts $chan "<B>To me it doesn't look like there is anything to change</B>"
  } elseif {!$failure} {
    puts $chan "<B>All channel changes applied</B>"
  } else {
    puts $chan "<B>Some changes failed!</B>"
  }
  
}


proc BuildActiveChannelList {} {
  
  # Build global of "active" channels
  
  global ActiveChannels
  
  if {[info exists ActiveChannels]==1} {
    unset ActiveChannels
  }
  
  RetryTransaction {
    set db [dbopen]
  }
  
  set ChannelsPerPass 25
  set keepgoin 1
  set start 0
  set end [expr $start+$ChannelsPerPass]
  while {$keepgoin} {
    RetryTransaction {
      set setup [db $db open /Setup]
      set source [dbobj $setup get Source]
      set channels [dbobj [lindex $source 0] get Channel]
      set nchannels [llength $channels]
      for {set i $start} {$i<$end} {incr i} {
        
        if {$i == $nchannels} {
          return -1
        }
        
        set channel [lindex $channels $i]
        set channelfsid [dbobj $channel fsid] 
        set channelsubobjid [dbobj $channel subobjid]
        set sobj [dbobj $channel get Station]
        set cname [lindex [dbobj $sobj get Name] 0]
        set snumber [dbobj $channel get Number]
        set channelname [dbobj $sobj get CallSign]
        set channellist [list $channelname $cname $snumber $channelfsid/$channelsubobjid]
        lappend ActiveChannels $channellist
      }
    }
    
    set start [expr $start+$ChannelsPerPass]
    set end [expr $start+$ChannelsPerPass]
    
  }
  dbclose $db
}


proc ActiveChannelInfo {TheChannelName TheChannelLongName} {
  
  global ActiveChannels
  
  foreach chaninfo $ActiveChannels {
    set channelname [lindex $chaninfo 0]
    set channellongname [lindex $chaninfo 1]
    
    # Need to test both short and long name - Channels names "Pay Per View" all over
    
    if {[string compare $TheChannelName $channelname]==0} {
      if {[string compare $TheChannelLongName $channellongname]==0} {
        return $chaninfo
      }
    }
  }
}
proc action_RestoreChannelMap {chan path env} {
  
  set directory [file dirname [info script]]
  set ScriptFile $directory/ChannelMapScript.tcl
  catch {exec /tvbin/tivosh $ScriptFile > /tmp/CMS.out}
  puts "Loading channel map from backup - Individual Transaction will not appear here."
  action_listchan $chan "/" "set ReturnString \[h1 \"It is Done - Commit the changes to make them Active\"\]"
  
}

proc action_RestoreChannelMapVerify {chan path env} {
  
  puts $chan [html_start "Verify Restore"]
  puts $chan [h1 "Warning"]
  puts $chan "This will change all the channel number mappings in every sublineup<br>"
  puts $chan "to however they were set the last time you saved the Channel Map.<br>"
  puts $chan "<br>"
  puts $chan [h1 "Make CERTAIN you know whats saved<br>"]
  puts $chan [h1 "Are you SURE you want to do this?<br>"]
  puts $chan [html_form_start "POST" "/RestoreChannelMap/"]
  puts $chan [html_form_input "submit" "RestoreChannelMapVerify" "Yes, I'm POSITIVE, Restore Channel Map from Saved"]
  puts $chan [h1 "Be Patient! It takes about a MINUTE per 100 channels <br>"]
}

proc action_SaveChannelMap {chan path env} {
  
  set pathname [writescript]
  action_listchan $chan "/" "set ReturnString \"Script has been written to $pathname\""
  
}

proc action_saveremap {chan path env} {
  
  # cgi to make the database changes to remap a channel when remap button is pressed
  # tries to do basic validation of channel number
  
  eval $env
  
  # Remember if we should return to the same page
  
  set ReturnToChanList [expr [info exists stayonpage]==0 ]
  
  # Check for the magic channel number to write the channel remap script
  
  if {[string compare $Number "***"]==0} {
    puts "AhHa! Someone has been looking at the code!"
    set pathname [writescript]
    action_listchan $chan "/" "set ReturnString \"Script has been written to $pathname\""
    return
  }
  
  # Determine if there are non-numerics in the channel number provided
  # No "string is integer" construct in Tivo TCL - do it manually
  
  set ChanLength [string length $Number]
  set StringIsNumber 1
  try {
    if {$ChanLength > 0} {
      for {set i 0} {$i < [string length $Number]} {incr i} {
        set ChanChar [string range $Number $i $i]
        if {[expr $ChanChar<"0"] || [expr $ChanChar>"9"]} {
          set StringIsNumber 0
        }
      }
    } else {
      set StringIsNumber 0
    }
  } catch errormessage {
    
    # Assume any error is bad data
    
    set StringIsNumber 0
  }
  
  # Additionally, accept on numbers 1-999
  
  try {
    if {[expr $Number<1] || [expr $Number>999]} {
      set StringIsNumber 0
    }
  } catch errormessage {
    set StringIsNumber 0
  }
  
  RetryTransaction {
    set db [dbopen]
  }
  
  # Getting ready to change the database - double check! Lookup the callsign of this object
  
  RetryTransaction {
    set scanresult [scan $Channel {%[0-9]%[/]%[0-9-]} fsid slash subobjid]
    set malformedobject [expr $scanresult!=3]
    set ChannelObj [db $db openidconstruction $fsid $subobjid]
    set ChannelNum	[dbobj $ChannelObj get Number]
    set StationObj [dbobj $ChannelObj get Station]
    set StationCallSign [dbobj $StationObj get CallSign]
  }
  
  dbclose $db
  
  # If we got a bad channel number, return with an error
  # If we got a good channel number, remap the channel
  
  if {$StringIsNumber == 0} {
    set ReturnString "Invalid Channel Number<br>"
    set remaplink "/"
    append remaplink $Channel "-" $ChannelNum
    set cgistring "set Lineup \"$Lineup\"; set ReturnString \"$ReturnString\" "
    if {!$ReturnToChanList} {
      append cgistring "; set \"stayonpage\" \"1\""
    }
    action_remapchan $chan $remaplink $cgistring
    return
  } else {
    try {
      if {$malformedobject} {
        set ReturnString "Channel Object was malformed.  This can't happen, but it did!"
      } else {
        set result [changenum $Channel $Number "Changing"]
        if {$result==1} {
          set chanlink "/object/"
          append chanlink $Channel
          set ChannelObjectStringLink [format "<A HREF =\\\"/object/%s\\\">%s</A>" $Channel $Channel]
          set ReturnString [format "%s (%s)  remapped to channel %s<br>" $StationCallSign $ChannelObjectStringLink $Number]
        } else {
          set ReturnString "Channel Found but remap call returned an error<br>"
        }
      }
    } catch errormessage {
      puts $errormessage
      set ReturnString "Channel Found but remap call failed<br>"
    }
  }
  
  # If the check box on the remap page is checked, return to that page
  
  if {$ReturnToChanList} {
    action_listchan $chan "/" "set ReturnString \"$ReturnString\""
    return
  } else {
    set CGIString "set Lineup \"$Lineup\"; set ReturnString \"$ReturnString\"; set CGIChannel \"$Channel\"; set \"stayonpage\" \"1\""
    eval $CGIString
    action_remapchan $chan "/" $CGIString
    return
  }
  
}

proc action_remapchan {chan path env} {
  
  # Displays HTML page with a list of station callsigns and a box
  # to enter a new station number.  A checkbox is provided to return to
  # this page after remapping as opposed to the main channel list
  # This makes it faster to remap several channels
  # The channel list and text box will default to the channel provided
  # on the link if one is provided
  
  global ChannelInfo
  global LineUpNames
  
  eval $env
  
  # Set a few booleans that define how we got here, and the environment
  
  set HaveCGIChannel [expr [info exists CGIChannel]]
  set ReturnToPageChecked [expr [info exists stayonpage]==1]
  set HaveRetString [expr [info exists ReturnString]==1 ]
  set HaveCGILineup [expr [info exists Lineup]==1]
  
  # Look for Default channel on link, if there is one. 
  # This is how we preset channel info from the links on the channel map page
  
  if {[string length $path] > 1} {
    set paramlist [split [string range $path 1 end] "-"]
    set StartChannel [lindex $paramlist 0]
    set StartChannelNum [lindex $paramlist 1]
  }
  
  # Generate the channel information globals ChannelInfo and LineUpNames
  
  listchannels
  
  # Sort the LineUpNames and add an "All Channels" lineup
  
  set LineUpNamesSorted [lsort -ascii -increasing -index 0 $LineUpNames]
  set LineUpNamesSorted [linsert $LineUpNamesSorted 0 "All Channels"]
  
  # Sort Channels by Name
  
  set ChannelInfoSorted [lsort -ascii -increasing -index 0 $ChannelInfo]
  
  # If the call is from a link (not CGI) then we don't know the lineup that goes
  # with this channel.  Look it up.
  
  if {!$HaveCGILineup} {
    foreach chaninfo $ChannelInfoSorted {
      if {[string compare [lindex $chaninfo 4] $StartChannel]==0} {
        set Lineup [lindex $chaninfo 2]
      }
    }
  }
  
  # If we didn't find the channel to map, default to All Channels/First Channel
  # This shouldn't ever happen, but has been been observed when tivoweb seems
  # unstable. (Or if a bogus channel object is provided on a link)
  
  set FoundChannel [expr [info exists Lineup]==1]
  if {!$FoundChannel} {
    set StartChannel [lindex [lindex $ChannelInfoSorted 0] 0]
    set StartChannelNum [lindex [lindex $ChannelInfoSorted 0] 1]
    set Lineup [lindex $LineUpNamesSorted 0]
  }
  
  # Start the page header, prepare to build the javascript
  
  puts $chan [html_start "Remap Channels"]
  puts $chan "<SCRIPT LANGUAGE=\"JavaScript\">"
  
  # Build javascript arrays corresponding to the pulldowns/channel numbers 
  
  puts $chan "channels = new Array("
  
  set GetAllChannels [expr [string compare $Lineup "All Channels"]==0] 
  set FoundCGIChannel 0
  set FirstLineupPass 1
  foreach ThisLineup $LineUpNamesSorted {
    if {!$FirstLineupPass} {
      puts $chan ","
    } else {
      puts ""
    }
    puts $chan "new Array("
    set FirstChannelInLineup 1
    foreach chaninfo $ChannelInfoSorted {
      set LineupMatch [expr [string compare [lindex $chaninfo 2] $ThisLineup]==0]
      if {$LineupMatch || $FirstLineupPass} {
        set channame [lindex $chaninfo 0]
        set chanobj [lindex $chaninfo 4]
        set channum [lindex $chaninfo 1]
        if {!$FirstChannelInLineup} {
          puts $chan ","
        }
        set FirstChannelInLineup 0
        puts -nonewline $chan "new Array(\"$channame\",\"$chanobj\",\"$channum\")"
      }
    }
    set FirstLineupPass 0
    puts $chan ""
    puts -nonewline $chan ")"
  }
  puts $chan ""
  puts $chan ");"
  
  # The gnarly part, write out a couple of javascript functions to change the pulldowns
  # and channel number, locally to the browser, without hitting the tivo.  (efficiency!)
  
  puts $chan "function setChannelNumber(item, lineup, channel, channels) \{"
  puts $chan "item.value = channels\[lineup\]\[channel\]\[2\]"
  puts $chan "\}"
  puts $chan "function fillSelectFromArray(numberbox, selectCtrl, itemArray, goodPrompt, badPrompt, defaultItem) \{"
  puts $chan "var i, j;"
  puts $chan "var prompt;"
  #puts $chan "// empty existing items"
  puts $chan "for (i = selectCtrl.options.length; i >= 0; i--) \{"
  puts $chan "selectCtrl.options\[i\] = null; "
  puts $chan "\}"
  puts $chan "prompt = (itemArray != null) ? goodPrompt : badPrompt;"
  puts $chan "if (prompt == null) \{"
  puts $chan "j = 0;"
  puts $chan "\}"
  puts $chan "else \{"
  puts $chan "selectCtrl.options\[0\] = new Option(prompt);"
  puts $chan "j = 1;"
  puts $chan "\}"
  puts $chan "if (itemArray != null) \{"
  puts $chan "// add new items"
  puts $chan "for (i = 0; i < itemArray.length; i++) \{"
  puts $chan "selectCtrl.options\[j\] = new Option(itemArray\[i\]\[0\]);"
  puts $chan "if (itemArray\[i\]\[1\] != null) \{"
  puts $chan "selectCtrl.options\[j\].value = itemArray\[i\]\[1\]; "
  puts $chan "\}"
  puts $chan "j++;"
  puts $chan "\}"
  puts $chan "// select first item (prompt) for sub list"
  puts $chan "selectCtrl.options\[0\].selected = true;"
  puts $chan "numberbox.value = itemArray\[0\]\[2\];"
  puts $chan "\}"
  puts $chan "\}"
  puts $chan "</script>"
  
  # Make a list of channels in the current lineup, for the initial channel pulldown
  # If we just remapped a channel, we have that channel in CGIchannel.  Look
  # for its index, for use in the next section.
  
  set GetAllChannels [expr [string compare $Lineup "All Channels"]==0] 
  set FoundCGIChannel 0
  foreach chaninfo $ChannelInfoSorted {
    set LineupMatch [expr [string compare [lindex $chaninfo 2] $Lineup]==0]
    if {$LineupMatch || $GetAllChannels} {
      lappend ChannelNames [lindex $chaninfo 0]
      lappend ChannelObjFsid [lindex $chaninfo 4]
      lappend ChannelNumbers [lindex $chaninfo 1]
      if {$HaveCGIChannel} {
        if {[string compare [lindex $chaninfo 4] $CGIChannel]==0} {
          set StartChannelInfo $chaninfo
          set FoundCGIChannel 1
        }
      }
    }
  }
  
  # If we just remapped a channel, and found that channel in this Lineup
  # default the station pulldown to the next channel in lineup. (include wrap around from bottom)
  # If we don't have the channel via CGI, we got it on the link. If we don't
  # find the channel provided on the link, just default to the All channels page,
  # and give a warning.  This is most likely caused by bogus information 
  # provided on the remap link.
  
  if {$FoundCGIChannel} {
    set ix [lsearch $ChannelObjFsid [lindex $StartChannelInfo 4]]
    if {[expr $ix+1==[llength $ChannelObjFsid]]} {
      set ix 0
    } else {
      incr ix
    }
    set StartChannelName [lindex $ChannelNames $ix]
    set StartChannel [lindex $ChannelObjFsid $ix]
    set StartChannelNum [lindex $ChannelNumbers $ix]
  } else {
    if {!$FoundChannel} {
      puts $chan [h2 "Can't find that channel... Bad link?"]
    }
  }
  
  # If we have a channel from the link or CGI (and found it!), we have a default channel
  
  set HaveDefaultChannel [expr $FoundChannel || $FoundCGIChannel]
  
  # Start the form, and give a return message (remap complete, invalid channel number, etc..)
  
  puts $chan [html_table_start "" "" "ALIGN=TOP"]
  puts $chan [html_form_start "POST" "/saveremap/"]
  if {$HaveRetString} {
    puts $chan [h2 "<br> $ReturnString"]
    puts $chan "<br>"
  }
  
  # deprecated by javascript
  #puts $chan [html_form_input "submit" "Go" "Go"]
  
  # Create Lineup Pulldown
  
  puts $chan "<br>"
  puts $chan [h1 "Edit Channel Map for a given Sub-lineup"]
  puts $chan "In Lineup: "
  set OnChange "fillSelectFromArray(this.form.Number, this.form.Channel,((this.selectedIndex == -1) ? null : channels\[this.selectedIndex\]));"
  puts $chan [html_form_select_change "Lineup" $OnChange $LineUpNamesSorted $LineUpNamesSorted $Lineup]
  
  # Create Channel Pulldown
  
  puts $chan "Change "
  set OnChange "setChannelNumber(this.form.Number, this.form.Lineup.selectedIndex, this.selectedIndex, channels);"
  if {$HaveDefaultChannel} {
    puts $chan [html_form_select_change "Channel" $OnChange $ChannelObjFsid $ChannelNames $StartChannel]
  } else {
    puts $chan [html_form_select_change "Channel" $OnChange $ChannelObjFsid $ChannelNames [lindex $ChannelObjFsid 0]]
  }
  
  # Create Channel number entry box
  
  puts $chan "To Channel:"
  if {$HaveDefaultChannel} {
    puts $chan [html_form_text 1 3 "Number" $StartChannelNum]
  } else {
    puts $chan [html_form_text 1 3 "Number" [lindex $ChannelNumbers 0]]
  }
  
  # Create return to this page checkbox
  #
  #The following call doesn't exist in the library.  Could do it with html_form_input,
  #but not with the ability to have the box prechecked.  Just do it manually.
  #
  # Edit - Call exists as of tivoweb 1.9.4
  
  puts $chan "  Return To This Page"
  
  # This is a bit of overkill, since we never get here if the box wasn't checked,
  # but its more robust - in case page functionality changes
  
  if {$ReturnToPageChecked} {
    puts $chan [html_form_checkbox "stayonpage" "1"]
  } else {
    puts $chan [html_form_checkbox "stayonpage" ""]
  }
  
  # Finish the page with a Remap button
  
  puts $chan "<br>"
  puts $chan [html_form_input "submit" "Remap" "Remap"]
  puts $chan [html_form_end]
  
  puts $chan [html_end]
  
}

proc action_ButtonDriver {chan path env} {
  
  eval $env
  if {[info exists MapLineups]} {
    action_BACdisplay $chan $path $env
  } elseif {[info exists SaveChannelMap]} {
    action_SaveChannelMap $chan $path $env
  } elseif {[info exists RestoreChannelMapVerify]} {
    action_RestoreChannelMapVerify $chan $path $env
  }
  
}

proc action_listchan {chan path env} {
  
  # Main driver HTML page
  # Build HTML page listing all channels with
  # callsign, stationname, lineup name, and database id
  # the callsign links to a channel remap page
  # the database id links to a display of the db object
  # Headings for the columns provide sort by column capability
  
  global ChannelInfo
  global LineUpNames
  
  eval $env
  
  # Remember if we have a return message for the beginning of the page
  
  set HaveRetString [expr [info exists ReturnString]==1 ]
  
  # determine what column to sort the page by
  
  set sortfield 0
  if {[string length $path] > 1} {
    set sortfield [string range $path 1 1]
  }
  
  # Generate channel information globals
  
  listchannels 
  
  # Sort - If its the channel number, its an integer sort, otherwise ascii
  
  if {$sortfield == 1} {
    set ChannelInfoSorted [lsort -real -increasing -index $sortfield $ChannelInfo]
  } else {
    set ChannelInfoSorted [lsort -ascii -increasing -index $sortfield $ChannelInfo]
  }
  
  # Start the page, output the return message, if any
  
  puts $chan [html_start "List Channels"]
  if {$HaveRetString} {
    puts $chan [h2 "<br> $ReturnString <br>"]
  }
  #puts $chan [html_form_start "POST" "/BACdisplay/"]
  puts $chan [html_form_start "POST" "/ButtonDriver/"]
  puts $chan [html_form_input "submit" "MapLineups" "Commit Changes to Active Channels List"]
  puts $chan [html_form_input "submit" "SaveChannelMap" "Save Current Channel State"]
  puts $chan [html_form_input "submit" "RestoreChannelMapVerify" "Restore Channel Map from Saved"]
  puts $chan [html_form_end]
  puts $chan [html_table_start "" "" "ALIGN=TOP"]
  
  # Column headers, links to sort by this column
  
  puts $chan [tr "" [th [html_link "/listchan/0" "Channel"]] \
                [th [html_link "/listchan/1" "Number"]] \
                [th [html_link "/listchan/2" "Lineup"]] \
                [th [html_link "/listchan/4" "Channel Object"]] \
                [th [html_link "/listchan/3" "Station Object"]] ]
  
  # Fill in the columns for each channel
  # The channel name links to the remap channel page
  # Channel number and lineup are informational
  # Channel and station objects are links to display that object
  
  foreach chaninfo $ChannelInfoSorted {
    set remaplink "/remapchan/" 
    append remaplink [lindex $chaninfo 4] "-" [lindex $chaninfo 1]
    set objectlink "/object/"
    
    set stationobjectlink $objectlink
    append stationobjectlink [lindex $chaninfo 3]
    
    set ChannelObjectString [lindex $chaninfo 4]
    set channelobjectlink $objectlink
    append channelobjectlink $ChannelObjectString
    
    puts $chan [tr "" [td [html_link $remaplink [lindex $chaninfo 0]]] \
                  [td [lindex $chaninfo 1]] \
                  [td [lindex $chaninfo 2]] \
                  [td [html_link $channelobjectlink  $ChannelObjectString] ] \
                  [td [html_link $stationobjectlink  [lindex $chaninfo 3]] ] ]
  }
  
  puts -nonewline $chan [html_table_end]
  puts $chan [html_end]
  
}

proc listchannels {} {
  
  # Build global ChannelInfo and LineUpNames for all channels in every lineup.
  # (duplicate channels possible and correct!!!)
  
  global ChannelInfo
  global LineUpNames
  
  # Clear out anything left over from a previous call. Since we don't know if the
  # previous call was done seconds, days, weeks or months ago, this is the safest way
  
  if {[info exists ChannelInfo]==1} {
    unset ChannelInfo
  }
  
  if {[info exists LineUpNames]==1} {
    unset LineUpNames
  }
  
  set db [dbopen]
  
  # Get the number of lineups
  
  RetryTransaction {
    
    set setup [db $db open /Setup]
    set source [dbobj $setup get Source]
    set headend [dbobj [lindex $source 0] get Headend]
    set lineups [dbobj $headend get Lineup]
    set numberoflineups [llength $lineups]
  }
  
  # Get the number of channels per lineup, and lineup names
  
  for {set i 0} {$i < $numberoflineups} {incr i} {
    RetryTransaction {
      set setup [db $db open /Setup]
      set source [dbobj $setup get Source]
      set headend [dbobj [lindex $source 0] get Headend]
      set lineups [dbobj $headend get Lineup]
      set ThisLineup [lindex $lineups $i]
      set lineupname [dbobj $ThisLineup get Name]
      set TheseChannels [dbobj $ThisLineup get Channel]
      set numberofchannels [llength $TheseChannels]
      lappend LineUpNames [lindex $lineupname 0]
      lappend NumChannelsInLineup $numberofchannels
    }
  }
  
  for {set i 0} {$i < $numberoflineups} {incr i} {
    
    #			USER CUSTOMIZATION AREA
    #
    #			Customize ChannelsPerPass for efficiency.  Higher is better, but too high will cause
    #			database lookups to fail.  The empirically determined maximum is in the 50-60 range.
    #			Anything approaching this number will likely fail occasionally.
    #			If you get errors, make it smaller.
    
    set ChannelsPerPass 25
    set NumberOfPasses [expr ([lindex $NumChannelsInLineup $i]-1)/$ChannelsPerPass+1]
    set lineupname [lindex $LineUpNames $i]
    
    for {set pass 0} {$pass < $NumberOfPasses} {incr pass} {
      RetryTransaction {
        
        #					Get the channels in the lineup again and again and again
        
        set setup [db $db open /Setup]
        set source [dbobj $setup get Source]
        set headend [dbobj [lindex $source 0] get Headend]
        set lineups [dbobj $headend get Lineup]
        set ThisLineup [lindex $lineups $i] 
        set TheseChannels [dbobj $ThisLineup get Channel]
        
        #					Process the channels "ChannelsPerPass" at a time
        
        for {set j 0}	{$j < $ChannelsPerPass} {incr j} {
          set index [expr $pass*$ChannelsPerPass+$j]
          
          listchannel $db [lindex $TheseChannels $index] $lineupname
          
          #						get us out if we have exhausted the channels in this lineup
          
          if {[expr $index==[lindex $NumChannelsInLineup $i]-1]} {
            set j $ChannelsPerPass
          }
          
        }
      }
    }
  }
  
  dbclose $db
}

proc listchannel {db channel lineupname} {
  
  # Add channel to global ChannelInfo
  
  global ChannelInfo
  try {
    set channelnumber [dbobj $channel get Number]
    set channelfsid [dbobj $channel fsid]
    set channelsubobjid [dbobj $channel subobjid]
    set stationptr [dbobj $channel gettarget Station]
    scan $stationptr {%[0-9]%[/]%[0-9-]} firstid slash secondid
    set stationobj [db $db openidconstruction $firstid $secondid]
    set callsign [dbobj $stationobj get CallSign]
    set stationlongname [lindex [dbobj $stationobj get Name] 0]
    set chaninfo [list $callsign $channelnumber $lineupname $stationptr $channelfsid/$channelsubobjid $stationlongname]
    lappend ChannelInfo $chaninfo
  } catch errormessage {
    puts $errormessage
  }
}

proc writescript {} {
  
  # write out a shell script that sets all the channel numbers to the current configuration
  
  global ChannelInfo
  global LineUpNames
  
  set directory [file dirname [info script]]
  set modulename "$directory/modules/ChannelMap.itcl"
  set ScriptPath "$directory/ChannelMapScript.tcl"
  
  if [catch {open $ScriptPath w 0755} script] {
    return "-NOWHERE! error opening $ScriptPath"
  }
  
  puts $script "#!/tvbin/tivosh"
  puts $script "source /tvlib/tcl/tv/mfslib.tcl"
  puts $script "proc register_module \{one two three \} \{"
  puts $script "\}"
  puts $script "proc html_start \{one\} \{"
  puts $script "\}"
  puts $script "source $modulename"
  listchannels
  set ChannelInfoSorted [lsort -ascii -increasing -index 0 $ChannelInfo]
  foreach chaninfo $ChannelInfoSorted {
    #		set Object [lindex $chaninfo 4]
    set LineupName [lindex $chaninfo 2]
    set ChannelNum [lindex $chaninfo 1]
    set ChannelName [lindex $chaninfo 0]
    puts $script "ChangeByNameAndLineup \"$ChannelName\" \"$LineupName\" \"$ChannelNum\""
  }
  set i 1
  puts $script " "
  puts $script "# If you want this script to commit these changes to the active channels"
  puts $script "# Delete the lines below refering to the sub-lineups which you are NOT using"
  puts $script "# And uncomment the last line"
  puts $script " "
  foreach lineup $LineUpNames {
    puts  $script "append fakeenv \"set L$i \\\"$lineup\\\";\""
    incr i
  }
  puts $script " "
  puts $script "#action_BuildActiveChannels stdout \"/\" \$fakeenv"
  close $script 
  return $ScriptPath
}

proc ChangeByNameAndLineup {channelname lineup channelnumber} {
  
  global ChannelInfo
  global LineUpNames
  
  if {![info exists ChannelInfo]} {
    listchannels
  }
  
  foreach chaninfo $ChannelInfo {
    set cname [lindex $chaninfo 0]
    if {$channelname==$cname} {
      set lname [lindex $chaninfo 2]
      if {$lineup==$lname} {
        set chanobj [lindex $chaninfo 4]
        set result [changenum $chanobj $channelnumber "Changing"]
        break
      }
    }
  }
}

proc ChangeChannelVerify {resid newnum channelname} {
  
  # Sets the channel number in a channel object, IFF the station pointed
  # to by this channel is the same as the station name on the call.  A
  # reasonable double check, as this is called by a shell script
  
  
  # Very strange but if this dbopen call is in a RetryTransaction, tivosh
  # dies miserably, TMK asserts.  
  
  set database [dbopen]
  
  RetryTransaction {
    scan $resid {%[0-9]%[/]%[0-9-]} firstid slash secondid
    set chanobj [db $database openidconstruction $firstid $secondid]
    set channum [dbobj $chanobj get Number]
    set stationobj [dbobj $chanobj get Station]
    set stationptr [dbobj $chanobj gettarget Station]
    set stationname [dbobj $stationobj get Name]
    set stationcallsign [dbobj $stationobj get CallSign]
    
    if {[string compare $stationcallsign $channelname]==0} {
      dbobj $chanobj set Number $newnum
      puts [format "(%s) Changing %s - %s From Ch: %s To Ch: %s" $stationptr $stationcallsign $stationname $channum $newnum] 
    } else {
      puts "Better check that script! $stationptr isn't $channelname! (It's $stationcallsign)"
    }
  }
  dbclose $database
}

proc changenum {resid newnum whataction} {
  
  # take a channel object and set the channel number to the provided number
  
  RetryTransaction {
    set db [dbopen]
  }
  
  RetryTransaction {
    scan $resid {%[0-9]%[/]%[0-9-]} firstid slash secondid
    set chanobj [db $db openidconstruction $firstid $secondid]
    set channum [dbobj $chanobj get Number]
    set stationobj [dbobj $chanobj get Station]
    set stationptr [dbobj $chanobj gettarget Station]
    set stationname [dbobj $stationobj get Name]
    set stationcallsign [dbobj $stationobj get CallSign]
    
    puts [format "(%s) $whataction %s - %s From Ch:%s To Ch: %s" $stationptr $stationcallsign $stationname $channum $newnum] 
    dbobj $chanobj set Number $newnum
  }
  dbclose $db
  return 1
}

proc html_form_select_change {name change values labels defaultval} {
  
  # same as html_form_select, but allows
  # an "onChange" script to be provided
  set str ""
  append str "<SELECT NAME=\"$name\" onChange=\"$change\">"
  set vlen [llength $values]
  for {set i 0} {$i < $vlen} {incr i} {
    set value [lindex $values $i]
    if {$defaultval == $value} {
      append str "<OPTION SELECTED VALUE=\"$value\">[lindex $labels $i]"
    } else {
      append str "<OPTION VALUE=\"$value\">[lindex $labels $i]"
    }
  }
  append str "</SELECT>"
  return $str
} 

register_module "listchan" "ChannelMap" "List Stations and Remap Channels"
}