scripts/sessionconobj.itcl

   1 # vim: ft=tcl foldmarker=<<<,>>>
   2
   3 class tlc::SessionCon {
   4         inherit tlc::Con
   5         constructor {parms a_con cl_ip cl_port} {tlc::Con::constructor $parms $a_con $cl_ip $cl_port} {}
   6         destructor      {}
   7
   8         public {
   9                 variable        sessionkey                      ""
  10
  11                 method          session_ref             {}
  12                 method          attach_to_session       {sessionid}
  13                 method          get_new_session         {}
  14                 method          setvar                          {varname value}
  15                 method          getvar                          {varname}
  16         }
  17         private {
  18                 variable        session
  19                 common          sessions
  20                 variable        client_ip
  21         }
  22 }
  23
  24 body tlc::SessionCon::constructor {parms a_con cl_ip cl_port} { #<<<1
  25         eval configure $parms
  26         set client_ip $cl_ip
  27         if {$sessionkey==""} {
  28                 get_new_session
  29         } else {
  30                 attach_to_session $sessionkey
  31         }
  32         log debug "Session-enabled connection active."
  33 }
  34
  35 body tlc::SessionCon::session_ref {} {
  36         return $session
  37 }
  38
  39 body tlc::SessionCon::attach_to_session {$skey} { #<<<1
  40         if {[info exists sessions($skey)]} {
  41                 if {[info exists $sessions($skey)]} {
  42                 # this is a valid session that we may attach to
  43                         set session $sessions($skey)
  44                         set sessionkey $skey
  45                         return 1
  46                 } else {
  47 #                       the session has timed out -- remove the reference and report unsuccessful connection
  48                         array unset sessions $skey
  49                         set sessionkey ""
  50                         return 0
  51                 }
  52         } else {
  53                 set sessionkey ""
  54                 return 0
  55         }
  56 }
  57
  58 body tlc::SessionCon::get_new_session {} {      #<<<1
  59         log debug "requesting new session object"
  60         set session [Sessionobj ::#auto -client_ip $client_ip]
  61         set sessionkey [$session cget -sessionkey]
  62         log debug "sessionkey is: $sessionkey"
  63         set sessions($sessionkey) $session
  64         log debug "sessions($sessionkey) is: $session"
  65         return $sessionkey
  66 }
  67
  68 body tlc::SessionCon::setvar {varname value} { #<<<1
  69         log debug "entering setvar for sessioncon, varname: $varname; varval: $value"
  70         log debug "attempting to use session: $session"
  71         if {[info exists sessions($sessionkey)]} {
  72                 log debug "session exists; requesting setvar"
  73                 return [$session setvar $varname $value]
  74         } else {
  75                 log debug "no session found: returning empty"
  76                 return ""
  77         }
  78 }
  79
  80 body tlc::SessionCon::getvar {varname} { #<<<1
  81         log debug "entering getvar for sessioncon"
  82         if {[info exists sessions($sessionkey)]} {
  83                 log debug "session exists; asking session for variable"
  84                 return [$session getvar $varname]
  85         } else {
  86                 return 0
  87         }
  88 }
  89
  90 body tlc::SessionCon::destructor {} { #<<<1
  91 }
  92