Index: library/mongodb/nx-mongo.tcl
===================================================================
diff -u -r7e9e1831d37e6f0557a8bfe17ecba0ec6f7e6c33 -reef878fdd83b2fcf27a2644e6e8788a12f714c26
--- library/mongodb/nx-mongo.tcl	(.../nx-mongo.tcl)	(revision 7e9e1831d37e6f0557a8bfe17ecba0ec6f7e6c33)
+++ library/mongodb/nx-mongo.tcl	(.../nx-mongo.tcl)	(revision eef878fdd83b2fcf27a2644e6e8788a12f714c26)
@@ -8,17 +8,24 @@
 package provide nx::mongo 0.2
 
 # todo: how to handle multiple connections; currently we have a single, global connection
-# todo: make embedded spec nicer
-# todo: handle time stamps
+# todo: all references are currently auto-fetched. make this optional
+# todo: If "emebds" or "references" are used, the object must be of 
+#       the specified classes, no subclasses allowed
+# todo: extend the query language syntax, e.g. regexp, ...
 # todo: handle remove for non-multivalued embedded objects
 # idea: handle names of nx objects (e.g. attribute like __name)
 # idea: handle classes von nx objects (e.g. attribute like __class)
 # idea: combine incremental slot operations with e.g. add -> $push, remove -> $pull
+# todo: make "embedded", "reference" spec even nicer?
 
 namespace eval ::nx::mongo {
 
   ::nx::Object create ::nx::mongo::db {
-    :public method connect {args} {set :mongoConn [::mongo::connect {*}$args]}
+    :attribute db
+    :public method connect {{-db test} args} {
+      set :db $db
+      set :mongoConn [::mongo::connect {*}$args]
+    }
     :public method count   {args} {::mongo::count  ${:mongoConn} {*}$args}
     :public method index   {args} {::mongo::index  ${:mongoConn} {*}$args}
     :public method insert  {args} {::mongo::insert ${:mongoConn} {*}$args}
@@ -27,7 +34,7 @@
     :public method update  {args} {::mongo::update ${:mongoConn} {*}$args}
   }
   
-  #
+  #######################################################################
   # nx::mongo::Attribute is a specialized attribute slot
   #
   ::nx::MetaSlot create ::nx::mongo::Attribute -superclass ::nx::Attribute {
@@ -44,7 +51,8 @@
 	  switch -glob ${:type} {
 	    "boolean" -
 	    "integer" {set :mongotype ${:type}}
-	    "embedded" {set :mongotype object}
+	    "embedded" {set :mongotype embedded_object}
+	    "reference" {set :mongotype referenced_object}
 	  }
 	  #"::*" {set :mongotype object}
 	}
@@ -72,18 +80,52 @@
       } elseif {$bsontype eq "object"} {
 	#puts stderr "*** we have an object '$value', [:serialize]"
 	if {${:type} eq "embedded" && [info exists :arg]} {
+	  #puts stderr "*** we have an embed class = ${:arg}"
 	  set value [${:arg} bson create $value]
 	  #puts stderr "*** ${:arg} bson create ==> $value"
+	} elseif {${:type} eq "reference" && [info exists :arg]} {
+	  #puts stderr "*** we have a reference, class = ${:arg}"
+	  # TODO we assume auto_deref
+	  set value [:bson deref ${:arg} $value]
+	  puts stderr "*** bson deref ${:arg} ==> $value"
 	} else {
 	  error "don't know how to decode object with value '$value'; [:serialize]"
 	}
       }
       return $value
     }
