#---------------------------------------------------------------------------
# seaman scripts (connection bookkeeping)
#---------------------------------------------------------------------------

proc check_instrument {caller {hostport {}}} {
  if {[sicsdescriptor $caller] ne "sea"} {
    catch {removeobject $caller}
    catch {removeobject _$caller}
    if {$hostport eq ""} {
      set hostport "$caller:8641"
    }
    stdConfig::make seaclient $caller _$caller -port $hostport
  } elseif {[driverKind _$caller oldhostport] eq "sctcontroller"} {
    if {$oldhostport ne $hostport} {
      _$caller reconnect $hostport
    }
  }
}

proc book_request {caller hostport device args} {
  clientput "$caller ($hostport) wants to get: $args"
  check_instrument $caller $hostport
  
  # make a list of already booked items for caller
  foreach item [busy_list items] {
    set ins [result busy_list $item]
    if {$ins eq $caller} {
      set booked($item) 1
    }
  }
  # make a list of requested items from caller
  foreach item [request_list items] {
    set ins [result request_list $item]
    if {$ins eq $caller} {
      set requested($item) 1
    }
  }

  if {$device eq "PARTIAL"} {
    set all 0
  } else {
    set all 1
    device_list makeitem $caller $device
  }
  # book or add to the list of booked by other instruments
  set cmd [list reconnect_or_set_busy]
  foreach itm $args {
    if {[string match "sample-ts*" $itm] || [string match "localhost*"] $itm} {
      set item "${caller}/$itm"
    } else {
      set item $itm
    }
    if {[busy_list exists $item]} {
      set ins [result busy_list $item]
      set booked($item) 0
      if {$ins ne $caller} {
        request_list makeitem $item $caller
        set requested($item) 0
      }
    } else {
      busy_list_add $item $caller
      set booked($item) 0
      set ins $caller
    }
    if {$all && $ins eq $caller} {
      set arg [list $itm]
    } else {
      set arg [list $itm $ins [silent "" result device_list $ins]]
    }
    lappend cmd $arg
  }
  
  array set confirm_list {}
  if {$all} {
  # remove not requested bookings of caller
    set items ""
    foreach item [array names booked] {
      if {$booked($item)} {
        lappend items $item
        busy_list_add $item KILL
        if {[request_list exists $item]} {
          set ins [result request_list $item]
          clientput "confirm $ins"
          lappend confirm_list($ins) $item
        }
      }
    }
    foreach item [array names requested] {
      if {$requested($item)} {
        request_list deleteitem $item
      }
    }
    if {$items ne ""} {
      clientput "$caller does no longer need: $items"
    }
  }
  $caller / $cmd
  clientput "inform $caller about busy items: [lrange $cmd 1 end]"
  foreach i [array names confirm_list] {
    clientput "confirm_list $i : $confirm_list($i)"
    eval "book_confirm $i $confirm_list($i)"
  }
  return ""
}

proc busy_list_add {hostport caller} {
  if {$caller eq "KILL"} {
    busy_list deleteitem $hostport
  } else {
    busy_list makeitem $hostport $caller
  }
}

proc get_instruments {} {
  set ilist [split [unknown list match _*] ","]
  foreach instr $ilist {
    if {$instr ne "ENDLIST"} {
      set ins [string range $instr 1 end]
      if {[sicsdescriptor $ins] eq "sea"} {
        lappend instruments [string range $instr 1 end]
      }
    }
  }
  return $instruments
}

proc hostport_of {ctrl rack} {
  source config/rack.list
  set hostport ""
  array set racks $racklist
  catch {
    set cfglist $racks($rack)
    foreach {obj hostport} $cfglist {
      if {$obj eq $ctrl} {
        break
      }
    }
  }
  return $hostport
}

proc hostports_of {rack} {
  source config/rack.list
  set hostport ""
  array set racks $racklist
  set result [list]
  catch {
    set cfglist $racks($rack)
    foreach {obj hostport} $cfglist {
      lappend result $hostport
    }
  }
  return $result
}

