Forum OpenACS Development: Re: XML to XoTCL Object

Collapse
5: Re: XML to XoTCL Object (response to 1)
Posted by Gustaf Neumann on

As other have said already, the are many possible mappings, some of these are for some examples more or less convenient. In most cases, there is little need to map the full DOM structure into XOTcl objects, because tdom provides already a powerful interface. Stefan's pointer to the two papers is a great introduction to approaches for OO/XML mappings.

A central question is whether you have control over the XML types (e.g. you are able to specify the XML schema) or you want to map given XML structures to given XOTcl classes/objects.

For the first case, the small program below might help you as a start.

For the second case, i would recommend to look into the RSS-client class (in xowiki/tcl/syndicate-procs.tcl in CVS head) which is used to map various forms of RSS files into xotcl objects based on a set of xpath queries. Most likely this can be generalized by providing xpath queries as slot attributes.

Below is a study, how to map arbitrary XOTcl objects into XML and how to generate again from the XML file the XOTcl objects. Note that this works as well with all acs objects, when using the mappings from xotcl-core. It will create the objects in memory, one has to use save/save_new to persist it in the database. Note, however, that the import/export exports as well all IDs which are of limited used when exchanging objects between systems. To address these problems, one might look into the import/export facilities of xowiki.

After loading the code underneath, on can run the following example:

#
# Define two simple classes with two sample instances
#
Class C -parameter {x y}
C c1 -x 1 -y 10

Class D -superclass C -parameter {{z 100}}
D d1 -x 2 -y 20

#
# Get the XML representation of the two objects
# 
set XML [xml getXML c1 d1]

# Destroy the objects from memory
d1 destroy 
c1 destroy

# 
# Get the XML Schema definition for the two classes
#
set XMLS [xml getSchema ::C ::D]

#
# Parse the XML file and obtain the objects from the
# contents.
#
xml getObjects $XML

ns_log notice c1=[info command c1]
ns_log notice c1=[c1 info class]

Note that this code is just a study, for real world usage, one should provide an interface for named/unnamed objects, class mappings, namespace fiddling (both xml and tcl).

######################################################
#
# The method allslots computes the set of all slots of a class,
# including the slots of the classes of the full type hierarchy.
#
Class instproc allslots {} {
  set slots [my info slots]
  # remember slotnames
  foreach slot $slots {set slotname([namespace tail $slot]) 1}
  # iterate over class structure
  foreach c [my info heritage] {
    foreach slot [$c info slots] {
      set key slotname([namespace tail $slot])
      # don't add slots which are already defined in more specialized classes
      if {[info exists $key]} continue
      set $key 1
      lappend slots $slot
    }
  }
  # return slot objects always in same order
  return [lsort $slots]
}

#
# The object xml implements import and export of XOTcl objects
# via XML.
# 
# The most important methods are
#
#  - getSchema   ...
#
#    returns an xml schema derived from the XOTcl slot structure of the specified
#    XOTcl classes. Currently, it defines all attributes as string values.
#    It could use the as well the database types kept in the db-slots in xotcl-core.
#
# - getXML   ...
#
#   returns an XML representation of the specified XOTcl objects. The
#   generated XML text contains only the instance attributes defined
#   via slots (e.h. parameters)
#
# - getObjects 
# 
#   parses the specified XML text and creates the XOTcl objects from
#   the contents of the XML file.
#
# 

Object xml
xml set schemaName http://your.host.net/xotcl
xml set schemaFile http://your.host.net/xotcl.xsd

xml proc tcl_to_xml {name} {regsub -all :: [string trimleft $name :] _.._ name; return $name}
xml proc xml_to_tcl {name} {regsub -all _\.\._ $name :: name;return $name}

xml proc getSchema args {
  my instvar schemaName
  dom createDocument xs:schema doc
  $doc documentElement root
  $root setAttribute targetNamespace $schemaName
  $root setAttribute xmlns $schemaName
  $root setAttribute xmlns:xs "http://www.w3.org/2001/XMLSchema"
  
  foreach class $args {
    set node [$doc createElement xs:complexType ]
    $node setAttribute name [my tcl_to_xml $class]
    $root appendChild $node
    set seq [$doc createElement xs:sequence ]
    $node appendChild $seq
    foreach slot [$class allslots] {
      $seq appendFromList [list xs:element [list name [$slot name] type xs:string] {}]
    }
    set att [$doc createElement xs:attribute ]
    $att setAttribute name name
    $att setAttribute type xs:string
    $node appendChild $att
  }

  set node [$doc createElement xs:complexType ]
  $node setAttribute name xotcl
  $root appendChild $node
  set seq [$doc createElement xs:sequence ]
  $node appendChild $seq
  set choice [$doc createElement xs:choice ]
  $seq appendChild $choice
  foreach class $args {
    set ncName [my tcl_to_xml $class]
    $seq appendFromList [list xs:element [list name $ncName type $ncName] {}]
  }
  return [$root asXML]
}

xml proc getXML args {
  my instvar schemaName schemaFile
  dom createDocument xotcl doc
  $doc documentElement root
  $root setAttribute xmlns $schemaName
  $root setAttribute xmlns:xsi "http://www.w3.org/2001/XMLSchema-instance"
  $root setAttribute xsi:schemaLocation "$schemaName $schemaFile"
  
  foreach o $args {
    set node [$doc createElement [my tcl_to_xml [$o info class] ]]
    $root appendChild $node
    $node setAttribute name [$o self]
    foreach slot [[$o info class] allslots] {
      set name [$slot name]
      $node appendFromList [list $name "" [list [list #text [$o $name]]]]
    }
  }

  return [$root asXML]
}

xml proc getObjects {XML} {
  my instvar schemaName 
  set objects [list]
  dom parse $XML doc
  $doc documentElement root
  $root setAttributeNS "" xmlns:default [$root getAttribute xmlns]
  foreach node [$root selectNodes /default:xotcl/*] {
    set command [list [my xml_to_tcl [$node nodeName]] create [$node getAttribute name]]
    foreach att [$node childNodes] {
      lappend command [list -[$att nodeName] [$att text]]
    }
    lappend objects [eval $command]
  }
  return $objects
}