Index: TODO
===================================================================
diff -u -rfe68b259d9a15328a04a9dc64394dc5ffe5ba5a4 -rc85ca5808548fc506bfc39600bafb8b11ecfac43
--- TODO	(.../TODO)	(revision fe68b259d9a15328a04a9dc64394dc5ffe5ba5a4)
+++ TODO	(.../TODO)	(revision c85ca5808548fc506bfc39600bafb8b11ecfac43)
@@ -2607,6 +2607,11 @@
   * improve documentation
   * added handling of bson types for timestamps and dates
   * provide setup based on mongo_db, mongo_collection and mongo_ns
+  * implemented type "reference" similar to "embedded"
+  * all referenced objects are for the time being auto-dereferenced
+  * new method "show" for mongo mapped classes
+  * added two new example files example-nx-reference-many.tcl and
+    example-nx-reference-one.tcl
 
 TODO:
 
Index: library/mongodb/example-nx-mongo.tcl
===================================================================
diff -u -rfe68b259d9a15328a04a9dc64394dc5ffe5ba5a4 -rc85ca5808548fc506bfc39600bafb8b11ecfac43
--- library/mongodb/example-nx-mongo.tcl	(.../example-nx-mongo.tcl)	(revision fe68b259d9a15328a04a9dc64394dc5ffe5ba5a4)
+++ library/mongodb/example-nx-mongo.tcl	(.../example-nx-mongo.tcl)	(revision c85ca5808548fc506bfc39600bafb8b11ecfac43)
@@ -1,5 +1,7 @@
 #
-# This is an example how to use the nx mongo mapping.
+# This is an example how to use the nx mongo mapping.  We show here
+# single class mapped to the mongo db with sing and multivalued
+# scalars together with some querying options.
 #
 # Gustaf Neumann              fecit, April 2011
 #
@@ -93,17 +95,3 @@
   puts "\t$p:\t[$p name]"
 }
 
