#! /bin/env tclsh
package require ycl::chan
package require ycl::file::prototype
package require ycl::ns
namespace import [yclprefix]::ns
package require ycl::proc
namespace import [yclprefix]::proc::checkargs
namespace import [yclprefix]::proc::upmethod
package require ycl::iter
namespace import [yclprefix]
if {[yclprefix] ne {::ycl}} {
rename [namespace tail [yclprefix]] ycl
}
namespace eval doc {}
proc cmp {fname1 fname2} {
set chan1 [open $fname1 rb]
set chan2 [open $fname2 rb]
set res [ycl chan cmp $chan1 $chan2]
close $chan1
close $chan2
return $res
}
proc configure {iter cmd args} {
variable states
set state [dict get $states $iter]
variable ${state}::type
if {![dict exists $states $iter]} {
return -code error "this iterator is not configurable"
}
return [_configure_$type $cmd $iter {*}$args]
}
namespace eval _configure_file {
namespace upvar [namespace parent] states states
proc chan {iter args} {
variable states
set state [namespace parent]::[dict get $states $iter]
variable ${state}::chan
if {[llength $args]} {
} else {
return $chan
}
}
proc read {iter args} {
variable states
set state [namespace parent]::[dict get $states $iter]
variable ${state}::read
if {[llength $args]} {
set read [lindex $args 0]
} else {
return $read
}
}
namespace export {[a-z]*}
namespace ensemble create -unknown [namespace current]::_unknown
}
variable doc::cat {
description {
}
}
proc cat path {
set fh [open $path]
set code [catch {read $fh} res einfo]
close $fh
return -options $einfo $res
}
variable doc::puts {
description {
write data to a file
returns the name of any backup file created
}
args {
name {
description {
positional
}
}
backup {
description {
back up
}
default {lindex 0}
}
newline {
description {
add a newline at the end
}
default {lindex 1}
process {
if {$newline} {
lindex {}
} else {
lindex -nonewline
}
}
}
access {
description {
filename access
}
default {lindex w}
}
permissions {
default {}
}
overwrite {
default {lindex 0}
}
data {}
}
}
proc puts {name args} {
checkargs doc::puts
set permissions {}
if {[file exists $name]} {
if {$backup} {
while {[catch {file rename $name $name.[set timestamp [clock format [
set ms [ clock microseconds]] -format %Y%m%d%H%M%S[
expr {$ms % 1000}]]]} cres copts]} {
lassign [dict get $copts -errorcode] posix eexist
#todo expannnd this for other platforms
if {$posix ne {POSIX} || eexist ne {EEXIST}} {
return -options $copts $cres
}
}
} elseif {!$overwrite} {
error [list {file already exists} $name]
}
}
if {[catch {set chan [
::open $name $access {*}$permissions]} res einfo]} {
} else {
catch {::puts {*}$newline $chan $data} res einfo]
catch {close $chan}
}
if {[dict get $einfo -code]} {
return -options $einfo $res
} else {
if {[info exists timestamp]} {
return $name.timestamp
}
}
}
proc new args {
package require ycl::file::prototype
rename new {}
namespace import [yclprefix]::file::prototype::new
tailcall new {*}$args
}
namespace eval i {}
variable states [::dict create]
variable counter
trace add variable counter read "incr [::list [namespace current]::counter] ;#"