@ -53,11 +53,44 @@ namespace eval punk::cap {
}
}
oo::class create [namespace current]::interface_capprovider.provider {
method register {{capabilityname_glob *}} {
variable provider_pkg
variable registrationobj
constructor {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 *}} {
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 {} {
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 $capname
}
}
}
@ -188,6 +221,11 @@ namespace eval punk::cap {
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]
}
#for each capability
# - ensure 1st element is a single word
# - ensure that if 2nd element (capdict) is present - it is dict shaped
@ -199,6 +237,11 @@ namespace eval punk::cap {
if {[expr {[llength $capdict] %2 != 0}]} {
error "register_package error. pkg:'$pkg' The second element for capname:'$capname' doesn't appear to be a valid dict. Problematic entry: '$capspec'"
}
if {$capspec in $pkg_already_accepted} {
#review - multiple handlers? if so - will need to record which handler(s) accepted the capspec
puts stderr "register_package pkg $pkg already has capspec marked as accepted: $capspec"
continue
}
if {[dict exists $caps $capname]} {
set cap_pkgs [dict get $caps $capname providers]
} else {
@ -219,17 +262,23 @@ namespace eval punk::cap {
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
#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]} {
set caps [dict get $pkgcapsdeclared $pkg]
lappend caps {*}$capabilitylist
dict set pkgcapsdeclared $pkg $caps
set capspecs [dict get $pkgcapsdeclared $pkg]
foreach spec $capspecs {
if {$spec ni $capspecs} {
lappend capspecs $spec
}
}
dict set pkgcapsdeclared $pkg $capspecs
} else {
dict set pkgcapsdeclared $pkg $capabilitylist
}
}
proc unregister_package {pkg} {
#todo!
proc unregister_package {pkg {capname *}} {
variable pkgcapsdeclared
variable caps
if {[string match ::* $pkg]} {
@ -250,7 +299,7 @@ namespace eval punk::cap {
# 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 capability deregistration required this should probably be a separate thing (e.g disable_capability?)
#if per dataset deregistration required this should probably be a separate thing
$capreg pkg_unregister $pkg
}
set pkglist [lreplace $pkglist $posn $posn]
