Patch title: Release 94 bulk changes
Abstract:
File: /pliant/protocol/http/uvar.pli
Key:
    Removed line
    Added line
abstract
  [Per user permanent variables for the HTTP server.]


# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.


module "/pliant/language/compiler.pli"
module "/pliant/fullpliant/user.pli"
module "server.pli"
submodule "/pliant/appli/database.pli"
module "/pliant/appli/database/prototype.pli"
submodule "/pliant/storage/database.pli"
module "/pliant/storage/database/prototype.pli"
module "/pliant/language/data/string_cast.pli"


type DataConstant
  field Arrow value
  
DataInterface_ maybe DataConstant

method dd type d -> t
  oarg DataConstant dd ; arg Data_ d ; arg_R Type t
  t :> entry_type dd:value

method dc get d adr type -> status
  oarg DataConstant dc ; arg Data_ d ; arg Address adr ; arg Type type ; arg Status status
  var Pointer:Type t :> entry_type dc:value
  if type=t
    type copy_instance dc:value adr
    status := success
  else
    var Str s := to_string dc:value t "db"
    status := from_string adr type s "db"


type UserVariable
  field Str module
  field Str variable
  field Link:Type type
  field Link:DataConstant default

function uvar_map page uv d
  arg HtmlPage page ; arg UserVariable uv ; arg_rw Data_ d
  var Str uname := page:http_request user_name
  if uname=""
    d := data_null
    if (exists uv:default)
      d interface :> uv default
    return
  var Data:(Set Set:Anything) session :> user_database2:data:user:uname:session
  if not (exists session)
    user_database2:data:user create uname
    session :> user_database2:data:user:uname:session
  var (Pointer Data:Anything) data :>> addressof:d map Data:Anything
  data :> (session uv:module) uv:variable
  if d:adr=null # FIXME: should be: not exists:data
    session create uv:module
    (session uv:module) create uv:variable
    data :> (session uv:module) uv:variable
    if (exists uv:default)
      d:base:sem request
      d:interface set d uv:default:value (entry_type uv:default:value)
      d:base:sem release

function active_type uv access e
  arg UserVariable uv ; arg Int access ; arg_rw Expression e
  if e:size<>1 or not (e:0 cast HtmlPage)
    return
  e suckup e:0
  var Link:Argument a :> argument local (Data uv:type)
  e add (instruction (the_function uvar_map HtmlPage UserVariable Data_) e:0:result (argument mapped_constant UserVariable uv) a)
  e set_result a access_read+access_write


meta uvar e
  if e:size<2 or (e:0 constant Type)=null
    return
  var Pointer:Type t :> (e:0 constant Type) map Type
  var Link:DataConstant default :> null map DataConstant
  var Int stop := e:size
  if e:size>=4 and e:(e:size-2):ident="<-" and (e:(e:size-1) constant t)<>null
    default :> new DataConstant
    default value := e:(e:size-1) constant t
    stop -= 2
  for (var Int i) 1 stop-1
    if not e:i:is_pure_ident
      return
  for (var Int i) 1 stop-1
    var Link:UserVariable uv :> new UserVariable
    uv module := e:external_module:name
    uv variable := e:i ident
    uv type :> t
    uv default :> default
    e define ". "+e:i:ident addressof:uv e:module:actual
  e set_void_result

export uvar