-    
+
+    :method "bson deref" {class value} {
+      #puts stderr "*** bson deref $class '$value'"
+      foreach {name type v} $value {
+	if {[string match {$*} $name]} {set ([string range $name 1 end]) $v}
+      }
+      if {![info exists (id)]} {
+	error "value to be dereferenced does not contain dbref id: $value"
+      }
+      if {[info exists (db)]} {
+	if {$(db) ne [$class mongo_db]} {error "$(db) is different to [$class mongo_db]"}
+      }
+      if {[info exists (ref)]} {
+	if {$(ref) ne [$class mongo_collection]} {error "$(ref) is different to [$class mongo_collection]"}
+      }
+      return [$class find first -cond [list _id = $(id)]]
+    }
+
     :method "bson encodeValue" {value} {
-      if {${:mongotype} eq "object"} {
-	return [list ${:mongotype} [$value bson encode]]
+      if {${:mongotype} eq "embedded_object"} {
+	return [list object [$value bson encode]]
+      } elseif {${:mongotype} eq "referenced_object"} {
+	if {![::nsf::var::exists $value _id]} {
+	  puts stderr "autosave $value to obtain an object_id"
+	  $value save
+	}
+	set _id [$value _id]
+	set cls [$value info class]
+	return [list object [list \
+				 {$ref} string [$cls mongo_collection] \
+				 {$id} oid $_id \
+				 {$db} string [$cls mongo_db]]]
       } else {
 	return [list ${:mongotype} $value]
       }
@@ -121,22 +163,49 @@
     :public method type=embedded {name value arg} {
       set s [:uplevel self]
       #puts stderr "check $name '$value' arg='$arg' s=$s"
-      if {[::nsf::isobject $value] && [::nsf::is class $arg] && [$value info has type $arg]} {
+      if {[::nsf::object::exists $value] && [::nsf::is class $arg] && [$value info has type $arg]} {
 	::nsf::var::set $value __embedded_in [list $s $name]
 	::nsf::var::set $s __contains($value) 1
       } else {
 	error "value '$value' for attribute $name is not of type $arg"
       }
     }
+    #
+    # Type converter for handling embedded objects. Makes sure to
+    # track "embedded in" relationship
+    #
+    :public method type=reference {name value arg} {
+      set s [:uplevel self]
+      #puts stderr "check $name '$value' arg='$arg' s=$s"
+      if {[::nsf::object::exists $value] && [::nsf::is class $arg] && [$value info has type $arg]} {
+	set ref [list $s $name]
+	if {[::nsf::var::exists $value __referenced_in]} {
+	  set refs [::nsf::var::set $value __referenced_in]
+	  if {[lsearch $refs $ref] == -1} {lappend refs $ref}
+	} else {
+	  set refs [list $ref]
+	}
+	::nsf::var::set $value __referenced_in $refs
+      } else {
+	error "value '$value' for attribute $name is not of type $arg"
+      }
+    }
   }
   
+
+  #######################################################################
+  # The class mongo::Class provides methods for mongo classes (such as
+  # "find", "insert", ...)
+  #
   ::nx::Class create ::nx::mongo::Class -superclass nx::Class {
     
     #
-    # Every mongo class can be configured with a document, from which
+    # Every mongo class can be configured with a mongo_ns, from which
     # its instance data is queried.
     #
-    :attribute document
+    :attribute mongo_ns
+    :attribute mongo_db
+    :attribute mongo_collection
     
     #
     # Provide helper methods to access from an external specifier
@@ -193,6 +262,7 @@
     }
     
     :method "bson parameter" {tuple} {
+      #puts "bson parameter $tuple"
       set objParams [list]
       foreach {att type value} $tuple {
 	set slot [:get slot $att]
@@ -210,21 +280,49 @@
       }
     }
 
+    :method "bson pp_array" {{-indent 0} list} {
+      set result [list]
+      foreach {name type value} $list {
+	switch $type {
+	  object { lappend result "\{ [:bson pp -indent $indent $value] \}" }
+	  array { lappend result "\[ [:bson pp_array -indent $indent $value] \]" }
+	  default { lappend result [list $value]}
+	}
+      }
+      return [join $result ", "]
+    }
+
+    :public method "bson pp" {{-indent 0} list} {
+      set result [list]
+      set nextIndent [expr {$indent + 2}]
+      foreach {name type value} $list {
+	set prefix "\n[string repeat { } $indent]$name: "
+	switch $type {
+	  object { lappend result "$prefix\{ [:bson pp -indent $nextIndent $value] \}" }
+	  array { lappend result "$prefix\[ [:bson pp_array -indent $nextIndent $value] \]" }
+	  default { lappend result $prefix[list $value]}
+	}
+      }
+      return [join $result ", "]
+    }
+
     #
     # Overload method attribute to provide "::nx::mongo::Attribute" as a
     # default slot class
     #
     :public method attribute {spec {-class ::nx::mongo::Attribute} {initblock ""}} {
+      regsub -all {,type=} $spec {,arg=} spec
       next [list $spec -class $class $initblock]
     }
     
     #
     # index method
     #
     :public method index {att {-type 1}} {
+      if {![info exists :mongo_ns]} {:mongo_setup}
       # todo: 2d index will need a different type
-      #::mongo::index $::mongoConn ${:document} [list $att int $type]
-      db index ${:document} [list $att int $type]
+      #::mongo::index $::mongoConn ${:mongo_ns} [list $att int $type]
+      db index ${:mongo_ns} [list $att int $type]
     }
     
     #
@@ -233,15 +331,17 @@
     :public method insert {args} {
       set p [:new {*}$args]
       $p save
+      set _id [$p _id]
       $p destroy
+      return $_id
     }
 
     #
     # The method "count" is similar to find, but returns just the
     # number of tuples for the query.
     #
     :public method count {{-cond ""}} {
-      return [::nx::mongo::db count ${:document} $cond]
+      return [::nx::mongo::db count ${:mongo_ns} $cond]
     }
     
     #
@@ -253,11 +353,11 @@
 				 {-cond ""}
 				 {-orderby ""} 
 			       } {
-      set tuple [lindex [::nx::mongo::db query ${:document} \
+      set tuple [lindex [::nx::mongo::db query ${:mongo_ns} \
 			     [:bson query -cond $cond -orderby $orderby] \
 			     -limit 1] 0]
       #puts "find first fetched: $tuple"
-      if {$instance ne ""} {set instance [:uplevel [list ::nsf::qualify $instance]]}
+      if {$instance ne ""} {set instance [:uplevel [list ::nsf::object::qualify $instance]]}
       return [:bson create -name $instance $tuple]
     }
     
@@ -271,7 +371,7 @@
       set opts [list]
       if {[info exists limit]} {lappend opts -limit $limit}
       if {[info exists skip]} {lappend opts -skip $skip}
-      set fetched [::nx::mongo::db query ${:document} \
+      set fetched [::nx::mongo::db query ${:mongo_ns} \
 		       [:bson query -cond $cond -orderby $orderby] \
 		       {*}$opts]
       puts "[join $fetched \n]"
@@ -280,27 +380,60 @@
       }
       return $result
     }
+
+    :public method show {
+			 {-cond ""} 
+			 {-orderby ""} 
+			 {-limit} 
+			 {-skip} 
+			 } {
+      set result [list]
+      set opts [list]
+      if {[info exists limit]} {lappend opts -limit $limit}
+      if {[info exists skip]} {lappend opts -skip $skip}
+      set fetched [::nx::mongo::db query ${:mongo_ns} \
+		       [:bson query -cond $cond -orderby $orderby] \
+		       {*}$opts]
+      set tuples [list]
+      foreach tuple $fetched {
+	lappend tuples "\{[:bson pp -indent 4 $tuple]\n\}"
+      }
+      puts [join $tuples ", "]
+    }
     
+    :method mongo_setup {} {
+      #
+      # setup mongo_collection, mongo_db and mongo_ns
+      #
+      if {[info exists :mongo_ns]} {
+	#puts stderr "given mongo_ns ${:mongo_ns}"
+	if {![regexp {^([^.]+)[.](.*)$} ${:mongo_ns} :mongo_db :mongo_collection]} {
+	  error "${:mongo_ns} does not contain a dot."
+	}
+      } else {
+	if {![info exists :mongo_collection]} {
+	  set :mongo_collection [string tolower [namespace tail [self]]]s
+	}
+	if {![info exists :mongo_db]} {
+	  set :mongo_db [::nx::mongo::db db]
+	}
+	set :mongo_ns ${:mongo_db}.${:mongo_collection}
+	#puts stderr "mongo_ns is set to ${:mongo_ns}"
+      }
+    }
+
     #
     # When a mongo::Class is created, mixin the mongo::Object to make
     # "save" etc. available
     #
     
     :method init {} {
       :mixin add ::nx::mongo::Object
+      :mongo_setup
     }
-    
-    # :public method create args {
-    #   puts stderr CREATE-[self]-$args
-    #   set o [next]
-    #   $o mixin add ::nx::mongo::Object
-    #   puts stderr CREATED-$o-[$o info mixin]
-    #   return $o
-    # }
-    
   }
   
-  #
+  #######################################################################
   # The class mongo::Object provides methods for mongo objects (such as
   # "save")
   #
@@ -328,42 +461,7 @@
       return $bson
     }
 
