couldn't read file "./huddle_types.tcl": no such file or directory
    while executing
"source [file join $selfdir huddle_types.tcl]"
    (lambda term "{selfdir} {
    source [file join $selfdir huddle_types.tcl]..." line 2)
    invoked from within
"apply {{selfdir} {
    source [file join $selfdir huddle_types.tcl]

    foreach typeNamespace [namespace children ::huddle::types] {
        addType ..."
    (in namespace eval "::request" script line 637)
    invoked from within
"namespace eval ::request $script"
    ("::try" body line 12)

OUTPUT BUFFER:

# huddle.tcl (working title) # # huddle.tcl 0.1.5 2011-08-23 14:46:47 KATO Kanryu(kanryu6@users.sourceforge.net) # # It is published with the terms of tcllib's BSD-style license. # See the file named license.terms. # # This library provide functions to differentinate string/list/dict in multi-ranks. # # Copyright (c) 2008-2011 KATO Kanryu # Copyright (c) 2015 Miguel Martínez López package require Tcl 8.5 package provide huddle 0.2 namespace eval ::huddle { namespace export huddle wrap unwrap isHuddle strip_node are_equal_nodes argument_to_node get_src variable types # Some subcommands conflict with Tcl builtin commands. So, we make # the convention of using the first letter in uppercase for # private procs (e.g. from "set" to "Set") namespace ensemble create -map { set ::huddle::Set append ::huddle::Append get ::huddle::Get get_stripped ::huddle::get_stripped unset ::huddle::Unset combine ::huddle::combine combine_relaxed ::huddle::combine_relaxed type ::huddle::type remove ::huddle::remove equal ::huddle::equal exists ::huddle::exists clone ::huddle::clone isHuddle ::huddle::isHuddle wrap ::huddle::wrap unwrap ::huddle::unwrap addType ::huddle::addType jsondump ::huddle::jsondump compile ::huddle::compile } } proc ::huddle::addType {typeNamespace} { variable types set typeName [namespace tail $typeNamespace] set typeCommand ::huddle::Type_$typeName namespace upvar $typeNamespace settings settings if {[dict exists $settings map]} { set ensemble_map_of_type [dict get $settings map] set renamed_subcommands [dict values $ensemble_map_of_type] } else { set renamed_subcommands [list] } dict set ensemble_map_of_type settings ${typeNamespace}::settings foreach path_to_subcommand [info procs ${typeNamespace}::*] { set subcommand [namespace tail $path_to_subcommand] if {$subcommand ni $renamed_subcommands} { dict set ensemble_map_of_type $subcommand ${typeNamespace}::$subcommand } } namespace eval $typeNamespace " namespace import ::huddle::wrap ::huddle::unwrap ::huddle::isHuddle ::huddle::strip_node ::huddle::are_equal_nodes ::huddle::argument_to_node ::huddle::get_src namespace ensemble create -unknown ::huddle::unknown_subcommand -command $typeCommand -prefixes false -map {$ensemble_map_of_type} proc settings {} { variable settings return \$settings } " set huddle_map [namespace ensemble configure ::huddle -map] dict with settings { foreach subcommand $publicMethods { dict set huddle_map $subcommand [list $typeCommand $subcommand] } if {[info exists superclass]} { set types(superclass:$tag) $superclass } set types(type:$tag) $typeName set types(callback:$tag) $typeCommand set types(isContainer:$tag) $isContainer set types(tagOfType:$typeName) $tag } namespace ensemble configure ::huddle -map $huddle_map return } proc ::huddle::is_superclass_of {tag1 tag2} { variable types if {![info exists types(list_of_superclasses:$tag1)]} { set types(list_of_superclasses:$tag1) [list] set superclass_tag $tag1 while {true} { if {[info exists types(superclass:$superclass_tag)]} { set superclass $types(superclass:$superclass_tag) set superclass_tag $types(tagOfType:$superclass) lappend types(list_of_superclasses:$tag1) $superclass_tag } else { break } } } if {$tag2 in $types(list_of_superclasses:$tag1) } { return 1 } else { return 0 } } proc ::huddle::unknown_subcommand {ensembleCmd subcommand args} { set settings [$ensembleCmd settings] if {[dict exists $settings superclass]} { set superclass [dict get $settings superclass] set map [namespace ensemble configure $ensembleCmd -map] dict set map $subcommand [list ::huddle::Type_$superclass $subcommand] namespace ensemble configure $ensembleCmd -map $map return "" } else { error "Invalid subcommand '$subcommand' for type '$ensembleCmd'" } } proc ::huddle::isHuddle {obj} { if {[lindex $obj 0] ne "HUDDLE" || [llength $obj] != 2} { return 0 } variable types set node [lindex $obj 1] set tag [lindex $node 0] if { [array get types "type:$tag"] == ""} { return 0 } return 1 } proc ::huddle::strip_node {node} { variable types foreach {head src} $node break if {[info exists types(type:$head)]} { if {$types(isContainer:$head)} { return [$types(callback:$head) strip $src] } else { return $src } } else { error "This head '$head' doesn't exists." } } proc ::huddle::call {tag cmd arguments} { variable types return [$types(callback:$tag) $cmd {*}$arguments] } proc ::huddle::combine {args} { variable types foreach {obj} $args { checkHuddle $obj } set first_object [lindex $args 0] set tag_of_group [lindex [unwrap $first_object] 0] foreach {obj} $args { set node [unwrap $obj] foreach {tag src} $node break if {$tag_of_group ne $tag} { if {[is_superclass_of $tag $tag_of_group]} { set tag_of_group $tag } else { if {![is_superclass_of $tag_of_group $tag]} { error "unmatched types are given or one type is not a superclass of the other." } } } lappend result {*}$src } set src [$types(callback:$tag_of_group) append_subnodes "" {} $result] return [wrap [list $tag $src]] } proc ::huddle::checkHuddle {huddle_object} { if {![isHuddle $huddle_object]} { error "\{$huddle_object\} is not a huddle." } } proc ::huddle::argument_to_node {src {default_tag s}} { if {[isHuddle $src]} { return [unwrap $src] } else { return [list $default_tag $src] } } proc ::huddle::wrap { node } { return [list HUDDLE $node] } proc ::huddle::unwrap { huddle_object } { return [lindex $huddle_object 1] } proc ::huddle::get_src { huddle_object } { return [lindex [unwrap $huddle_object] 1] } proc ::huddle::Get {huddle_object args} { return [retrieve_huddle $huddle_object $args 0] } proc ::huddle::get_stripped {huddle_object args} { return [retrieve_huddle $huddle_object $args 1] } proc ::huddle::retrieve_huddle {huddle_object path stripped} { checkHuddle $huddle_object set target_node [Find_node [unwrap $huddle_object] $path] if {$stripped} { return [strip_node $target_node] } else { return [wrap $target_node] } } proc ::huddle::type {huddle_object args} { variable types checkHuddle $huddle_object set target_node [Find_node [unwrap $huddle_object] $args] foreach {tag src} $target_node break return $types(type:$tag) } proc ::huddle::Find_node {node path} { variable types set subnode $node foreach subpath $path { foreach {tag src} $subnode break set subnode [$types(callback:$tag) get_subnode $src $subpath] } return $subnode } proc ::huddle::exists {huddle_object args} { variable types checkHuddle $huddle_object set subnode [unwrap $huddle_object] foreach key $args { foreach {tag src} $subnode break if {$types(isContainer:$tag) && [$types(callback:$tag) exists $src $key] } { set subnode [$types(callback:$tag) get_subnode $src $key] } else { return 0 } } return 1 } proc ::huddle::equal {obj1 obj2} { checkHuddle $obj1 checkHuddle $obj2 return [::huddle::are_equal_nodes [unwrap $obj1] [unwrap $obj2]] } proc ::huddle::are_equal_nodes {node1 node2} { variable types foreach {tag1 src1} $node1 break foreach {tag2 src2} $node2 break if {$tag1 ne $tag2} {return 0} return [$types(callback:$tag1) equal $src1 $src2] } proc ::huddle::Append {objvar args} { variable types upvar 1 $objvar obj checkHuddle $obj foreach {tag src} [unwrap $obj] break set src [$types(callback:$tag) append_subnodes $tag $src $args] set obj [wrap [list $tag $src]] return $obj } proc ::huddle::Set {objvar args} { upvar 1 $objvar obj checkHuddle $obj set path [lrange $args 0 end-1] set new_subnode [argument_to_node [lindex $args end]] set root_node [unwrap $obj] # We delete the internal reference of $obj to $root_node # Now refcount of $root_node is 1 unset obj Apply_to_subnode set root_node [llength $path] $path $new_subnode set obj [wrap $root_node] } proc ::huddle::remove {obj args} { checkHuddle $obj set modified_node [remove_node [unwrap $obj] [llength $args] $args] set obj [wrap $modified_node] } proc ::huddle::remove_node {node len path} { variable types foreach {tag src} $node break set first_key_to_removed_subnode [lindex $path 0] if {$len > 1} { if { $types(isContainer:$tag) } { set subpath_to_removed_subnode [lrange $path 1 end] incr len -1 set new_src "" foreach item [$types(callback:$tag) items $src] { foreach {key subnode} $item break if {$key eq $first_key_to_removed_subnode} { set modified_subnode [::huddle::remove_node $subnode $len $subpath_to_removed_subnode] $types(callback:$tag) set new_src $key $modified_subnode } else { set cloned_subnode [Clone_node $subnode] $types(callback:$tag) set new_src $key $cloned_subnode } } return [list $tag $new_src] } else { error "\{$src\} don't have any child node." } } else { $types(callback:$tag) remove src $first_key_to_removed_subnode return [list $tag $src] } } proc ::huddle::Unset {objvar args} { upvar 1 $objvar obj checkHuddle $obj set root_node [unwrap $obj] # We delete the internal reference of $obj to $root_node # Now refcount of $root_node is 1 unset obj Apply_to_subnode remove root_node [llength $args] $args set obj [wrap $root_node] } proc ::huddle::clone {obj} { set cloned_node [Clone_node [unwrap $obj]] return [wrap $cloned_node] } proc ::huddle::Clone_node {node} { variable types foreach {tag src} $node break if { $types(isContainer:$tag) } { set cloned_src "" foreach item [$types(callback:$tag) items $src] { foreach {key subnode} $item break set cloned_subnode [Clone_node $subnode] $types(callback:$tag) set cloned_src $key $cloned_subnode } return [list $tag $cloned_src] } else { return $node } } proc ::huddle::Apply_to_subnode {subcommand node_var len path {subcommand_arguments ""}} { variable types upvar 1 $node_var node foreach {tag src} $node break # We delete $src from $node. # In that position there is only an empty string. # This way, the refcount of $src is 1 lset node 1 "" # We get the fist key. This information is used in the recursive case ($len>1) and in the base case ($len==1). set key [lindex $path 0] if {$len > 1} { set subpath [lrange $path 1 end] incr len -1 if { $types(isContainer:$tag) } { set subnode [$types(callback:$tag) get_subnode $src $key] # We delete the internal reference of $src to $subnode. # Now refcount of $subnode is 1 $types(callback:$tag) delete_subnode_but_not_key src $key ::huddle::Apply_to_subnode $subcommand subnode $len $subpath $subcommand_arguments # We add again the new $subnode to the original $src $types(callback:$tag) set src $key $subnode # We add again the new $src to the parent node lset node 1 $src } else { error "\{$src\} don't have any child node." } } else { if {![info exists types(type:$tag)]} {error "\{$src\} is not a huddle node."} $types(callback:$tag) $subcommand src $key $subcommand_arguments lset node 1 $src } } proc ::huddle::jsondump {huddle_object {offset " "} {newline "\n"} {begin ""}} { variable types set nextoff "$begin$offset" set nlof "$newline$nextoff" set sp " " if {[string equal $offset ""]} {set sp ""} set type [huddle type $huddle_object] switch -- $type { boolean - number - null { return [huddle get_stripped $huddle_object] } string { set data [huddle get_stripped $huddle_object] # JSON permits only oneline string set data [string map { \n \\n \t \\t \r \\r \b \\b \f \\f \\ \\\\ \" \\\" / \\/ } $data ] return "\"$data\"" } list { set inner {} set len [huddle llength $huddle_object] for {set i 0} {$i < $len} {incr i} { set subobject [huddle get $huddle_object $i] lappend inner [jsondump $subobject $offset $newline $nextoff] } if {[llength $inner] == 1} { return "\[[lindex $inner 0]\]" } return "\[$nlof[join $inner ,$nlof]$newline$begin\]" } dict { set inner {} foreach {key} [huddle keys $huddle_object] { lappend inner [subst {"$key":$sp[jsondump [huddle get $huddle_object $key] $offset $newline $nextoff]}] } if {[llength $inner] == 1} { return $inner } return "\{$nlof[join $inner ,$nlof]$newline$begin\}" } default { return [$types(callback:$type) jsondump $data $offset $newline $nextoff] } } } # data is plain old tcl values # spec is defined as follows: # {string} - data is simply a string, "quote" it if it's not a number # {list} - data is a tcl list of strings, convert to JSON arrays # {list list} - data is a tcl list of lists # {list dict} - data is a tcl list of dicts # {dict} - data is a tcl dict of strings # {dict xx list} - data is a tcl dict where the value of key xx is a tcl list # {dict * list} - data is a tcl dict of lists # etc.. proc ::huddle::compile {spec data} { while {[llength $spec]} { set type [lindex $spec 0] set spec [lrange $spec 1 end] switch -- $type { dict { if {![llength $spec]} { lappend spec * string } set result [huddle create] foreach {key value} $data { foreach {matching_key subspec} $spec { if {[string match $matching_key $key]} { Append result $key [compile $subspec $value] break } } } return $result } list { if {![llength $spec]} { set spec string } else { set spec [lindex $spec 0] } set result [huddle list] foreach list_item $data { Append result [compile $spec $list_item] } return $result } string { return [wrap [list s $data]] } number { if {[string is double -strict $data]} { return [wrap [list num $data]] } else { error "Bad number: $data" } } bool { if {$data} { return [wrap [list bool true]] } else { return [wrap [list bool false]] } } null { if {$data eq ""} { return [wrap [list null]] } else { error "Data must be an empty string: '$data'" } } huddle { if {[isHuddle $data]} { return $data } else { error "Data is not a huddle object: $data" } } default {error "Invalid type: '$type'"} } } } apply {{selfdir} { source [file join $selfdir huddle_types.tcl] foreach typeNamespace [namespace children ::huddle::types] { addType $typeNamespace } return } ::huddle} [file dirname [file normalize [info script]]] return