-
-nx::mongo::Class create Users {
-  :attribute name:required
-}
-
-nx::mongo::Class create Post {
-  :attribute title:required
-  :attribute user_id
-}
-
-set u [Users new -name Smith]
-$u save
-set p [Post new -title "Hello World" -user_id [$u _id]]
-$p save
\ No newline at end of file
Index: library/mongodb/example-nx-reference-many.tcl
===================================================================
diff -u
--- library/mongodb/example-nx-reference-many.tcl	(revision 0)
+++ library/mongodb/example-nx-reference-many.tcl	(revision c85ca5808548fc506bfc39600bafb8b11ecfac43)
@@ -0,0 +1,144 @@
+#
+# This is an introductory example how to use the nx mongo mapping for
+# referencing some objects. We use here an example of a Group having
+# a (possible compound) users as members.
+#
+# Gustaf Neumann              fecit, May 2011
+#
+package require nx::mongo
+
+# Establish connection to the database
+::nx::mongo::db connect -db "tutorial"
+
+# Make sure, we start always from scratch
+nx::mongo::db remove tutorial.groups {}
+nx::mongo::db remove tutorial.members {}
+
+######################################################################
+# The first approach to implement references simply as multivalued
+# attributes. This is just feasible in cases, where the user has just
+# a name and not more attributes.
+#
+nx::mongo::Class create Group {
+  :attribute name
+  :attribute members:0..n
+}
+
+Group insert -name "grp1" -members {gustaf stefan}
+
+# Retrieve the entry from the database:
+set g [Group find first -cond {name = "grp1"}]
+puts stderr "Members of group: [$g members]\n"
+
+######################################################################
+# The second approach to implement references to other objects via an
+# attribute pointing to the object ids of other objects. This is
+# similar to the classical datbase approach. When the object is
+# fetched, the application developer has to care about
+# fetching/dereferencing the referenced objects.
+#
+nx::mongo::Class create Member {
+  :attribute name
+}
+nx::mongo::Class create Group {
+  :attribute name
+  :attribute members:0..n
+}
+
+set id1 [Member insert -name gustaf] 
+set id2 [Member insert -name stefan]
+Group insert -name "grp2" -members [list $id1 $id2]
+
+# Retrieve the entry from the database:
+set g [Group find first -cond {name = "grp2"}]
+set members [list]
+foreach m [$g members] {
+  lappend members [Member find first -cond [list _id = $m]]
+}
+puts stderr "Members of group [$g name]:"
+foreach m $members {puts stderr "\t[$m name]"}
+puts stderr ""
+
+######################################################################
+# The third approach is to embed the objects in the referencing
+# document. This might be feasible when the values of the embedded
+# objects seldomly change, When the containing object (the posting) is
+# loaded, the appropriate object structure is created automatically.
+#
+nx::mongo::Class create Member {
+  :attribute name
+}
+nx::mongo::Class create Group {
+  :attribute name
+  :attribute members:embedded,arg=::Member,0..n
+}
+
+Group insert -name "grp3" \
+    -members [list \
+		  [Member new -name gustaf] \
+		  [Member new -name stefan]]
+
+# Retrieve the entry from the database:
+set g [Group find first -cond {name = "grp3"}]
+
+puts stderr "Members of group [$g name]:"
+foreach m [$g members] {puts stderr "\t[$m name]"}
+puts stderr ""
+
+
+######################################################################
+# The fourth approach is to use mongo db-refs for referencing.  This
+# is similar to approach two, but provides support for dereferencing
+# and maintaining the reference lists.
+#
+nx::mongo::Class create Member {
+  :attribute name
+}
+nx::mongo::Class create Group {
+  :attribute name
+  :attribute members:reference,arg=::Member,0..n
+}
+
+Group insert -name "grp4" \
+    -members [list \
+		  [Member new -name gustaf] \
+		  [Member new -name stefan]]
+
+# Retrieve the entry from the database:
+set g [Group find first -cond {name = "grp4"}]
+
+puts stderr "Members of group [$g name]:"
+foreach m [$g members] {puts stderr "\t[$m name]"}
+puts stderr ""
+
+puts stderr "Content of collection groups:"
+Group show
+
+# Content of collection groups:
+# {
+#     _id: 4daae3e492b5570e00000000, 
+#     name: grp1, 
+#     members: [ gustaf, stefan ]
+# }, {
+#     _id: 4daae3e492b5570e00000003, 
+#     name: grp2, 
+#     members: [ 4daae3e492b5570e00000001, 4daae3e492b5570e00000002 ]
+# }, {
+#     _id: 4daae3e492b5570e00000004, 
+#     name: grp3, 
+#     members: [ { 
+#       name: gustaf }, { 
+#       name: stefan } ]
+# }, {
+#     _id: 4daae3e492b5570e00000007, 
+#     name: grp4, 
+#     members: [ { 
+#       $ref: members, 
+#       $id: 4daae3e492b5570e00000005, 
+#       $db: tutorial }, { 
+#       $ref: members, 
+#       $id: 4daae3e492b5570e00000006, 
+#       $db: tutorial } ]
+# }
+
+
Index: library/mongodb/example-nx-reference-one.tcl
===================================================================
diff -u
--- library/mongodb/example-nx-reference-one.tcl	(revision 0)
+++ library/mongodb/example-nx-reference-one.tcl	(revision c85ca5808548fc506bfc39600bafb8b11ecfac43)
@@ -0,0 +1,122 @@
+#
+# This is an introductory example how to use the nx mongo mapping for
+# referencing some object. We use here an example of an Posting having
+# a (possible compound) user as originator. All example work the same
+# way as well with with multivalued attributes.
+#
+# Gustaf Neumann              fecit, May 2011
+#
+package require nx::mongo
+
+# Establish connection to the database
+::nx::mongo::db connect -db "tutorial"
+
+# Make sure, we start always from scratch
+nx::mongo::db remove tutorial.users {}
+nx::mongo::db remove tutorial.posts {}
+
+######################################################################
+# The first approach to implement references simply as an attribute.
+# This is just feasible in cases, where the user has just a name and
+# not more attributes.
+#
+nx::mongo::Class create Post {
+  :attribute title
+  :attribute user
+}
+
+Post insert -title "Hello trivial World" -user smith
+
+# Retrieve the entry from the database:
+set p [Post find first -cond {title = "Hello trivial World"}]
+puts stderr "Name of user: [$p user]\n"
+
+######################################################################
+# The second approach to implement references to other objects via an
+# attribute pointing to the object id of an other object. This is the
+# classical datbase approach. When the object is fetched, the
+# application developer has to care about fetching/dereferencing the
+# referenced object.
+#
+nx::mongo::Class create User {
+  :attribute name
+}
+nx::mongo::Class create Post {
+  :attribute title
+  :attribute user_id
+}
+
+# The method "insert" returns the object id of the newly created
+# object. We can use this value as a reference in the Post.
+set uid [User insert -name Smith]
+Post insert -title "Hello simple World" -user_id $uid
+
+# Retrieve the entry from the database:
+set p [Post find first -cond {title = "Hello simple World"}]
+set u [User find first -cond [list _id = [$p user_id]]]
+puts stderr "Name of user: [$u name]\n"
+
+######################################################################
+# The third approach is to embed the object in the referencing
+# document. This might be feasible when the values of the embedded
+# objects seldomly change, When the containing object (the posting) is
+# loaded, the appropriate object structure is created automatically.
+#
+nx::mongo::Class create User {
+  :attribute name
+}
+nx::mongo::Class create Post {
+  :attribute title
+  :attribute user:embedded,arg=::User
+}
+
+Post insert -title "Hello embedded World" -user [User new -name Smith]
+
+# Retrieve the entry from the database:
+set p [Post find first -cond {title = "Hello embedded World"}]
+puts stderr "Name of user: [[$p user] name]\n"
+
+######################################################################
+# The fourth approach is to use mongo db-refs for referencing.  This
+# is similar to approach two, but provides support for dereferencing
+# and maintaining the reference lists.
+#
+nx::mongo::Class create User {
+  :attribute name
+}
+nx::mongo::Class create Post {
+  :attribute title
+  :attribute user:reference,arg=::User
+}
+
+Post insert -title "Hello referenced World" -user [User new -name Smith]
+
+# Retrieve the entry from the database:
+set p [Post find first -cond {title = "Hello referenced World"}]
+puts stderr "Name of user: [[$p user] name]\n"
+
+puts stderr "Content of the collection groups:"
+Post show
+
+# Content of the collection groups:
+# {
+#     _id: 4daae48056b77f0e00000000, 
+#     title: {Hello trivial World}, 
+#     user: smith
+# }, {
+#     _id: 4daae48056b77f0e00000002, 
+#     title: {Hello simple World}, 
+#     user_id: 4daae48056b77f0e00000001
+# }, {
+#     _id: 4daae48056b77f0e00000003, 
+#     title: {Hello embedded World}, 
+#     user: { 
+#       name: Smith }
+# }, {
+#     _id: 4daae48056b77f0e00000005, 
+#     title: {Hello referenced World}, 
+#     user: { 
+#       $ref: users, 
+#       $id: 4daae48056b77f0e00000004, 
+#       $db: tutorial }
+# }
Index: library/mongodb/nx-mongo.tcl
===================================================================
diff -u -rfe68b259d9a15328a04a9dc64394dc5ffe5ba5a4 -rc85ca5808548fc506bfc39600bafb8b11ecfac43
--- library/mongodb/nx-mongo.tcl	(.../nx-mongo.tcl)	(revision fe68b259d9a15328a04a9dc64394dc5ffe5ba5a4)
+++ library/mongodb/nx-mongo.tcl	(.../nx-mongo.tcl)	(revision c85ca5808548fc506bfc39600bafb8b11ecfac43)
@@ -8,7 +8,8 @@
 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: make embedded, reference spec nicer