-    :method "bson pp_array" {{-indent 0} list} {
-      set result [list]
-      foreach {name type value} $list {
-	switch $type {
-	  object { lappend result "\{ [:bson pp -indent $indent $value] \}" }
-	  array { lappend result "\[ [:bson pp_array -indent $indent $value] \]" }
-	  default { lappend result [list $value]}
-	}
-      }
-      return [join $result ", "]
-    }
-
-    :method "bson pp" {{-indent 0} list} {
-      set result [list]
-      set nextIndent [expr {$indent + 2}]
-      foreach {name type value} $list {
-	set prefix "\n[string repeat { } $indent]$name: "
-	switch $type {
-	  object { lappend result "$prefix\{ [:bson pp -indent $nextIndent $value] \}" }
-	  array { lappend result "$prefix\[ [:bson pp_array -indent $nextIndent $value] \]" }
-	  default { lappend result $prefix[list $value]}
-	}
-      }
-      return [join $result ", "]
-    }
-
     #
-    # embedded_in denotes that the object is embedded in another
-    # object with a reference to the attribute
-    #
-    # :public method embedded_in {object attribute} {
-    #   set :__embedded_in [list $object $attribute]
-    #   $object $attribute add [self] end
-    # }
-
-    #
     # destroy a mapped object from memory
     #
     :public method destroy {} {
@@ -387,18 +485,34 @@
     :public method delete {} {
       puts stderr "[self] delete"
       if {[info exists :__embedded_in]} {
+	# When an embedded object is deleted, it is removed for the
+	# reference list. The containing object is not automatically
+	# saved for the time being. We could consider an automatic
+	# save or mongo-$pull update operation.
 	puts "[self] is embedded in ${:__embedded_in}"
 	lassign ${:__embedded_in} parent att
 	set slot [[$parent info class] get slot $att]
 	$slot remove $parent [self]
 	#puts stderr [:serialize]
 	puts stderr "[self] must save parent $parent in db"
 	:destroy
+      } elseif {[info exists :__referenced_in]} {
+	# When a referenced is deleted, we do for now essentially the
+	# same as for embedded objects. However, the same object might
+	# be referenced by several objects.
+	puts "[self] is referenced in ${:__referenced_in}"
+	foreach reference ${:__referenced_in} {
+	  lassign $reference parent att
+	  set slot [[$parent info class] get slot $att]
+	  $slot remove $parent [self]
+	  puts stderr "[self] must save parent $parent in db"
+	}
+	:destroy
       } else {
 	puts "delete a non-embedded entry"
 	if {[info exists :_id]} {
-	  set document [[:info class] document]
-	  ::nx::mongo::db remove $document [list _id oid ${:_id}]
+	  set mongo_ns [[:info class] mongo_ns]
+	  ::nx::mongo::db remove $mongo_ns [list _id oid ${:_id}]
 	} else {
 	  error "[self]: object does not contain an _id; it can't be delete from the mongo db."
 	}
@@ -410,23 +524,23 @@
     # otherwise perform an insert
     #
     :public method save {} {
-      set document [[:info class] document]
-      if {$document eq ""} {
+      set mongo_ns [[:info class] mongo_ns]
+      if {$mongo_ns eq ""} {
 	# We could perform the delegation probably automatically, but
 	# for now we provide an error
-	error "No document specified for [:info class]. In case this is an embedded object, save the embedding one."
+	error "No mongo_ns specified for [:info class]. In case this is an embedded object, save the embedding one."
       } else {
 	set bson [:bson encode]
 	if {[info exists :_id]} {
-	  puts stderr "we have to update [:bson pp -indent 4 $bson]"
-	  ::nx::mongo::db update $document [list _id oid ${:_id}] $bson
+	  puts stderr "we have to update [[:info class] bson pp -indent 4 $bson]"
+	  ::nx::mongo::db update $mongo_ns [list _id oid ${:_id}] $bson
 	} else {
-	  puts stderr "we have to insert [:bson pp -indent 4 $bson]"
-	  set r [::nx::mongo::db insert $document $bson]
+	  puts stderr "we have to insert [[:info class] bson pp -indent 4 $bson]"
+	  set r [::nx::mongo::db insert $mongo_ns $bson]
 	  set :_id [lindex $r 2]
 	}
       }
     }
   }
   
-}
\ No newline at end of file
+}