#! /bin/env tclsh
namespace import [yclprefix]
if {[namespace tail [yclprefix]] ne {ycl}} {
rename [namespace tail [yclprefix]] ycl
}
package require fileutil
namespace import ::fileutil::fullnormalize
#package require sha1
#package require struct::matrix
package require uuid
namespace import ::uuid::uuid
package require ycl::ns
namespace import [yclprefix]::ns::object
package require ycl::proc
namespace import [yclprefix]::proc::checkargs
namespace import [yclprefix]::proc::dproc
namespace import [yclprefix]::proc::alias
package require ycl::iter
package require ycl::file
namespace import [yclprefix]::file::cat
namespace import [yclprefix]::file::fputs
package require ycl::list
interp alias {} [namespace current]::all {} [yclprefix] list all
namespace eval doc {}
namespace eval conf {}
proc empty? {path} {
return [expr {[llength [glob -nocomplain -directory $path *]] == 0}]
}
variable doc::iter {
description {
iterate through the contents of a directory
}
args {
path {
description {
filesystem path to traverse, usually a directory. If it is a
path, the iterator will yield nothing
}
validate {
[file isdirectory $path]
}
}
select {
description {
a command prefix to which will be appended the name of each
directory, and which should return the desired contents of the
directory
}
default {
set select {
apply {path {
set contents [
glob -nocomplain -directory $path -type hidden *]
lappend contents {*}[
glob -nocomplain -directory $path *]
#performance-wide, the following two alternatives
#are sixes.
set contents [lsearch -all -inline -not \
[lsort $contents[set contents {}]] */.]
set contents [lsearch -all -inline -not \
$contents[set contents {}] */..]
#foreach item [lsort $contents[set contents {}]] {
# if {[file tail $item] ni {. ..}} {
# lappend contents $item
# }
#}
return $contents
}}
}
}
}
dirs {
description {
include directories in the output
}
validate {
[string is boolean $dirs]
}
default {
set dirs false
}
}
files {
description {
include files in the output
}
validate {
[string is boolean $files]
}
default {
set files true
}
}
mode {
description {
specifies depth-first or breadth-first
}
validate {
$mode in {breadth depth}
}
default {
set mode breadth
}
}
}
}
dproc iter {path args} {
checkargs doc::iter
set subdirs [list $path]
switch -- $mode {
breadth {
ycl iter iter {} {
while {[llength $subdirs]} {
set newsubdirs [list]
foreach subdir $subdirs {
if {$dirs} {
yield $subdir
}
foreach item [{*}$select $subdir] {
if {[file isdirectory $item]} {
lappend newsubdirs $item
} elseif {$files} {
yield $item
}
}
}
set subdirs $newsubdirs
}
} subdirs $subdirs select $select dirs $dirs files $files
}
depth {
ycl iter iter {} {
if {![catch {set contents [{*}$select $path]}]} {
foreach item $contents {
if {[file isdirectory $item]} {
$ns ycl iter for item in [$ns iter $item {*}$args] {
yield $item
}
} else {
yield $item
}
}
}
if {$dirs} {
yield $path
}
} ns [namespace current] path $path select $select dirs $dirs \
files $files args $args
}
}
}
variable doc::mktempdir {
description {
create a directory guaranteed to have just been created by this operation.
The user is responsible for deleting the temporary directory.
}
args {
in {
description {
path to create the tmpdir in
}
default {
set in [::fileutil::tempdir]
}
}
named {
description {
name of the temporary directory
}
default {
}
}
pattern {
description {
template for creating the directory
}
default {
}
}
tries {
description {
how many times to try making the directory before giving up
}
default {
set tries 1000
}
}
}
}
dproc mktempdir args {
#todo: also try to use mktemp -d
checkargs doc::mktempdir
set success 0
if {[auto_execok mkdir] ne {}} {
set mkdir mkdir
} else {
set mkdir {file mkdir}
}
for {} {$tries > 0} {incr tries -1} {
set fname [uuid generate]
set dirpath [file join $in $fname]
if {[file exists $dirpath]} {
continue
}
set status [catch {
exec {*}$mkdir $dirpath
set success 1
} cres copts]
if {$status} {
return -code $status -opts $copts $cres
}
break
}
return $dirpath
}
variable doc::deserialize {
description {
convert a representation of a filesystem tree to a real filesystem tree
}
args {
in {
description {
a path in which to create the directory tree
}
}
tree {
description {
a list of the form {directories files}. Each directory is a
list of the form {name hierarchy}, and each file is a list of
the form {name contents}
}
}
}
}
dproc deserialize args {
checkargs doc::deserialize
lassign $tree dirs files
foreach {file contents} $files {
set path [file join $in $file]
set chan [open $path w]
puts $chan $contents
close $chan
}
foreach {dir tree} $dirs {
set in2 [file join $in $dir]
file mkdir $in2
deserialize tree $tree in $in2
}
}
#TODO: there's a better solution for this on the wiki, I think (bag of algorithms?)
if {[file normalize [info script]] eq [file normalize $argv0]} {
main
}