proc rack_owner {rack {owner ""} {used ""}} {
  if {$rack eq "no"} return
  set hostport [hostport_of _cc $rack]
  if {$hostport eq ""} {
    clientput "$rack not found"
    return
  }
  if {$owner eq ""} {
    return [silent undef result rack_list $rack]
  }
  clientlog "rack $rack owner $owner old [silent free result rack_list $rack]"
  if {$owner eq "free"} {
#    if {$hostport ne ""} {
#      dolater 3 rack_reconnect $rack $hostport
#    }
    foreach p [hostports_of $rack] {
      catch {busy_list deleteitem $p}
    }    
    rack_list makeitem $rack free
  } else {
    # release all racks attached to owner first
    foreach irack [rack_list items] {
      if {[result rack_list $irack] eq $owner} {
        rack_list $irack free
      }
    }
    # attach rack to owner
    rack_list makeitem $rack $owner
    if {$used ne ""} {
      catch {instr_list $owner $inuse}
    }
    # obsolete after change:
    if {[sicsdescriptor $rack] eq "ccu4"} {
      removeobject $rack
      if {[sicsdescriptor _$rack] eq "SctController"} {
        removeobject _$rack
      }
      clientput "release $rack"
    }
  }
}

# obsolete:
proc rack_reconnect {rack hostport} {
  if {[sicsdescriptor $rack] eq "notfound"} {
    stdConfig::make -driver ccu4 -name $rack -port $hostport
  } else {
    _$rack reconnect
  }
  clientput "reconnect $rack"
  rack_list makeitem $rack free
}

proc rack_in_use_on {rack instrument inuse} {
  global free_instr_cache

  instr_list makeitem $instrument $inuse
  if {$inuse} {
    if {[silent free result rack_list $rack] ne $instrument} {
      rack_owner $rack $instrument 1
    }
  }
  catch {unset free_instr_cache}
}

proc free_instruments {} {
  global free_instr_cache

  if {![info exists free_instr_cache]} {
    set ilist [instr_list items]
    set fi [list]
    foreach ins $ilist {
      if {[result instr_list $ins] == 0} {
        lappend fi $ins
      }
    }
    set free_instr_cache [join $fi ","]
  }
  return $free_instr_cache
}

proc ask_for_rack {rack instrument} {
  set ins [silent free result rack_list $rack]
  set hins [silent $ins result busy_list [hostport_of _cc $rack]]
  if {$hins ne $ins} {
    $instrument / rack_not_available $rack $hins
    return
  }
  clientlog "$rack: $ins -> $instrument"
  if {$ins eq $instrument} {
    $instrument / install_rack $rack
    return
  }
  if {$ins eq "free"} {
    dolater 1 rack_available_for $rack $instrument
    return
  }
  clientlog $ins / release_rack_for $rack $instrument
  $ins / release_rack_for $rack $instrument
}

proc move_rack_to {rack to} {
  if {$rack eq "no"} return
  if {$to eq "free"} {
    rack_owner $rack $to
    return
  }
  dolater 0 rack_available_for $rack $to
}

proc rack_available_for {rack instrument {tmo now}} {
  if {$tmo eq "force" || [silent 0 result rack_list $rack] eq "free"} {
    clientlog "- $instrument / install_rack $rack"
    dolater 3 $instrument / install_rack $rack
    return
  }
  set now [DoubleTime]
  if {$tmo eq "now"} {
    set tmo $now
  }
  if {$tmo <= $now + 30} {
    error "timeout in rack_available_for $rack $instrument"
  }
  dolater 1 rack_available_for $rack $instrument $tmo
}

proc rack_not_available_for {rack instrument old} {
  clientlog $instrument / rack_not_available $rack $old
  $instrument / rack_not_available $rack $old
}

proc book_this {caller args} {
  clientput "$caller wants to disconnect: $args"
  foreach {item instr} $args {
    if {[result busy_list $item] eq $instr} {
      lappend ilist($instr) $item
    }
  }
  foreach instr [array names ilist] {
    $instr / disconnect_from $caller $ilist($instr)
  }
}

proc book_confirm {caller args} {
  clientput "inform $caller about disconnected items: $args"
  set rlist ""
  foreach item $args {
    if {[silent "" result request_list $item] eq $caller} {
      request_list deleteitem $item
    }
    busy_list_add $item $caller
    lappend rlist [list $item $caller [silent "" result device_list $caller]]
  }
  $caller / reconnect_or_set_busy $rlist
}

