# -*- tcl -*- # Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -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 0.1.0 # Meta platform tcl # Meta description pkg capability register # Meta license BSD # @@ Meta End #*** !doctools #[manpage_begin punk::cap 0 0.1.0] #[copyright "2023 JMNoble - BSD licensed"] #[titledesc {Module API}] #[moddesc {punk capabilities plugin system}] #[require punk::cap] #[description] #[list_begin definitions] # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements ##e.g package require frobz package require oolib # mkdoc markdown #' --- #' author: JMNoble #' --- #' ## Concepts: #' > 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 #' #' > **capability provider** - a package which registers as providing one or more capablities. #' registered using register_package #' 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 pkgcapsdeclared [dict create] variable pkgcapsaccepted [dict create] variable caps [dict create] namespace eval class { if {[info commands [namespace current]::interface_caphandler.registry] eq ""} { #Handler classes oo::class create [namespace current]::interface_caphandler.registry { method pkg_register {pkg capname capdict fullcapabilitylist} { #*** #[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} { #*** #[call [class interface_caphandler.registry] [method pkg_unregister] [arg pkg]] return ;#unregistration return is ignored - review } } oo::class create [namespace current]::interface_caphandler.sysapi { } #Provider classes oo::class create [namespace current]::interface_capprovider.registration { method get_declarations {} { #*** #[call [class interface_capprovider.registration] [method pkg_unregister] [arg pkg]] error "interface_capprovider.registration not implemented by provider" } } oo::class create [namespace current]::interface_capprovider.provider { 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 *}} { #*** #[call [class interface_capprovider.provider] [method register] [opt 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 {} { #*** #[call [class interface_capprovider.provider] [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 } } } } ;# end namespace class namespace eval capsystem { proc get_caphandler_registry {capname} { set ns [::punk::cap::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 "" } } #Not all capabilities have to be registered. #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. proc 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 [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 [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 } 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} { #*** !doctools # [call [fun exists] [arg capname]] # Return a boolean indicating if the named capability exists (0|1) # mkdoc markdown #' #' ## **exists(capname)** #' #' > return a boolean indicating the existence of a capability #' #' > Arguments: #' #' > - *capname* - string indicating the name of the capability #' #' > Returns: 0|1 #' variable caps return [dict exists $caps $capname] } proc has_handler {capname} { #*** !doctools # [call [fun 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 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" # } # ${handler}::[lindex $args 0] {*}[lrange $args 1 end] #} 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 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, that the capability will use. proc register_package {pkg capabilitylist} { variable pkgcapsdeclared variable pkgcapsaccepted variable caps 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 foreach capspec $capabilitylist { lassign $capspec capname capdict if {[llength $capname] !=1} { error "register_package error. pkg: '$pkg' An entry in the capability list doesn't appear to have a single-word name. Problematic entry:'$capspec'" } 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 { 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]} { 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 } } #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 } } #review promote/demote doesn't always make a lot of sense .. should possibly be per cap for multicap pkgs #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 #The order of providers will be the order the packages were loaded & registered #the naming: "promote vs demote" operates on a latest-package-in-list has higher preference assumption (matching last pkg loaded) #Each capability handler could implement specific preferencing methods if finer control needed. #In some cases the preference/loading order may be inapplicable/irrelevant to a particular capability anyway. #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. #Whether particular caps or users of caps do anything with this ordering is dependent on the cap-handler and/or calling code. proc promote_package {pkg} { 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_package {pkg} { 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 } } } } } proc pkgcap {pkg} { 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 [dict get $pkgcapsaccepted $pkg] } return [dict create declared [dict get $pkgcapsdeclared $pkg] 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 } } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::cap [namespace eval punk::cap { variable version variable pkg punk::cap set version 0.1.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 #[list_end] #[manpage_end]