#! /bin/env tclsh
package require {ycl eav sqlite}
namespace import [yclprefix]::eav::sqlite::eav
package require {ycl exec}
package require {ycl ns}
namespace import [yclprefix]::exec::exec
package require {ycl proc}
namespace import [yclprefix]::proc::checkargs
namespace import [yclprefix]::proc::checkspec
package require {ycl struct env env}
package require {ycl var}
namespace import [yclprefix]::var::util::unvar
variable doc::feature {
description {
Query Enable or disable features of a program .
}
}
proc .spawned {_ args} {
set env [[$_ .basis] .env append [info cmdcount]_[namespace tail $_]]
[yclprefix] struct env env command $env ${_}::.env
$_ .routine .env
$_ .env mv [[$_ .basis] .env id]
$_ $ info [[$_ .basis] $ info]
$_ .switch .spawned {*}$args
}
[namespace current] .method .spawned
proc feature {_ args} {
namepsace upvar $_ features features
if {![llength $args]} {
return $features
} elseif {[llength $args] == 1} {
set name [lindex $args 0]
if {[dict exists features]} {
}
set res [$_ eav find enabled == entity [$_ $ entity] == type feature \
== name $name == magic $magic]
if {![llength $res]} {
return -code error [list {no such feature} $name]
}
lassign [lindex [dict values $res] end] enabled
} elseif {[llength $args] == 2} {
lassign $args name action
if {$action ni {enable disable}} {
return -code error [list {unknown action} $action]
}
set record [
$_ eav find {} entity == entity [$_ $ entity] == type feature \
== name $name == magic $magic
]
if {![llength $record]} {
return -code error [list {no such feature} $name]
}
set record [lindex [dict values $record] end]
dict update record enable enable disable disable enabled enabled {}
$_ {*}[set $action]
} else {
return -code error [list {wrong # args}]
}
return [$_ {*}$enabled]
}
[namespace current] .method feature
proc features {_ name args} {
set magic [$_ $ magic]
$_ eav find name == entity [$_ $ entity] == type feature == magic $magic
}
[namespace current] .method features
variable doc::find {
description {
find an executable program
sufficient for the current configuration and
spawn a new shelf for it based on the current one
}
args {
_ {
description {
}
positional 1
}
name {
description {
name of the new shelf for the found program .
}
}
}
}
checkspec $doc::find
proc find {_ name args} {
checkargs [$_ $ doc::find] {*}$args
set found {}
set failed {}
set magic [$_ $ magic]
foreach execname [$_ $ execnames] {
set name [[uplevel 1 [list $_ .spawn $name]] init execname $execname]
if {[$name qualified]} {
return $name
} else {
uplevel [list rename $name {}]
}
}
return -code error [list {no matching program found}]
}
[namespace current] .method find
variable doc::init {
description {
an interface to an external program
} args {
_ {
description {
An object featuring the {ycl shelf} interface to configure as a
program .
}
}
eav {
description {
Name of the {ycl eav} instance to use .
}
default {}
}
execname {
description {
name of executable
}
default {}
process {
if {[$_ $.exists execnames]} {
if {$execname ni [$_ $ execnames]} {
$_ $ execnames [list $execname {*}[$_ $ execnames]]
}
} else {
$_ $ execnames [list $execname]
}
$_ $ execname $execname
$_ $ execpath [$_ resolve [$_ $ execname]]
return $execname
}
}
execnames {
description {
Typical names for the executable file containing this program
}
default {}
process {$_ $ execnames $execnames}
}
execpath {
description {
the path to the executable
}
automatic true
default {}
}
entity {
description {
entity identifier in the eav database
}
default {}
}
name {
description {
The name of the new program
Automatically determined if pkg is provided
}
default {}
process {$_ $ name $name}
}
path {
description {
The path of the new program
}
default {
#automatically determined later
}
}
require {
description {
A list of requirements , where each requirement is a list whose
items are fit to be passed as arguments to [require]
}
default {lindex {}}
}
version {
description {
The program version
}
automatic true
}
}
}
variable doc::configure $doc::init
dict unset doc::configure require
proc init {_ args} {
set _ [uplevel [list namespace which $_]]
set magic [$_ $ magic]
$_ $ type program
checkargs [$_ $ doc::init] {*}$args
foreach varname {
disabled enable enabled execargs execparams execres failed
findings found preexec probe probes success
} {
$_ $ $varname {}
}
if {{eav} ni [$_ .routines]} {
set eav [eav ${_}::eav]
$_ .routine eav $eav
}
$_ $ entity [$_ eav set {} type shelf command $_ magic $magic]
foreach requirement $require {
$_ require {*}$requirement
}
return $_
}
[namespace current] .method init
proc preexec _ {
}
namespace eval probe {
namespace import [yclprefix]::proc::checkargs
namespace ensemble create -parameters _ -map {
ensure ensure run run set set_}
namespace eval doc {}
variable doc::ensure {
description {
run the probe if needed
}
}
proc ensure {_ args} {
set magic [$_ $ magic]
set result {}
foreach probename $args {
set probe [$_ .env $^& probes $probename]
if {$probe eq {}} {
error [list {no such probe} $probename]
}
if {![$_ .env exists probes $probename result]} {
$_ probe run $probename
}
lappend result [$_ .env $ probes $probename result]
}
return $result
}
variable doc::run {
description {
Probe the program for some feature . A probe typically modifies the
configuration of its shelf depending on what it finds . It also logs
information about its activity in the "findings"
}
args {
_ {}
success {
description {
a boolean value indicating whether the probe succeeded
}
}
execres {
description {
a dictionary with the following keys {
status {
description {
the exit code from the execution
}
}
out {
description {
the output from the execution
}
}
}
}
}
opts {
description {
the return options from the execution
}
}
}
}
proc run {_ name args} {
namespace upvar $_ failed failed
namespace upvar $_ success success
namespace upvar $_ probed probed
set magic [$_ $ magic]
set success 0
::set prereqs [$_ .env $^ probes $name prereqs]
$_ probe ensure {*}$prereqs
set command [$_ .env $^ probes $name command]
if {![llength $command]} {
error [list {no such probe} $name]
}
set probe [$_ .env create probes $name]
if {[$_ .env as& $probe exists result]} {
$_ .env as& $probe unset result
}
set result [{*}$command $_ [list $_ .env] $probe {*}$args]
$_ .env set probes $name result $result
set command [$_ .env $^ probes $name command]
return $result
}
variable doc::set {
description {
set a probe
if exactly two arguments are presented
the first argument is the name of the probe
the second argument is the command
}
args {
_ {}
name {
description {
The name of the probe
}
positional 1
}
command {
description {
The command that implements the probe. It is run as a
subcommand of the current shelf.
}
}
settings {
description {
A list of configuration settings modified by this probe
}
default {lindex {}}
}
prereqs {
description {
A list of probes that must be run first
}
default {lindex {}}
}
}
value {
description {
A unique identifier for the probe
}
}
}
proc set_ {_ args} {
if {![llength $args]} {
set probes [$_ .env view probes]
return [$_ .env view probes]
} elseif {[llength $args] == 1} {
set args [lassign $args[set args {}] name]
return [$_ .env view probes [list $name]]
} elseif {[llength $args] == 2} {
set args [lassign $args[set args {}] name command]
if {$command eq {}} {
$_ .env unset probes [list . $name]
return
}
set settings {}
set prereqs {}
} else {
checkargs $doc::set {*}$args
}
set res [$_ .env setm probes [list . $name] [
list settings $settings command $command prereqs $prereqs]]
return $res
}
}
[namespace current] .method probe
namespace eval probes {
namespace ensemble create -parameters _ -map {
ensure ensure list list_}
proc ensure _ {
set magic [$_ $ magic]
$_ probe ensure [$_ probes list]
}
proc list_ _ {
set probes [$_ .env as& $requirement set probes]
}
}
[namespace current] .method probes
variable doc::qualified {
description {
verify that a program meets all provided requirements
}
}
proc qualified _ {
set requirements [$_ requirement info]
if {![llength $requirements]} {
return 1
}
set res {}
foreach requirement $requirements {
$_ probe ensure {*}[$_ .env as& $requirement $ probes]
set cmd [$_ .env as& $requirement $ expr]
set result [{*}$cmd $_ [list $_ .env] $requirement]
$_ .env as& $requirement set result $result
if {!$result} {
return 0
}
}
return 1
}
[namespace current] .method qualified
namespace eval requirement {
namespace import [yclprefix]::proc::checkargs
namespace import [yclprefix]::proc::partial
namespace ensemble create -map {
info info remove remove set set_
} -parameters _
namespace eval doc {}
proc info {_ args} {
if {[llength $args] == 1} {
return [[$_ .env pivot requirements] get] [lindex $args end]]
} elseif {[llength $args] > 1} {
return -code error [list {too many arguments}]
}
set r [$_ .env view& requirements]
return $r
}
proc remove {_ args} {
foreach arg $args {
puts [$_ .env unset requirements $arg]
}
}
variable doc::set {
description {
Set and query requirements
}
args {
_ {}
name {
description {
a name for the requirement
}
positional 1
}
expr {
description {
Positional .
An [expr] expression that is evaluated to determine whether the
requirement is met .
}
}
probes {
description {
Probes that must be up-to-date before verifying the requirement
.
}
default {lindex {}}
}
}
}
proc set_ {_ args} {
set magic [$_ $ magic]
switch [llength $args] {
1 {
lassign $args name
set expr [uplevel 1 [list [namespace which partial] $name]]
set probes {}
}
default {
checkargs $doc::set {*}$args
}
}
set entity [$_ $ entity]
$_ .env setm requirements [list . $name] [list expr $expr probes $probes]
return
}
}
[namespace current] .method requirement
proc resolve {_ path} {
auto_execok $path
}
[namespace current] .method resolve
variable doc::run {
description {
runs the program and stores the results in $execstatus, $execval,
and $execopts
}
args {
_ {}
preargs {
description {
Arguments to be passed to the executable before $execparams
}
default {lindex {}}
}
postargs {
description {
Arguments to be passed to the executable after $execparams
}
default {lindex {}}
}
redirects {
default {}
}
}
}
proc run {_ args} {
namespace upvar $_ disabled disabled
namespace upvar $_ enable enable
namespace upvar $_ execres execres
checkargs [$_ $ doc::run] {*}$args
set magic [$_ $ magic]
set found []
if {[$_ .env exists prepare]} {
dict for {entity prepare} [$_ .env list prepare] {
dict update prepare action action {}
{*}$action
}
}
if {[$_ .env exists preexec]} {
foreach preexec1 [$_ .env list preexec] {
$_ {*}$preexec1
}
}
if {[info exists redirects]} {
} elseif {[$_ $.exists redirects]} {
set redirects [$_ $ redirects]
} else {
set redirects {}
}
set cmd [
list [$_ $ execpath] {*}$preargs {*}[
$_ $ execparams] {*}$postargs]
set execres [exec | $cmd {*}$redirects]
if {[dict exists $execres eopts]} {
set options [dict get $execres eopts]
} else {
set options {}
}
return -options $options [dict get $execres out]
}
[namespace current] .method run
[namespace current] $ magic a0f69d5fee36252ab673e13298effd0bd6cc67cb010d31f1c8812e80d1f4f8e1
[namespace current] init
apply [list {_} {
[yclprefix] struct env env command [[yclprefix] struct env env new [
namespace tail [$_ .namespace]]] .env
$_ .routine .env
$_ $ features {}
$_ $ probes {}
$_ $ info {}
} [namespace current]] [namespace current]