You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
695 lines
33 KiB
695 lines
33 KiB
# -*- tcl -*- |
|
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt |
|
# |
|
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. |
|
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
# (C) 2023 |
|
# |
|
# @@ Meta Begin |
|
# Application punk::cap 999999.0a1.0 |
|
# Meta platform tcl |
|
# Meta description pkg capability register |
|
# Meta license BSD |
|
# @@ Meta End |
|
|
|
|
|
#*** !doctools |
|
#[manpage_begin punkshell_module_punk::cap 0 999999.0a1.0] |
|
#[copyright "2023 JMNoble - BSD licensed"] |
|
#[titledesc {capability provider and handler plugin system}] |
|
#[moddesc {punk capabilities plugin system}] |
|
#[require punk::cap] |
|
#[description] |
|
#[keywords module capability plugin] |
|
#[section Overview] |
|
#[para]punk::cap provides management of named capabilities and the provider packages and handler packages that implement a pluggable capability. |
|
#[para]see also [uri https://core.tcl-lang.org/tcllib/doc/trunk/embedded/md/tcllib/files/modules/pluginmgr/pluginmgr.md {tcllib pluginmgr}] for an alternative which uses safe interpreters |
|
#[subsection Concepts] |
|
#[para]A [term capability] may be something like providing a folder of files, or just a data dictionary, and/or an API |
|
# |
|
#[para][term {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> |
|
# |
|
#[para][term {capability provider}] - a package which registers as providing one or more capablities. |
|
#[para]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. |
|
|
|
|
|
#*** !doctools |
|
#[section API] |
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
## Requirements |
|
##e.g package require frobz |
|
package require oolib |
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
namespace eval punk::cap { |
|
variable pkgcapsdeclared [dict create] |
|
variable pkgcapsaccepted [dict create] |
|
variable caps [dict create] |
|
namespace eval class { |
|
if {[info commands [namespace current]::interface_caphandler.registry] eq ""} { |
|
#*** !doctools |
|
#[subsection {Namespace punk::cap::class}] |
|
#[para] class definitions |
|
#[list_begin itemized] [comment {- punk::cap::class groupings -}] |
|
# [item] |
|
# [para] [emph {handler_classes}] |
|
# [list_begin enumerated] |
|
|
|
oo::class create [namespace current]::interface_caphandler.registry { |
|
#*** !doctools |
|
#[enum] CLASS [class interface_caphandler.registry] |
|
#[list_begin definitions] |
|
# [para] [emph METHODS] |
|
method pkg_register {pkg capname capdict fullcapabilitylist} { |
|
#*** !doctools |
|
#[call class::interface_caphandler.registry [method pkg_register] [arg pkg] [arg capname] [arg capdict] [arg fullcapabilitylist]] |
|
#handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid |
|
#overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes. |
|
return 1 ;#default to permit |
|
} |
|
method pkg_unregister {pkg} { |
|
#*** !doctools |
|
#[call class::interface_caphandler.registry [method pkg_unregister] [arg pkg]] |
|
return ;#unregistration return is ignored - review |
|
} |
|
#*** !doctools |
|
#[list_end] |
|
} |
|
|
|
oo::class create [namespace current]::interface_caphandler.sysapi { |
|
#*** !doctools |
|
#[enum] CLASS [class interface_caphandler.sysapi] |
|
#[list_begin definitions] |
|
# [para] [emph METHODS] |
|
|
|
|
|
#*** !doctools |
|
#[list_end] |
|
} |
|
|
|
#*** !doctools |
|
# [list_end] [comment {- end enumeration handler classes -}] |
|
|
|
#*** !doctools |
|
# [item] |
|
# [para] [emph {provider_classes}] |
|
# [list_begin enumerated] |
|
|
|
#Provider classes |
|
oo::class create [namespace current]::interface_capprovider.registration { |
|
#*** !doctools |
|
# [enum] CLASS [class interface_cappprovider.registration] |
|
# [para]Your provider package will need to instantiate this object under a sub-namespace called [namespace capsystem] within your package namespace. |
|
# [para]If your package namespace is mypackages::providerpkg then the object command would be at mypackages::providerpkg::capsystem::capprovider.registration |
|
# [para]Example code for your provider package to evaluate within its namespace: |
|
# [example { |
|
#namespace eval capsystem { |
|
# if {[info commands capprovider.registration] eq ""} { |
|
# punk::cap::class::interface_capprovider.registration create capprovider.registration |
|
# oo::objdefine capprovider.registration { |
|
# method get_declarations {} { |
|
# set decls [list] |
|
# lappend decls [list punk.templates {relpath ../templates}] |
|
# lappend decls [list another_capability_name {somekey blah key2 etc}] |
|
# return $decls |
|
# } |
|
# } |
|
# } |
|
#} |
|
#}] |
|
#[para] The above example declares that your package can be registered as a provider for the capabilities named 'punk.templates' and 'another_capability_name' |
|
# [list_begin definitions] |
|
# [para] [emph METHODS] |
|
method get_declarations {} { |
|
#*** |
|
#[call class::interface_capprovider.registration [method get_declarations]] |
|
#[para] This method must be overridden by your provider using oo::objdefine cappprovider.registration as in the example above. |
|
# There must be at least one 2-element list in the result for the provider to be registerable. |
|
#[para]The first element of the list is the capabilityname - which can be custom to your provider/handler packages - or a well-known name that other authors may use/implement. |
|
#[para]The second element is a dictionary of keys specific to the capability being implemented. It may be empty if the any potential capability handlers for the named capability don't require registration data. |
|
error "interface_capprovider.registration not implemented by provider" |
|
} |
|
#*** !doctools |
|
# [list_end] |
|
} |
|
|
|
oo::class create [namespace current]::interface_capprovider.provider { |
|
#*** !doctools |
|
# [enum] CLASS [class interface_capprovider.provider] |
|
# [para] Your provider package will need to instantiate this directly under it's own namespace with the command name of [emph {provider}] |
|
# [example { |
|
# namespace eval mypackages::providerpkg { |
|
# punk::cap::class::interface_capprovider.provider create provider mypackages::providerpkg |
|
# } |
|
# }] |
|
# [list_begin definitions] |
|
# [para] [emph METHODS] |
|
variable provider_pkg |
|
variable registrationobj |
|
constructor {providerpkg} { |
|
#*** !doctools |
|
#[call class::interface_capprovider.provider [method constructor] [arg providerpkg]] |
|
variable provider_pkg |
|
if {$providerpkg in [list "" "::"]} { |
|
error "interface_capprovider.provider constructor error. Invalid provider '$providerpkg'" |
|
} |
|
if {![namespace exists ::$providerpkg]} { |
|
error "interface_capprovider.provider constructor error. Invalid provider '$providerpkg' - matching namespace not found" |
|
} |
|
|
|
set registrationobj ::${providerpkg}::capsystem::capprovider.registration |
|
if {[info commands $registrationobj] eq ""} { |
|
error "capprovider.provider constructor error. Missing capprovider.registration interface at '$obj' (command not found) interface_capprovider.regstration instantiation must precede interface_capprovider.provider" |
|
} |
|
|
|
set provider_pkg [string trim $providerpkg ""] |
|
|
|
} |
|
method register {{capabilityname_glob *}} { |
|
#*** !doctools |
|
#[comment {- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---}] |
|
#[call class::interface_capprovider.provider [method register] [opt capabilityname_glob]] |
|
# |
|
#[para]This is the mechanism by which a user of your provider package will register your package as a provider of the capability named. |
|
# |
|
#[para]A user of your provider may elect to register all your declared capabilities: |
|
#[example { |
|
# package require mypackages::providerpkg |
|
# mypackages::providerpkg::provider register * |
|
#}] |
|
#[para] Or a specific capability may be registered: |
|
#[example { |
|
# package require mypackages::providerpkg |
|
# mypackages::providerpkg::provider register another_capability_name |
|
#}] |
|
# |
|
variable provider_pkg |
|
set all_decls [$registrationobj get_declarations] |
|
set register_decls [lsearch -all -inline -index 0 $all_decls $capabilityname_glob] |
|
punk::cap::register_package $provider_pkg $register_decls |
|
} |
|
method capabilities {} { |
|
#*** !doctools |
|
#[comment {- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---}] |
|
#[call class::interface_capprovider.provider [method capabilities]] |
|
#[para] return a list of capabilities supported by this provider package |
|
variable provider_pkg |
|
variable registrationobj |
|
|
|
set capabilities [list] |
|
set decls [$registrationobj get_declarations] |
|
foreach decl $decls { |
|
lassign $decl capname capdict |
|
if {$capname ni $capabilities} { |
|
lappend capabilities $capname |
|
} |
|
} |
|
return $capabilities |
|
} |
|
#*** !doctools |
|
# [list_end] [comment {- end class definitions -}] |
|
} |
|
#*** !doctools |
|
# [list_end] [comment {- end enumeration provider_classes }] |
|
#[list_end] [comment {- end itemized list punk::cap::class groupings -}] |
|
} |
|
} ;# end namespace class |
|
|
|
#*** !doctools |
|
#[subsection {Namespace punk::cap}] |
|
#[para] Main punk::cap API for client programs interested in using capability handler packages and associated (registered) provider packages |
|
#[list_begin definitions] |
|
|
|
#Not all capability names have to be registered. |
|
#A package registering as a provider using register_package can include capabilitynames in it's capabilitylist which have no associated 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. |
|
proc register_capabilityname {capname capnamespace} { |
|
puts stderr "REGISTER_CAPABILITYNAME $capname $capnamespace" |
|
variable caps |
|
variable pkgcapsdeclared |
|
variable pkgcapsaccepted |
|
if {$capnamespace ne ""} { |
|
#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 [capability_get_handler $capname]] ne ""} { |
|
puts stderr "register_capabilityname cannot register capability:$capname with handler:$capnamespace. There is already a registered handler:$hdlr" |
|
return |
|
} |
|
#assertion: 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 [punk::cap::capsystem::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 |
|
} |
|
if {[catch {$capreg pkg_register $pkg $capdict $fullcapabilitylist} do_register]} { |
|
puts stderr "punk::cap::register_capabilityname '$capname' '$capnamespace' failed to register provider package '$pkg' - possible error in handler or provider" |
|
puts stderr "error message:" |
|
puts stderr $do_register |
|
set do_register 0 |
|
} |
|
|
|
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 capability_exists {capname} { |
|
#*** !doctools |
|
# [call [fun capability_exists] [arg capname]] |
|
# Return a boolean indicating if the named capability exists (0|1) |
|
variable caps |
|
return [dict exists $caps $capname] |
|
} |
|
proc capability_has_handler {capname} { |
|
#*** !doctools |
|
# [call [fun capability_has_handler] [arg capname]] |
|
#Return a boolean indicating if the named capability has a handler package installed (0|1) |
|
variable caps |
|
return [expr {[dict exists $caps $capname handler] && [dict get $caps $capname handler] ne ""}] |
|
} |
|
proc capability_get_handler {capname} { |
|
#*** !doctools |
|
# [call [fun capability_get_handler] [arg capname]] |
|
#Return the base namespace of the active handler package for the named capability. |
|
#[para] The base namespace for a handler will always be the package name, but prefixed with :: |
|
variable caps |
|
if {[dict exists $caps $capname]} { |
|
return [dict get $caps $capname handler] |
|
} |
|
return "" |
|
} |
|
proc call_handler {capname args} { |
|
if {[set handler [capability_get_handler $capname]] eq ""} { |
|
error "punk::cap::call_handler $capname $args - no handler registered for capability $capname" |
|
} |
|
set obj ${handler}::api_$capname |
|
$obj [lindex $args 0] {*}[lrange $args 1 end] |
|
} |
|
proc get_providers {capname} { |
|
variable caps |
|
if {[dict exists $caps $capname]} { |
|
return [dict get $caps $capname providers] |
|
} |
|
return [list] |
|
} |
|
|
|
#register package with arbitrary capnames from capabilitylist |
|
#The registered pkg is a module that provides some service to that capname. Possibly just data members or possibly an implementation of an API, that the capability will use. |
|
proc register_package {pkg capabilitylist args} { |
|
variable pkgcapsdeclared |
|
variable pkgcapsaccepted |
|
variable caps |
|
set opts [dict create\ |
|
-nowarnings false |
|
] |
|
foreach {k v} $args { |
|
switch -- $k { |
|
-nowarnings { |
|
dict set opts $k $v |
|
} |
|
default { |
|
error "Unrecognized option $k. Known options [dict keys $opts]" |
|
} |
|
} |
|
} |
|
set warnings [expr {! [dict get $opts -nowarnings]}] |
|
|
|
if {[string match ::* $pkg]} { |
|
set pkg [string range $pkg 2 end] |
|
} |
|
if {[dict exists $pkgcapsaccepted $pkg]} { |
|
set pkg_already_accepted [dict get $pkgcapsaccepted $pkg] |
|
} else { |
|
set pkg_already_accepted [list] |
|
} |
|
package require $pkg |
|
set providerapi ::${pkg}::provider |
|
if {[info commands $providerapi] eq ""} { |
|
error "register_package error. pkg '$pkg' doesn't seem to be a punk::cap capability provider (no object found at $providerapi)" |
|
} |
|
set defined_caps [$providerapi capabilities] |
|
#for each capability |
|
# - ensure 1st element is a single word |
|
# - ensure that if 2nd element (capdict) is present - it is dict shaped |
|
set capabilitylist_count [llength $capabilitylist] |
|
set accepted_count 0 |
|
set errorlist [list];# list of dicts |
|
set warninglist [list] |
|
foreach capspec $capabilitylist { |
|
lassign $capspec capname capdict |
|
|
|
if {$warnings} { |
|
if {$capname ni $defined_caps} { |
|
puts stderr "WARNING: pkg '$pkg' doesn't declare support for capability '$capname'." |
|
} |
|
} |
|
if {[llength $capname] !=1} { |
|
puts stderr "register_package error. pkg: '$pkg' An entry in the capability list doesn't appear to have a single-word name. Problematic entry:'$capspec'" |
|
set reason "First element of capspec not a single-word name" |
|
lappend errorlist [dict create msg $reason capspec $capspec] |
|
continue |
|
} |
|
if {[expr {[llength $capdict] %2 != 0}]} { |
|
puts stderr "register_package error. pkg:'$pkg' The second element for capname:'$capname' doesn't appear to be a valid dict. Problematic entry: '$capspec'" |
|
set reason "The second element of the capspec isn't a valid dict" |
|
lappend errorlist [dict create msg $reason capspec $capspec] |
|
continue |
|
} |
|
if {$capspec in $pkg_already_accepted} { |
|
#review - multiple handlers? if so - will need to record which handler(s) accepted the capspec |
|
if {$warnings} { |
|
puts stderr "WARNING: register_package pkg $pkg already has capspec marked as accepted: $capspec" |
|
} |
|
lappend warninglist [dict create msg "pkg $pkg already has this capspec marked as accepted" capspec $capspec] |
|
continue |
|
} |
|
if {[dict exists $caps $capname]} { |
|
set cap_pkgs [dict get $caps $capname providers] |
|
} else { |
|
dict set caps $capname [dict create handler "" providers [list]] |
|
set cap_pkgs [list] |
|
} |
|
#todo - if there's a caphandler - call it's init/validation callback for the pkg |
|
set do_register 1 ;#default assumption unless vetoed by handler |
|
if {[set capreg [punk::cap::capsystem::get_caphandler_registry $capname]] ne ""} { |
|
#Note that the interface_caphandler.registry instance must be able to handle multiple calls for same pkg |
|
set do_register [$capreg pkg_register $pkg $capname $capdict $capabilitylist] |
|
} |
|
if {$do_register} { |
|
if {$pkg ni $cap_pkgs} { |
|
lappend cap_pkgs $pkg |
|
dict set caps $capname providers $cap_pkgs |
|
} |
|
dict lappend pkgcapsaccepted $pkg $capspec ;#if pkg is being registered prior to handler-registration - the handler may undo this entry |
|
} |
|
} |
|
#another call to register_pkg with same pkg may have been made (most likely with different capname) so we must append - but check not already present |
|
#dict lappend pkgcapsdeclared $pkg $capabilitylist |
|
if {[dict exists $pkgcapsdeclared $pkg]} { |
|
#review - untested |
|
set mergecapspecs [dict get $pkgcapsdeclared $pkg] |
|
foreach spec $capabilitylist { |
|
if {$spec ni $mergecapspecs} { |
|
lappend mergecapspecs $spec |
|
} |
|
} |
|
dict set pkgcapsdeclared $pkg $mergecapspecs |
|
} else { |
|
dict set pkgcapsdeclared $pkg $capabilitylist |
|
} |
|
set resultdict [list num_capabilities $capabilitylist_count num_accepted $accepted_count] |
|
if {[llength $errorlist]} { |
|
dict set resultdict errors $errorlist |
|
} |
|
if {[llength $warninglist]} { |
|
dict set resultdict warnings $warninglist |
|
} |
|
return $resultdict |
|
} |
|
|
|
#todo! |
|
proc unregister_package {pkg {capname *}} { |
|
variable pkgcapsdeclared |
|
variable caps |
|
if {[string match ::* $pkg]} { |
|
set pkg [string range $pkg 2 end] |
|
} |
|
if {[dict exists $pkgcapsdeclared $pkg]} { |
|
#remove corresponding entries in caps |
|
set capabilitylist [dict get $pkgcapsdeclared $pkg] |
|
foreach c $capabilitylist { |
|
set do_unregister 1 |
|
lassign $c capname _capdict |
|
set cap_info [dict get $caps $capname] |
|
set pkglist [dict get $cap_info providers] |
|
set posn [lsearch $pkglist $pkg] |
|
if {$posn >= 0} { |
|
if {[set capreg [punk::cap::capsystem::get_caphandler_registry $capname]] ne ""} { |
|
#review |
|
# it seems not useful to allow the callback to block this unregister action |
|
#the pkg may have multiple datasets for each capname so callback will only be called for first dataset we encounter |
|
#vetoing unregister would make this more complex for no particular advantage |
|
#if per dataset deregistration required this should probably be a separate thing |
|
$capreg pkg_unregister $pkg $capname |
|
} |
|
set pkglist [lreplace $pkglist $posn $posn] |
|
dict set caps $capname providers $pkglist |
|
} |
|
} |
|
#delete the main registration record |
|
dict unset pkgcapsdeclared $pkg |
|
} |
|
} |
|
|
|
proc pkgcap {pkg {capsearch}} { |
|
variable pkgcapsdeclared |
|
variable pkgcapsaccepted |
|
if {[string match ::* $pkg]} { |
|
set pkg [string range $pkg 2 end] |
|
} |
|
if {[dict exists $pkgcapsdeclared $pkg]} { |
|
set accepted "" |
|
if {[dict exists $pkgcapsaccepted $pkg]} { |
|
set accepted [lsearch -all -inline -glob -index 0 [dict get $pkgcapsaccepted $pkg] $capsearch] |
|
} |
|
return [dict create declared [lsearch -all -inline -glob -index 0 [dict get $pkgcapsdeclared $pkg] $capsearch] accepted $accepted] |
|
} else { |
|
return |
|
} |
|
} |
|
proc pkgcaps {} { |
|
variable pkgcapsdeclared |
|
variable pkgcapsaccepted |
|
set result [dict create] |
|
foreach {pkg capsdeclared} $pkgcapsdeclared { |
|
set accepted "" |
|
if {[dict exists $pkgcapsaccepted $pkg]} { |
|
set accepted [dict get $pkgcapsaccepted $pkg] |
|
} |
|
dict set result $pkg declared $capsdeclared |
|
dict set result $pkg accepted $accepted |
|
} |
|
return $result |
|
} |
|
|
|
proc capability {capname} { |
|
variable caps |
|
if {[dict exists $caps $capname]} { |
|
return [dict get $caps $capname] |
|
} |
|
return "" |
|
} |
|
proc capabilities {{glob *}} { |
|
variable caps |
|
set capnames [lsort [dict keys $caps $glob]] |
|
set cap_list [list] |
|
foreach capname $capnames { |
|
lappend cap_list [list $capname [dict get $caps $capname]] |
|
} |
|
return $cap_list |
|
} |
|
|
|
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} { |
|
lappend cap_list $k |
|
} |
|
} |
|
return $cap_list |
|
} |
|
#*** !doctools |
|
#[list_end] [comment {- end definitions for namespace punk::cap -}] |
|
|
|
namespace eval advanced { |
|
#*** !doctools |
|
#[subsection {Namespace punk::cap::advanced}] |
|
#[para] punk::cap::advanced API. Functions here are generally not the preferred way to interact with punk::cap. |
|
#[para] In some cases they may allow interaction in less safe ways or may allow use of features that are unavailable in the base namespace. |
|
#[para] Some functions are here because they are only marginally or rarely useful, and they are here to keep the base API simple. |
|
#[list_begin definitions] |
|
|
|
proc promote_provider {pkg} { |
|
#*** !doctools |
|
# [call advanced::[fun promote_provider] [arg pkg]] |
|
#[para]Move the named provider package to the preferred end of the list (tail). |
|
#[para]The active handler may or may not utilise this for preferencing. See documentation for the specific handler package to confirm. |
|
#[para] |
|
#[para] promote/demote doesn't always make a lot of sense .. should preferably be configurable per capapbility for multicap provider pkgs |
|
#[para]The idea is to provide a crude way to preference/depreference packages independently of order the packages were loaded |
|
#e.g a caller or cap-handler can ascribe some meaning to the order of the 'providers' key returned from punk::cap::capabilities <capname> |
|
#[para]The order of providers will be the order the packages were loaded & registered |
|
#[para]the naming: "promote vs demote" operates on a latest-package-in-list has higher preference assumption (matching last pkg loaded) |
|
#[para]Each capability handler could and should implement specific preferencing methods within its own API if finer control needed. |
|
#In some cases the preference/loading order may be inapplicable/irrelevant to a particular capability anyway. |
|
#[para]As this is just a basic mechanism, which can't support independent per-cap preferencing for multi-cap packages - |
|
# it only allows putting the pkgs to the head or tail of the lists. |
|
#[para]Whether particular caps or users of caps do anything with this ordering is dependent on the cap-handler and/or calling code. |
|
variable pkgcapsdeclared |
|
variable caps |
|
if {[string match ::* $pkg]} { |
|
set pkg [string range $pkg 2 end] |
|
} |
|
if {![dict exists $pkgcapsdeclared $pkg]} { |
|
error "punk::cap::promote_package error pkg'$pkg' not registered. Use register_package \$pkg first" |
|
} |
|
if {[dict size $pkgcapsdeclared] > 1} { |
|
set pkginfo [dict get $pkgcapsdeclared $pkg] |
|
#remove and re-add at end of dict |
|
dict unset pkgcapsdeclared $pkg |
|
dict set pkgcapsdeclared $pkg $pkginfo |
|
dict for {cap cap_info} $caps { |
|
set cap_pkgs [dict get $cap_info providers] |
|
if {$pkg in $cap_pkgs} { |
|
set posn [lsearch $cap_pkgs $pkg] |
|
if {$posn >=0} { |
|
#rewrite package list with pkg at tail of list for this capability |
|
set cap_pkgs [lreplace $cap_pkgs $posn $posn] |
|
lappend cap_pkgs $pkg |
|
dict set caps $cap providers $cap_pkgs |
|
} |
|
} |
|
} |
|
} |
|
} |
|
proc demote_provider {pkg} { |
|
#*** !doctools |
|
# [call advanced::[fun demote_provider] [arg pkg]] |
|
#[para]Move the named provider package to the preferred end of the list (tail). |
|
#[para]The active handler may or may not utilise this for preferencing. See documentation for the specific handler package to confirm. |
|
variable pkgcapsdeclared |
|
variable caps |
|
if {[string match ::* $pkg]} { |
|
set pkg [string range $pkg 2 end] |
|
} |
|
if {![dict exists $pkgcapsdeclared $pkg]} { |
|
error "punk::cap::promote_package error pkg'$pkg' not registered. Use register_package \$pkg first" |
|
} |
|
if {[dict size $pkgcapsdeclared] > 1} { |
|
set pkginfo [dict get $pkgcapsdeclared $pkg] |
|
#remove and re-add at start of dict |
|
dict unset pkgcapsdeclared $pkg |
|
dict set pkgcapsdeclared $pkg $pkginfo |
|
set pkgcapsdeclared [dict merge [dict create $pkg $pkginfo] $pkgcapsdeclared] |
|
dict for {cap cap_info} $caps { |
|
set cap_pkgs [dict get $cap_info providers] |
|
if {$pkg in $cap_pkgs} { |
|
set posn [lsearch $cap_pkgs $pkg] |
|
if {$posn >=0} { |
|
#rewrite package list with pkg at head of list for this capability |
|
set cap_pkgs [lreplace $cap_pkgs $posn $posn] |
|
set cap_pkgs [list $pkg {*}$cap_pkgs] |
|
dict set caps $cap providers $cap_pkgs |
|
} |
|
} |
|
} |
|
} |
|
} |
|
|
|
#*** !doctools |
|
#[list_end] |
|
} |
|
|
|
|
|
#*** !doctools |
|
#[section Internal] |
|
|
|
namespace eval capsystem { |
|
#*** !doctools |
|
#[subsection {Namespace punk::cap::capsystem}] |
|
#[para] Internal functions used to communicate between punk::cap and capability handlers |
|
#[list_begin definitions] |
|
proc get_caphandler_registry {capname} { |
|
set ns [::punk::cap::capability_get_handler $capname]::capsystem |
|
if {[namespace exists ${ns}]} { |
|
if {[info command ${ns}::caphandler.registry] ne ""} { |
|
if {[info object isa object ${ns}::caphandler.registry]} { |
|
return ${ns}::caphandler.registry |
|
} |
|
} |
|
} |
|
return "" |
|
} |
|
#*** !doctools |
|
#[list_end] |
|
} |
|
} |
|
|
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
## Ready |
|
package provide punk::cap [namespace eval punk::cap { |
|
variable version |
|
variable pkg punk::cap |
|
set version 999999.0a1.0 |
|
variable README.md [string map [list %pkg% $pkg %ver% $version] { |
|
# punk capabilities system |
|
## pkg: %pkg% version: %ver% |
|
|
|
punk::cap base namespace |
|
}] |
|
return $version |
|
}] |
|
return |
|
|
|
#*** !doctools |
|
#[manpage_end]
|
|
|