+# todo: all references are currently auto-fetched. make this optional
 # 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)
@@ -29,7 +30,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 {
@@ -46,7 +47,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}
 	}
@@ -74,18 +76,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]
       }
@@ -130,8 +166,33 @@
 	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::isobject $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 {
     
     #
@@ -197,6 +258,7 @@
     }
     
     :method "bson parameter" {tuple} {
+      #puts "bson parameter $tuple"
       set objParams [list]
       foreach {att type value} $tuple {
 	set slot [:get slot $att]
@@ -214,6 +276,32 @@
       }
     }
 
+    :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
@@ -238,7 +326,9 @@
     :public method insert {args} {
       set p [:new {*}$args]
       $p save
+      set _id [$p _id]
       $p destroy
+      return $_id
     }
 
     #
@@ -285,13 +375,33 @@
       }
       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 "mongo_ns is set to ${: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."
 	}
@@ -303,7 +413,7 @@
 	  set :mongo_db [::nx::mongo::db db]
 	}
 	set :mongo_ns ${:mongo_db}.${:mongo_collection}
-	puts stderr "mongo_ns is set to ${:mongo_ns}"
+	#puts stderr "mongo_ns is set to ${:mongo_ns}"
       }
     }
 
@@ -316,18 +426,9 @@
       :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")
   #
@@ -355,42 +456,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 {} {
@@ -414,13 +480,29 @@
     :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]} {
@@ -445,10 +527,10 @@
       } else {
 	set bson [:bson encode]
 	if {[info exists :_id]} {
-	  puts stderr "we have to update [:bson pp -indent 4 $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]"
+	  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]
 	}