proc show_item {item} {
  set req [silent "" result request_list $item]
  if {$req ne ""} {
    set item [format "%-15s %s" $item $req]
  }
  return [format "%45s %s\n" " " $item]
}

proc device_none_on {instrument} {
  $instrument / samenv -q none
}

proc show {{key ""}} {

  set ilist [split [unknown list match _*] ","]
  foreach instr $ilist {
    if {$instr ne "ENDLIST"} {
      set ins [string range $instr 1 end]
      if {[sicsdescriptor $ins] eq "sea"} {
        set hostport {}
        driverKind $instr hostport
#        clientlog "$instr $hostport"
        set table($ins) [list $hostport]
      }
    }
  }

  foreach item [result busy_list items] {
    set ins [result busy_list $item]
    if {![info exists table($ins)]} {
      set table($ins) "?"
    }
    lappend table($ins) $item
  }

  set result    "Instrument                    Device          Connections     Requests\n"
  append result "----------------------------------------------------------------------\n"
  foreach instr [lsort [array names table]] {
    set row $table($instr)
    set head [format "%-29s %s\n" "$instr ([lindex $row 0])" [silent "" result device_list $instr]]
    if {$key eq "" || $key eq $instr} {
      append result $head
      foreach item [lrange $row 1 end] {
        append result [show_item $item]
      }
      append result "\n"
    } elseif {[string match "*$key*" [join $row]]} {
      append result $head
      foreach item [lrange $row 1 end] {
        if {[string match "*$key*" $item]} {
          append result [show_item $item]
        }
      }
      append result "\n"
    }
  }
  return $result
}

proc get_devices {args} {
  set ilist [split $args ","]
  set result [list]
  foreach ins $ilist {
    set dev [silent {} result samenv_list $ins]
    if {$dev eq ""} {
      set dev [silent {} result device_list $ins]
    }
    lappend result $dev
  }
  return [join $result ","]
}

proc samenv args {
  if {$args eq "name"} {
    return "_inst_select"
  }
  if {[llength $args] > 0} {
    error "forbidden on seaman"
  }
}

namespace eval inst_select {

clientput "REORDER web_ports"

  set home /home/l_samenv

  foreach itm [web_ports items] {
    web_ports deleteitem $itm
  }

  proc instrument {instr} {
  }

  proc seaweb {instr port {host ""}} {
    web_ports makeitem $instr $port
  }

  proc sea {mode sea graph web} {
  }

  proc schedule_cron args {}
  proc writeServer args {}

  set mrc stdout
  source ../../monitconfig

  web_ports makeitem test TEST
  samenv_list makeitem test instrlist
  device_list makeitem test instrlist
}

proc _inst_selectGroup {} {
  foreach instr [web_ports items] {
    set dev [silent "" result samenv_list $instr]
    set dev1 [silent "" result device_list $instr]
    if {$dev eq "" || $dev1 ne [lindex [split $dev /] 0]} {
      set dev $dev1
    }
    if {$dev ne ""} {
      clientput -T[string toupper $instr]
      clientput -V$dev
      set link [result web_ports $instr]
      if {$link eq "TEST"} {
        clientput -l:8000/?sg=1&sm=0&sc=0
        clientput -i_link_test
      } else {
        clientput -l:[result web_ports $instr]
        clientput -i_link_[result web_ports $instr]
      }
    }
  }
}

proc getgroup_inst_select {} {
  Group _inst_select " "
}

proc rackGroup {} {
  foreach rack [lsort [rack_list items]] {
    Input "$rack attached to" "rack_owner $rack"
  }
}

proc portsGroup {} {
  foreach port [lsort [busy_list items]] {
    Input "$port attached to" "busy_list $port"
  }
}

proc mainGroup {} {
  Group rack "racks"
  Group ports "ports"
}

proc refresh {} {
  foreach instr [instr_list items] {
    clientlog "$instr"
    catch {
      $instr / save_samenv
    } msg
    clientput $msg
  }
}


publish book_this User
publish book_request User
publish book_confirm User
publish device_none_on User
publish get_devices User
publish show Spy
publish update_rack_list Spy
publish get_instruments Spy
publish rack_owner Spy
publish rack_in_use_on Spy

publish ask_for_rack Spy
publish rack_available_for Spy
publish rack_not_available_for Spy
publish free_instruments Spy
publish move_rack_to Spy

publish refresh Spy