Index: TODO =================================================================== diff -u -rc81b840c71a9f0de9d0a502e3e4ddfde57b81fdd -rec9e525c887a0ae430bdb35bef01f499b25d617f --- TODO (.../TODO) (revision c81b840c71a9f0de9d0a502e3e4ddfde57b81fdd) +++ TODO (.../TODO) (revision ec9e525c887a0ae430bdb35bef01f499b25d617f) @@ -2585,6 +2585,8 @@ - Let "info slot" return the slot object - nx::mongo: Initial commit of the experimental mongoDB interface for nx +- nx.tcl: fix handling of arg in converter + TODO: - how to delete attributes? Index: library/mongodb/README =================================================================== diff -u -r433066d5cd921df865e2b34685caf7a2b8e0035a -rec9e525c887a0ae430bdb35bef01f499b25d617f --- library/mongodb/README (.../README) (revision 433066d5cd921df865e2b34685caf7a2b8e0035a) +++ library/mongodb/README (.../README) (revision ec9e525c887a0ae430bdb35bef01f499b25d617f) @@ -37,8 +37,15 @@ This example script is using the higher level object oriented interface for nx (nx::mongo). -After running the scripts, you should see output like the following +After running the scripts, you should see output like the one below. + % /usr/local/bin/mongo + MongoDB shell version: 1.9.0-pre- + connecting to: test + > use tutorial + switched to db tutorial + > db.persons.find(); + -gustaf neumann =============================================================== Index: library/mongodb/example-nx-bi.tcl =================================================================== diff -u --- library/mongodb/example-nx-bi.tcl (revision 0) +++ library/mongodb/example-nx-bi.tcl (revision ec9e525c887a0ae430bdb35bef01f499b25d617f) @@ -0,0 +1,74 @@ +# +# The Business Insider Data Model +# +# { title: 'Too Big to Fail', +# author: 'John S.', +# ts: Date('05-Nov-09 10:33'), +# [ comments: [ {author: 'Ian White', +# comment: 'Great Article!' }, +# {author: 'Joe Smith', +# comment: 'But how fast is it?', +# replies: [ {author: Jane Smith', +# comment: 'scalable?' }] +# } +# ], +# tags: ['finance', 'economy'] +# } + +# +# This is an example how to use the nx mongo mapping. +# +# Gustaf Neumann fecit, April 2011 +# +package require nx::mongo +package require nx::serializer + +# Establish connection to the database +::nx::mongo::db connect + +# Make sure, we start always from scratch +nx::mongo::db remove tutorial.bi {} + +# +# Create the application classes +# + +# TODO: +# - make embedded spec nicer +# - handle delete of mebedded obj +# - + + +nx::mongo::Class create Comment { + #:document "tutorial.bi" + + :attribute author:required + :attribute comment:required + :attribute replies:embedded,arg=::Comment,0..n {set :incremental 1} +} + +nx::mongo::Class create Posting { + :document "tutorial.bi" + :index ts + :attribute title:required + :attribute author:required + :attribute ts:required + :attribute comments:embedded,arg=::Comment,0..n { + #set :incremental 1 + } + :attribute tags:0..n +} +#puts stderr [Posting serialize] + +set p [Posting new -title "Too Big to Fail" -author "John S." -ts "05-Nov-09 10:33" -tags {finance economy} \ + -comments [list \ + [Comment new -author "Ian White" -comment "Great Article!"] \ + [Comment new -author "Joe Smith" -comment "But how fast is it?" \ + -replies [list [Comment new -author "Jane Smith" -comment "scalable?"]]] \ + ]] + +#puts [$p serialize] + +puts stderr ==== +$p save +puts stderr ====EXIT \ No newline at end of file Index: library/mongodb/example-nx-mongo.tcl =================================================================== diff -u -ra978b09df089800818fb317d67286d9082164f91 -rec9e525c887a0ae430bdb35bef01f499b25d617f --- library/mongodb/example-nx-mongo.tcl (.../example-nx-mongo.tcl) (revision a978b09df089800818fb317d67286d9082164f91) +++ library/mongodb/example-nx-mongo.tcl (.../example-nx-mongo.tcl) (revision ec9e525c887a0ae430bdb35bef01f499b25d617f) @@ -6,10 +6,10 @@ package require nx::mongo # Establish connection to the database -set mongoConn [::mongo::connect] +::nx::mongo::db connect # Make sure, we start always from scratch -::mongo::remove $mongoConn tutorial.persons {} +nx::mongo::db remove tutorial.persons {} # # Create the application class "Person" Index: library/mongodb/nx-mongo.tcl =================================================================== diff -u -rc81b840c71a9f0de9d0a502e3e4ddfde57b81fdd -rec9e525c887a0ae430bdb35bef01f499b25d617f --- library/mongodb/nx-mongo.tcl (.../nx-mongo.tcl) (revision c81b840c71a9f0de9d0a502e3e4ddfde57b81fdd) +++ library/mongodb/nx-mongo.tcl (.../nx-mongo.tcl) (revision ec9e525c887a0ae430bdb35bef01f499b25d617f) @@ -11,251 +11,326 @@ # todo: handle embedded bson objects # todo: handle named nx objects (e.g. attribute _oid?} -# -# nx::mongo::Attribute is a specialized attribute slot -# -::nx::MetaSlot create ::nx::mongo::Attribute -superclass ::nx::Attribute { - :attribute mongotype +namespace eval ::nx::mongo { - :protected method init {} { + ::nx::Object create ::nx::mongo::db { + :public method connect {args} {set :mongoConn [::mongo::connect {*}$args]} + :public method index {args} {::mongo::index ${:mongoConn} {*}$args} + :public method insert {args} {::mongo::insert ${:mongoConn} {*}$args} + :public method remove {args} {::mongo::remove ${:mongoConn} {*}$args} + :public method query {args} {::mongo::query ${:mongoConn} {*}$args} + :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 { + :attribute mongotype + + :protected method init {} { + # + # If the mongotype was not provided, set it to a value derived + # from "type". Not all types are mappable easily to mongo types. + # + if {![info exists :mongotype]} { + set :mongotype string + if {[info exists :type]} { + puts stderr "type of ${:name} is ${:type}" + switch -glob ${:type} { + "boolean" - + "integer" {set :mongotype ${:type}} + "embedded" {set :mongotype object} + } + #"::*" {set :mongotype object} + } + } + puts stderr "mongo type of ${:name} is ${:mongotype} [info exists :type]" + next + } + # - # If the mongotype was not provided, set it to a value derived - # from "type". Not all types are mappable easily to mongo types. + # The methods "bson encode|decode" perform the low level type + # mapping. For now, this handles just the array notation. # - if {![info exists :mongotype]} { - set :mongotype string - if {[info exists :type]} { - switch ${:type} { - "boolean" - - "integer" {set :mongotype ${:type}} + :method "bson decode" {bsontype value} { + #puts stderr "bson decode of ${:name} /$bsontype/ '$value'" + if {$bsontype eq "array"} { + if {![:isMultivalued]} { + # We got an array, but the slot is not multivalued. Maybe + # generating an error is too harsh, but for the mapping back, + # we check for multivalued as well. + error "Attribute ${:name} should be multivalued, but it is not" } + set result [list] + foreach {pos type v} $value {lappend result $v} + return $result } + return $value } - next - } + + :method "bson encodeValue" {value} { + if {${:mongotype} eq "object"} { + return [list ${:mongotype} [$value bson encode]] + } else { + return [list ${:mongotype} $value] + } + } - # - # The methods "bson encode|decode" perform the low level type - # mapping. For now, this handles just the array notation. - # - :method "bson decode" {bsontype value} { - #puts stderr "bson decode of ${:name} /$bsontype/ '$value'" - if {$bsontype eq "array"} { - if {![:isMultivalued]} { - # We got an array, but the slot is not multivalued. Maybe - # generating an error is too harsh, but for the mapping back, - # we check for multivalued as well. - error "Attribute ${:name} should be multivalued, but it is not" + :method "bson encode" {value} { + if {[:isMultivalued]} { + set c -1 + set array [list] + foreach v $value {lappend array [incr c] {*}[:bson encodeValue $v]} + return [list array $array] + } else { + return [:bson encodeValue $value] } - set result [list] - foreach {pos type v} $value {lappend result $v} - return $result } - return $value - } - :method "bson encode" {value} { - if {[:isMultivalued]} { - set c -1 - set array [list] - foreach v $value {lappend array [incr c] ${:mongotype} $v} - return [list array $array] - } else { - return [list ${:mongotype} $value] + # + # + # + :public method type=embedded {name value args} { + set s [:uplevel self] + puts stderr "assign $name '$value' args='$args' s=$s" + if {[::nsf::isobject $value] && [::nsf::is class $args] && [$value info has type $args]} { + ::nsf::var::set $value _embedded_in [list $s $name] + puts stderr [list ::nsf::var::set $value _embedded_in [list $s $name]] + } else { + error "value '$value' for attribute $name is not of type $args" + } } } -} - -nx::Class create nx::mongo::Class -superclass nx::Class { - # - # Every mongo class can be configured with a document, from which - # its instance data is queried. - # - :attribute document - - # - # Provide helper methods to access from an external specifier - # (attribute name or operator name) internal representations - # (eg. mongo type, or mongo operator). - # - - :method "get slot" {att} { - set classes [concat [self] [:info mixin classes] [:info heritage]] - foreach cls $classes { - set slot [$cls info slot $att] - if {$slot ne ""} { - return $slot + ::nx::Class create ::nx::mongo::Class -superclass nx::Class { + + # + # Every mongo class can be configured with a document, from which + # its instance data is queried. + # + :attribute document + + # + # Provide helper methods to access from an external specifier + # (attribute name or operator name) internal representations + # (eg. mongo type, or mongo operator). + # + + :method "get slot" {att} { + set classes [concat [self] [:info mixin classes] [:info heritage]] + foreach cls $classes { + set slot [$cls info slot $att] + if {$slot ne ""} { + return $slot + } } } - } - - :public method "get relop" {op} { - array set "" {< $lt > $gt <= $lte >= $gte != $ne} - return $($op) - } - - # - # For interaction with bson structures, we provide on the class - # level "bson query" (a small dsl for a more convenient syntax in - # bson queries) and "bson parameter" which translates from a bson - # structure (tuple) into a dashed parameter list used in object - # creation. - # - - :method "bson query" {{-cond ""} {-orderby ""}} { - set bson [list] - foreach {att op value} $cond { - set slot [:get slot $att] + + :public method "get relop" {op} { + array set "" {< $lt > $gt <= $lte >= $gte != $ne} + return $($op) + } + + # + # For interaction with bson structures, we provide on the class + # level "bson query" (a small dsl for a more convenient syntax in + # bson queries) and "bson parameter" which translates from a bson + # structure (tuple) into a dashed parameter list used in object + # creation. + # + + :method "bson query" {{-cond ""} {-orderby ""}} { + set bson [list] + foreach {att op value} $cond { + set slot [:get slot $att] switch $op { "=" {lappend bson $att [$slot mongotype] $value} ">" - "<" - "<=" - ">=" - "!=" { lappend bson $att object [list [:get relop $op] [$slot mongotype] $value] } default {error "unknown operator $op"} } + } + set result [list \$query object $bson] + if {[llength $orderby] > 0} { + set bson [list] + foreach attspec $orderby { + lassign $attspec att direction + lappend bson $att int [expr {$direction eq "desc" ? -1 : 1}] + } + lappend result \$orderby object $bson + } + puts "Query: $result" + return $result } - set result [list \$query object $bson] - if {[llength $orderby] > 0} { - set bson [list] - foreach attspec $orderby { - lassign $attspec att direction - lappend bson $att int [expr {$direction eq "desc" ? -1 : 1}] + + :method "bson parameter" {tuple} { + set objParams [list] + foreach {att type value} $tuple { + set slot [:get slot $att] + lappend objParams -$att [$slot bson decode $type $value] } - lappend result \$orderby object $bson + return $objParams } - puts "Query: $result" - return $result - } - - :method "bson parameter" {tuple} { - set objParams [list] - foreach {att type value} $tuple { - set slot [:get slot $att] - lappend objParams -$att [$slot bson decode $type $value] + + # + # Overload method attribute to provide "::nx::mongo::Attribute" as a + # default slot class + # + :public method attribute {spec {-class ::nx::mongo::Attribute} {initblock ""}} { + next [list $spec -class $class $initblock] } - return $objParams - } - - # - # Overload method attribute to provide "::nx::mongo::Attribute" as a - # default slot class - # - :public method attribute {spec {-class ::nx::mongo::Attribute} {initblock ""}} { - next [list $spec -class $class $initblock] - } - - # - # index method - # - :public method index {att {-type 1}} { - # todo: 2d index will need a different type - ::mongo::index $::mongoConn ${:document} [list $att int $type] - } - - # - # A convenience method for inserting a fresh tuple - # - :public method insert {args} { - set p [:new {*}$args] - $p save - $p destroy - } - - # - # The query interface consists currently of "find first" (returning - # a single instance) and "find all" (returning a list of instances). - # - :public method "find first" { - -instance - {-cond ""} - {-orderby ""} - } { - set fetched [::mongo::query $::mongoConn ${:document} \ - [:bson query -cond $cond -orderby $orderby] \ - -limit 1] - puts "[join $fetched \n]" - foreach tuple $fetched { - if {[info exists instance]} { - set o [:uplevel [list [self] create $instance {*}[:bson parameter $tuple]]] - return $o - } else { - return [:uplevel [list [self] new {*}[:bson parameter $tuple]]] + + # + # index method + # + :public method index {att {-type 1}} { + # todo: 2d index will need a different type + #::mongo::index $::mongoConn ${:document} [list $att int $type] + db index ${:document} [list $att int $type] + } + + # + # A convenience method for inserting a fresh tuple + # + :public method insert {args} { + set p [:new {*}$args] + $p save + $p destroy + } + + # + # The query interface consists currently of "find first" (returning + # a single instance) and "find all" (returning a list of instances). + # + :public method "find first" { + -instance + {-cond ""} + {-orderby ""} + } { + set fetched [::nx::mongo::db query ${:document} \ + [:bson query -cond $cond -orderby $orderby] \ + -limit 1] + puts "[join $fetched \n]" + foreach tuple $fetched { + if {[info exists instance]} { + set o [:uplevel [list [self] create $instance {*}[:bson parameter $tuple]]] + return $o + } else { + return [:uplevel [list [self] new {*}[:bson parameter $tuple]]] + } } } - } - - :public method "find all" { - {-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 [::mongo::query $::mongoConn ${:document} \ - [:bson query -cond $cond -orderby $orderby] \ - {*}$opts] - puts "[join $fetched \n]" - foreach tuple $fetched { - lappend result [:uplevel [list [self] new {*}[:bson parameter $tuple]]] + + :public method "find all" { + {-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 ${:document} \ + [:bson query -cond $cond -orderby $orderby] \ + {*}$opts] + puts "[join $fetched \n]" + foreach tuple $fetched { + lappend result [:uplevel [list [self] new {*}[:bson parameter $tuple]]] + } + return $result } - return $result + + # + # When a mongo::Class is created, mixin the mongo::Object to make + # "save" etc. available + # + + :method init {} { + :mixin add ::nx::mongo::Object + } + + # :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 + # } + } - + # - # When a mongo::Class is created, mixin the mongo::Object to make - # "save" etc. available + # The class mongo::Object provides methods for mongo objects (such as + # "save") # - - :method init {} { - :mixin add ::nx::mongo::Object - } + ::nx::Class create ::nx::mongo::Object { + + # + # _id is the special attribute maintained by mongoDB + # + :attribute _id -class ::nx::mongo::Attribute { + set :mongotype oid + } - # :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 - # } + # + # Encode all object data in bson notation + # + :method "bson encode" {} { + set bson [list] + set cls [:info class] + foreach var [:info vars] { + set slot [$cls get slot $var] + if {$slot ne ""} { + lappend bson $var {*}[$slot bson encode [set :$var]] + } + } + return $bson + } -} + # + # 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 + # } -# -# The class mongo::Object provides methods for mongo objects (such as -# "save") -# -nx::Class create nx::mongo::Object { - - # - # _id is the special attribute maintained by mongoDB - # - :attribute _id -class ::nx::mongo::Attribute { - set :mongotype oid - } - - # - # Save the current object. When we have an _id, perform an update, - # otherwise perform an insert - # - :public method save {} { - set bson [list] - set cls [:info class] - foreach var [:info vars] { - set slot [$cls get slot $var] - lappend bson $var {*}[$slot bson encode [set :$var]] + # + # delete the current object from the db + # + :public method delete {} { + set document [[:info class] document] + if {$document eq ""} { + set embeddedIn [...] + } else { + } } - if {[info exists :_id]} { - #puts stderr "we have to update $bson" - ::mongo::update $::mongoConn [$cls document] [list _id oid ${:_id}] $bson - } else { - #puts stderr "we have to insert $bson" - ::mongo::insert $::mongoConn [$cls document] $bson + + # + # Save the current object. When we have an _id, perform an update, + # otherwise perform an insert + # + :public method save {} { + set document [[:info class] document] + if {$document 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." + } else { + set bson [:bson encode] + if {[info exists :_id]} { + #puts stderr "we have to update $bson" + ::nx::mongo::db update $document [list _id oid ${:_id}] $bson + } else { + puts stderr "we have to insert $bson" + ::nx::mongo::db insert $document $bson + } + } } } - -} - + +} \ No newline at end of file