# A capability may be something like providing a folder of files, or just a data dictionary, and/or an API
#
# capability handler - a package/namespace which may provide validation and standardised ways of looking up provider data
# registered (or not) using register_capabilityname <capname> <capnamespace>
# capability provider - a package which registers as providing one or more capablities.
# registered using register_package <pkg> <capabilitylist>
# the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability
# A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::cap {
variable pkgcap [dict create]
variable pkgcapsdeclared [dict create]
variable pkgcapsaccepted [dict create]
variable caps [dict create]
if {[info commands [namespace current]::interface_caphandler.registry] eq ""} {
#A package registering as a provider using register_package can include capabilitynames in it's capabilitylist which have no associated capnamespace (handler).
#such unregistered capabilitynames may be used just to flag something, or have datamembers significant to callers cooperatively interested in that capname.
#we allow registering a capability with an empty handler (capnamespace) - but this means another handler could be registered later.
#normalize with leading :: in case caller passed in package name rather than fully qualified namespace
if {![string match ::* $capnamespace]} {
set capnamespace ::$capnamespace
}
}
#allow register of existing capname iff there is no current handler
#as handlers can be used to validate during provider registration - ideally handlers should be registered before any pkgs call register_package
#we allow loading a handler later though - but will need to validate existing data from pkgs that have already registered as providers
if {[set hdlr [get_handler $capname]] ne ""} {
error "register_capabilityname cannot register capability:$capname with handler:$capnamespace. There is already a registered handler:$hdlr"
}
#assert: capnamespace may or may not be empty string, capname may or may not already exist in caps dict, caps $capname providers may have existing entries.
dict set caps $capname handler $capnamespace
if {![dict exists $caps $capname providers]} {
dict set caps $capname providers [list]
}
if {[llength [set providers [dict get $caps $capname providers]]]} {
#some provider(s) were in place before the handler was registered
if {[set capreg [get_caphandler_registry $capname]] ne ""} {
foreach pkg $providers {
set fullcapabilitylist [dict get $pkgcapsdeclared $pkg]
foreach capspec $fullcapabilitylist {
lassign $capspec cn capdict
if {$cn ne $capname} {
continue
}
set do_register [$capreg pkg_register $pkg $capdict $fullcapabilitylist]
set list_accepted [dict get $pkgcapsaccepted $pkg]
if {$do_register} {
if {$capspec ni $list_accepted} {
dict lappend pkgcapsaccepted $pkg $capspec
}
} else {
set posn [lsearch $list_accepted $capspec]
if {$posn >=0} {
set list_accepted [lreplace $list_accepted $posn $posn]
dict set pkgcapsaccepted $pkg $list_accepted
}
}
}
#check if any accepted for this cap and remove from caps as necessary
set count 0
foreach accepted_capspec [dict get $pkgcapsaccepted $pkg] {
if {[lindex $accepted_capspec 0] eq $capname} {
incr count
}
}
if {$count == 0} {
set pkgposn [lsearch $providers $pkg]
if {$pkgposn >= 0} {
set updated_providers [lreplace $providers $posn $posn]
dict set caps $capname providers $updated_providers
}
}
}
}
}
}
proc exists {capname} {
variable caps
return [dict exists $caps $capname]
}
proc has_handler {capname} {
variable caps
return [expr {[dict exists $caps $capname handler] && [dict get $caps $capname handler] ne ""}]
}
proc get_handler {capname} {
variable caps
if {[dict exists $caps $capname]} {
return [dict get $caps $capname handler]
}
return ""
}
#dispatch
#proc call_handler {capname args} {
# if {[set handler [get_handler $capname]] eq ""} {
# error "punk::cap::call_handler $capname $args - no handler registered for capability $capname"
set tpath [file normalize [file join $tmfile [dict get $templates_dict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder
#relpath relative to file is important for tm files that are zip/tar based containers
if {[file isdirectory $tpath]} {
dict set folderdict $tpath [list source $pkg sourcetype package]
} else {
puts stderr "punk::cap::templates::folders WARNING - unable to determine base folder for package '$pkg' which is registered with punk::mix as a provider of 'templates' capability"
}
} else {
puts stderr "punk::cap::templates::folders WARNING - registered pkg 'pkg' has capability 'templates' but no 'relpath' key - unable to use as source of templates"
}
}
proc capabilitynames {{glob *}} {
variable caps
return [lsort [dict keys $caps $glob]]
}
#return only those capnames which have at least one provider
proc capabilitynames_provided {{glob *}} {
variable caps
set keys [lsort [dict keys $caps $glob]]
set cap_list [list]
foreach k $keys {
if {[llength [dict get $caps $k providers]] > 0} {
#caplist may not be complete set - which somewhat reduces its utility here regarding any decisions based on the context of this capname/capdict (review - remove this arg?)
if {![dict exists $capdict relpath]} {
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability, but is missing 'relpath' key"
return 0
}
set provide_statement [package ifneeded $pkg [package require $pkg]]
set tmfile [lindex $provide_statement end]
if {![file exists $tmfile]} {
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - unable to determine base folder for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability"
return 0
}
set tpath [file normalize [file join $tmfile [dict get $capdict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder
if {![file isdirectory $tpath]} {
puts stderr "punk::cap::handlers::templates::capsystem pkg_register WARNING - unable to validate relpath location [dict get $capdict relpath] ($tpath) for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability"
}
if {$capname ni $::punk::cap::handlers::templates::handled_caps} {
# A capability may be something like providing a folder of files, or just a data dictionary, and/or an API
#
# capability handler - a package/namespace which may provide validation and standardised ways of looking up provider data
# registered (or not) using register_capabilityname <capname> <capnamespace>
# capability provider - a package which registers as providing one or more capablities.
# registered using register_package <pkg> <capabilitylist>
# the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability
# A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::cap {
variable pkgcap [dict create]
variable pkgcapsdeclared [dict create]
variable pkgcapsaccepted [dict create]
variable caps [dict create]
if {[info commands [namespace current]::interface_caphandler.registry] eq ""} {
#A package registering as a provider using register_package can include capabilitynames in it's capabilitylist which have no associated capnamespace (handler).
#such unregistered capabilitynames may be used just to flag something, or have datamembers significant to callers cooperatively interested in that capname.
#we allow registering a capability with an empty handler (capnamespace) - but this means another handler could be registered later.
#normalize with leading :: in case caller passed in package name rather than fully qualified namespace
if {![string match ::* $capnamespace]} {
set capnamespace ::$capnamespace
}
}
#allow register of existing capname iff there is no current handler
#as handlers can be used to validate during provider registration - ideally handlers should be registered before any pkgs call register_package
#we allow loading a handler later though - but will need to validate existing data from pkgs that have already registered as providers
if {[set hdlr [get_handler $capname]] ne ""} {
error "register_capabilityname cannot register capability:$capname with handler:$capnamespace. There is already a registered handler:$hdlr"
}
#assert: capnamespace may or may not be empty string, capname may or may not already exist in caps dict, caps $capname providers may have existing entries.
dict set caps $capname handler $capnamespace
if {![dict exists $caps $capname providers]} {
dict set caps $capname providers [list]
}
if {[llength [set providers [dict get $caps $capname providers]]]} {
#some provider(s) were in place before the handler was registered
if {[set capreg [get_caphandler_registry $capname]] ne ""} {
foreach pkg $providers {
set fullcapabilitylist [dict get $pkgcapsdeclared $pkg]
foreach capspec $fullcapabilitylist {
lassign $capspec cn capdict
if {$cn ne $capname} {
continue
}
set do_register [$capreg pkg_register $pkg $capdict $fullcapabilitylist]
set list_accepted [dict get $pkgcapsaccepted $pkg]
if {$do_register} {
if {$capspec ni $list_accepted} {
dict lappend pkgcapsaccepted $pkg $capspec
}
} else {
set posn [lsearch $list_accepted $capspec]
if {$posn >=0} {
set list_accepted [lreplace $list_accepted $posn $posn]
dict set pkgcapsaccepted $pkg $list_accepted
}
}
}
#check if any accepted for this cap and remove from caps as necessary
set count 0
foreach accepted_capspec [dict get $pkgcapsaccepted $pkg] {
if {[lindex $accepted_capspec 0] eq $capname} {
incr count
}
}
if {$count == 0} {
set pkgposn [lsearch $providers $pkg]
if {$pkgposn >= 0} {
set updated_providers [lreplace $providers $posn $posn]
dict set caps $capname providers $updated_providers
}
}
}
}
}
}
proc exists {capname} {
variable caps
return [dict exists $caps $capname]
}
proc has_handler {capname} {
variable caps
return [expr {[dict exists $caps $capname handler] && [dict get $caps $capname handler] ne ""}]
}
proc get_handler {capname} {
variable caps
if {[dict exists $caps $capname]} {
return [dict get $caps $capname handler]
}
return ""
}
#dispatch
#proc call_handler {capname args} {
# if {[set handler [get_handler $capname]] eq ""} {
# error "punk::cap::call_handler $capname $args - no handler registered for capability $capname"
set tpath [file normalize [file join $tmfile [dict get $templates_dict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder
#relpath relative to file is important for tm files that are zip/tar based containers
if {[file isdirectory $tpath]} {
dict set folderdict $tpath [list source $pkg sourcetype package]
} else {
puts stderr "punk::cap::templates::folders WARNING - unable to determine base folder for package '$pkg' which is registered with punk::mix as a provider of 'templates' capability"
}
} else {
puts stderr "punk::cap::templates::folders WARNING - registered pkg 'pkg' has capability 'templates' but no 'relpath' key - unable to use as source of templates"
}
}
proc capabilitynames {{glob *}} {
variable caps
return [lsort [dict keys $caps $glob]]
}
#return only those capnames which have at least one provider
proc capabilitynames_provided {{glob *}} {
variable caps
set keys [lsort [dict keys $caps $glob]]
set cap_list [list]
foreach k $keys {
if {[llength [dict get $caps $k providers]] > 0} {
#caplist may not be complete set - which somewhat reduces its utility here regarding any decisions based on the context of this capname/capdict (review - remove this arg?)
if {![dict exists $capdict relpath]} {
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability, but is missing 'relpath' key"
return 0
}
set provide_statement [package ifneeded $pkg [package require $pkg]]
set tmfile [lindex $provide_statement end]
if {![file exists $tmfile]} {
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - unable to determine base folder for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability"
return 0
}
set tpath [file normalize [file join $tmfile [dict get $capdict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder
if {![file isdirectory $tpath]} {
puts stderr "punk::cap::handlers::templates::capsystem pkg_register WARNING - unable to validate relpath location [dict get $capdict relpath] ($tpath) for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability"
}
if {$capname ni $::punk::cap::handlers::templates::handled_caps} {
#caplist may not be complete set - which somewhat reduces its utility here regarding any decisions based on the context of this capname/capdict (review - remove this arg?)
if {![dict exists $capdict relpath]} {
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of 'templates' capability, but is missing 'relpath' key"
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability, but is missing 'relpath' key"
return 0
}
set provide_statement [package ifneeded $pkg [package require $pkg]]
set tmfile [lindex $provide_statement end]
if {![file exists $tmfile]} {
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - unable to determine base folder for package '$pkg' which is attempting to register with punk::cap as a provider of 'templates' capability"
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - unable to determine base folder for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability"
return 0
}
set tpath [file normalize [file join $tmfile [dict get $capdict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder
if {![file isdirectory $tpath]} {
puts stderr "punk::cap::handlers::templates::capsystem pkg_register WARNING - unable to determine relpath location [dict get $capdict relpath] for package '$pkg' which is attempting to register with punk::cap as a provider of 'templates' capability"
puts stderr "punk::cap::handlers::templates::capsystem pkg_register WARNING - unable to validate relpath location [dict get $capdict relpath] ($tpath) for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability"
}
if {$capname ni $::punk::cap::handlers::templates::handled_caps} {
# A capability may be something like providing a folder of files, or just a data dictionary, and/or an API
#
# capability handler - a package/namespace which may provide validation and standardised ways of looking up provider data
# registered (or not) using register_capabilityname <capname> <capnamespace>
# capability provider - a package which registers as providing one or more capablities.
# registered using register_package <pkg> <capabilitylist>
# the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability
# A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::cap {
variable pkgcap [dict create]
variable pkgcapsdeclared [dict create]
variable pkgcapsaccepted [dict create]
variable caps [dict create]
if {[info commands [namespace current]::interface_caphandler.registry] eq ""} {
#A package registering as a provider using register_package can include capabilitynames in it's capabilitylist which have no associated capnamespace (handler).
#such unregistered capabilitynames may be used just to flag something, or have datamembers significant to callers cooperatively interested in that capname.
#we allow registering a capability with an empty handler (capnamespace) - but this means another handler could be registered later.
#normalize with leading :: in case caller passed in package name rather than fully qualified namespace
if {![string match ::* $capnamespace]} {
set capnamespace ::$capnamespace
}
}
#allow register of existing capname iff there is no current handler
#as handlers can be used to validate during provider registration - ideally handlers should be registered before any pkgs call register_package
#we allow loading a handler later though - but will need to validate existing data from pkgs that have already registered as providers
if {[set hdlr [get_handler $capname]] ne ""} {
error "register_capabilityname cannot register capability:$capname with handler:$capnamespace. There is already a registered handler:$hdlr"
}
#assert: capnamespace may or may not be empty string, capname may or may not already exist in caps dict, caps $capname providers may have existing entries.
dict set caps $capname handler $capnamespace
if {![dict exists $caps $capname providers]} {
dict set caps $capname providers [list]
}
if {[llength [set providers [dict get $caps $capname providers]]]} {
#some provider(s) were in place before the handler was registered
if {[set capreg [get_caphandler_registry $capname]] ne ""} {
foreach pkg $providers {
set fullcapabilitylist [dict get $pkgcapsdeclared $pkg]
foreach capspec $fullcapabilitylist {
lassign $capspec cn capdict
if {$cn ne $capname} {
continue
}
set do_register [$capreg pkg_register $pkg $capdict $fullcapabilitylist]
set list_accepted [dict get $pkgcapsaccepted $pkg]
if {$do_register} {
if {$capspec ni $list_accepted} {
dict lappend pkgcapsaccepted $pkg $capspec
}
} else {
set posn [lsearch $list_accepted $capspec]
if {$posn >=0} {
set list_accepted [lreplace $list_accepted $posn $posn]
dict set pkgcapsaccepted $pkg $list_accepted
}
}
}
#check if any accepted for this cap and remove from caps as necessary
set count 0
foreach accepted_capspec [dict get $pkgcapsaccepted $pkg] {
if {[lindex $accepted_capspec 0] eq $capname} {
incr count
}
}
if {$count == 0} {
set pkgposn [lsearch $providers $pkg]
if {$pkgposn >= 0} {
set updated_providers [lreplace $providers $posn $posn]
dict set caps $capname providers $updated_providers
}
}
}
}
}
}
proc exists {capname} {
variable caps
return [dict exists $caps $capname]
}
proc has_handler {capname} {
variable caps
return [expr {[dict exists $caps $capname handler] && [dict get $caps $capname handler] ne ""}]
}
proc get_handler {capname} {
variable caps
if {[dict exists $caps $capname]} {
return [dict get $caps $capname handler]
}
return ""
}
#dispatch
#proc call_handler {capname args} {
# if {[set handler [get_handler $capname]] eq ""} {
# error "punk::cap::call_handler $capname $args - no handler registered for capability $capname"
set tpath [file normalize [file join $tmfile [dict get $templates_dict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder
#relpath relative to file is important for tm files that are zip/tar based containers
if {[file isdirectory $tpath]} {
dict set folderdict $tpath [list source $pkg sourcetype package]
} else {
puts stderr "punk::cap::templates::folders WARNING - unable to determine base folder for package '$pkg' which is registered with punk::mix as a provider of 'templates' capability"
}
} else {
puts stderr "punk::cap::templates::folders WARNING - registered pkg 'pkg' has capability 'templates' but no 'relpath' key - unable to use as source of templates"
}
}
proc capabilitynames {{glob *}} {
variable caps
return [lsort [dict keys $caps $glob]]
}
#return only those capnames which have at least one provider
proc capabilitynames_provided {{glob *}} {
variable caps
set keys [lsort [dict keys $caps $glob]]
set cap_list [list]
foreach k $keys {
if {[llength [dict get $caps $k providers]] > 0} {
#caplist may not be complete set - which somewhat reduces its utility here regarding any decisions based on the context of this capname/capdict (review - remove this arg?)
if {![dict exists $capdict relpath]} {
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability, but is missing 'relpath' key"
return 0
}
set provide_statement [package ifneeded $pkg [package require $pkg]]
set tmfile [lindex $provide_statement end]
if {![file exists $tmfile]} {
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - unable to determine base folder for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability"
return 0
}
set tpath [file normalize [file join $tmfile [dict get $capdict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder
if {![file isdirectory $tpath]} {
puts stderr "punk::cap::handlers::templates::capsystem pkg_register WARNING - unable to validate relpath location [dict get $capdict relpath] ($tpath) for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability"
}
if {$capname ni $::punk::cap::handlers::templates::handled_caps} {
