💾 Archived View for thrig.me › blog › 2023 › 05 › 20 › guard.tcl captured on 2024-06-16 at 13:32:25.

View Raw

More Information

⬅️ Previous capture (2023-05-24)

-=-=-=-=-=-=-

#!/usr/bin/env tclsh8.6
#
# guard.tcl - example implementation of "guarded commands"

# on OpenBSD:
#   doas pkg_add tcl tcllib
package require Tcl 8.6
package require defer

# run the test: if okay, return. otherwise, run the action, and run the
# test again, failing if that test fails
proc guard {test action} {
    if { [uplevel 1 $test]} return else {uplevel 1 $action}
    if {![uplevel 1 $test]} {return -code 1 "after test failed"}
}

proc append-line {file string} {
    set fh [open $file a]
    puts $fh $string
    close $fh
}

proc has-line {file string} {
    try {
        set fh [open $file]
    } on error {} {
        return 0
    }
    defer::defer close $fh
    while {[gets $fh line] >= 0} {
        if {[string match $string $line]} {return 1}
    }
    return 0
}

# run commands in a directory, creating the directory if need be
proc with-directory {dir body} {
    set oldwd [pwd]
    defer::defer cd $oldwd
    guard {file isdirectory $dir} {file mkdir $dir}
    cd $dir
    uplevel 1 $body
}

proc with-file-line {file string} {
    guard {has-line $file $string} {append-line $file $string}
}

with-directory blah {
    with-file-line foo foo
    with-directory whatever {
        with-file-line bar bar
    }
}