Here my command :
foreach fic [glob -nocomplain -dir $dir -types {f d r} *] {
set infofile [list [file tail $fic] [file mtime $fic] [file atime $fic]]
# ...
}
Only I have an error : couldn't read directory "/Users/..." permission denied...
My solution is to add this command : file readable
foreach fic [glob -nocomplain -dir $dir -types {f d} *] {
if {![file readable $fic]} continue
set infofile [list [file tail $fic] [file mtime $fic] [file atime $fic]]
# ...
}
I thought when I added the r -type this kind of error did not appear.It’s a misunderstanding of the documentation ?
Permissions on Windows are complex, to the point where you can only be really sure that you've got permission to read a file immediately after you've successfully opened it for reading. The indications from glob and file readable are not definitive. This is the case on other operating systems, and in any case there's a race condition: the user could change the permissions between checking with file readable and calling some other operation. Because of that, while you can use glob -type r, you should not rely on it. It simply can't be guaranteed to be correct.
The fix for this? Handle errors from calls properly.
foreach fic [glob -nocomplain -dir $dir -types {f d r} *] {
try {
# More efficient than calling [file mtime] and [file atime] separately
file stat $fic data
} on error {} {
# Couldn't actually handle the file. Ignore
continue
}
set infofile [list [file tail $fic] $data(mtime) $data(atime)]
# ...
}
Related
I am trying to search for directories within sub-directories and return any directories that match the wildcard glob search.
The folder structure is as outlined below...
Rootdir
-dir01
-dir_match_01-OLD
-dir_match_01
-dir02
-dir_match_02-OLD
-dir_match_02
-dir03
-dir_match_03-OLD
-dir_match_03
-...
I am searching for directories that would reside in dir01, dir02, dir03 and so on.
I am using the following glob call to recursively search through the directories, which seems to be working correctly...
set rootdir "/home/rootdir/"
set searchstring "*-OLD"
foreach dir [glob -nocomplain -dir $rootdir -type d -- *] {
set result [glob -nocomplain -dir $dir -type d -- $searchstring]
puts $result
}
What I am finding is if I don't use a wildcard in the $searchstring and use an exact directory name that exists I receive the output successfully. But if I then use a wildcard to search for all directories ending in *-OLD It successfully finds them put puts them all out on the same line.
/home/rootdir/dir01/directory01-OLD /home/rootdir/dir01/directory02-OLD /home/rootdir/dir01/directory03-OLD
I have tried to separate the entries by using regsub to replace the whitespace with \n but all it does is remove the whitespace...
/home/rootdir/dir01/directory01-OLD/home/rootdir/dir01/directory02-OLD/home/rootdir/dir01/directory03-OLD
Any suggestions in what I am doing wrong would be much appreciated, thanks.
The most obvious part is that glob always returns a list of names. You'd therefore need to do the innermost loop like this:
foreach dir [glob -nocomplain -dir $rootdir -type d -- *] {
foreach result [glob -nocomplain -dir $dir -type d -- $searchstring] {
puts $result
}
}
However, for a fixed depth search, I think you can do it like this:
foreach dir [glob -nocomplain -dir $rootdir -type d -- */$searchstring] {
puts $dir
}
If you need recursive (full directory tree) search, there are utility commands in Tcllib's fileutil package:
package require fileutil
proc myMatcher {pattern filename} {
# Does the filename match the pattern, and is it a directory?
expr {[string match $pattern $filename] && [file isdir $filename]}
}
set rootdir "/home/rootdir/"
set searchstring "*-OLD"
# Note the use of [list] to create a partial command application
# This is a standard Tcl technique; it's one of the things that [list] is designed to do
foreach dir [fileutil::find $rootdir [list myMatcher $searchstring]] {
puts $dir
}
When I am executing a Python script and ensure that PYTHONPATH is properly set to refer depedency modules. Within the Python code I call a TCL script which again calls a Python script like below:
if {[catch {exec {*}[auto_execok python] [file nativename [file join [file dirname [info script]] my.py ]] } result] == 0 } {
puts "Executed successfully $result"
} else {
puts "Error $result"
return error
}
I am successfully able to execute the Python script my.py externally but when executed from the TCL script it gives issues. Somehow I find that it is cause the PYTHONPATH is not being passed properly while calling the Python script since my.py refers to depdency Python modules.
How can I pass the PYTHONPATH in exec command?
The PYTHONPATH is an environment variable. They're manipulated through the env global variable:
# You might be able to set this once for your whole script
set python_path {C:/Python/3.6/wherever C:/Users/me/Python/3.6/wherever}
# Transform a Tcl list into the right format that Python expects
set ::env(PYTHONPATH) [join [lmap p $python_path {file nativename $p}] \
$::tcl_platform(pathSeparator)]
# Split this out for a shorter line length. ;-)
set my_py [file join [file dirname [info script]] my.py]
if {[catch {exec {*}[auto_execok python] [file nativename $my_py]} result] == 0 } {
puts "Executed successfully $result"
} else {
puts "Error $result"
return error
}
In Tcl 8.5, you don't have lmap or the pathSeparator element of tcl_platform and instead would do something like this:
foreach p $python_path {
if {[info exist ::env(PYTHONPATH)]} {
# Assume Windows
append ::env(PYTHONPATH) ";" [file nativename $p]
} else {
set ::env(PYTHONPATH) [file nativename $p]
}
}
You could also hardcode the values if they're just one or two elements. Remember that backslashes (\) are significant to Tcl, so put the string in {…} if you're doing that.
set ::env(PYTHONPATH) {C:\Python\3.6\wherever;C:\Users\me\Python\3.6\wherever}
That's not particularly viable for anything redistributable… but works for one's own scripts.
I am beginner in tcl.
I am able to write script for collecting all files under a directory and it's all subdirectory.
I have written a belwo proc for the same.
proc rglob { dirpath } {
set rlist ""
foreach fpath [glob -nocomplain -types f -directory ${dirpath} *] {
lappend rlist ${fpath}
}
foreach dir [glob -nocomplain -types d -directory ${dirpath} *] {
lappend rlist {*}[rglob ${dir}]
}
return ${rlist}
}
rglob /a/b/c
will give you all files withing dir c and its subdirectories.
Now consider a case I want to exclude few directories under c say dir1 and dir2 are the two directory and I want to exclude a directory dir2. Please guide me how should I proceed for the same.
set exclude_dir dir2
This code is basically the same as in the accepted answer, but a little simpler:
proc rglob {dirpath args} {
set exclude $args
set rlist [glob -nocomplain -types f -directory $dirpath *]
foreach dir [glob -nocomplain -types d -directory $dirpath *] {
if {$dir ni $exclude} {
lappend rlist {*}[rglob $dir {*}$exclude]
}
}
return $rlist
}
Usage: rglob dirpath ?arg arg ...?, e.g. rglob ., rglob . ./abc ./def.
The matching of directory names could be improved by using glob or regexp matching.
Documentation:
foreach,
glob,
if,
lappend,
ni (operator),
proc,
return,
set,
{*} (syntax)
This will exclude from search resuls all directories with names in exclude_dirs_list. In fact, names are not full paths, so not only /a/b/c/dir1 will be excluded, but /a/b/c/d/e/dir1 too.
proc rglob { dirpath exclude_dirs_list} {
set rlist ""
foreach fpath [glob -nocomplain -tails -types f -directory ${dirpath} *] {
lappend rlist [file join ${dirpath} ${fpath}]
}
foreach dir [glob -nocomplain -tails -types d -directory ${dirpath} *] {
if {[lsearch -exact $exclude_dirs_list $dir] == -1} {
lappend rlist {*}[rglob [file join ${dirpath} ${dir}] $exclude_dirs_list]
}
}
return ${rlist}
}
rglob /a/b/c [list dir1 dir2]
If you need to exclude only /a/b/c/dir1 you should change from
lappend rlist {*}[rglob [file join ${dirpath} ${dir}] $exclude_dirs_list]
to
lappend rlist {*}[rglob [file join ${dirpath} ${dir}] {}]
Packages tdbc::mysql and tdbc::postgresql require dll libmysql.dll and libpq.dll somewere in PATH. What best way to include this dlls into single starpack?
For now I'm using following pkgIndex.tcl:
if {[catch {package require Tcl 8.6}]} {
return
}
package ifneeded tdbc::postgres 1.0.0 [list apply {{dir} {
if { $::tcl_platform(os) eq "Windows NT" &&
($::tcl_platform(machine) eq "intel" ||
$::tcl_platform(machine) ne "amd64") } {
foreach n {libpq libeay32 ssleay32 comerr32 gssapi32
k5sprt32 krb5_32 libiconv-2 libintl-8} {
file copy -force [file join $dir ${n}.dll] \
[file join $::env(WINDIR) System32 ${n}.dll]
}
}
source [file join $dir tdbcpostgres.tcl]
load [file join $dir tdbcpostgres100.dll] tdbcpostgres
}} $dir]
But this looks very ugly.
I was trying to find a way to copy the necessary libraries to the temporary folder used by the interpreter to load dll. But by examining the Tcl source code, find out the name of the temporary directory is not possible for script.
update: At the current time, I decided to use twapi to determine the name of the temporary folder that is used by the Tcl interpreter. I get the following code:
if {[catch {package require Tcl 8.6}]} {
return
}
package ifneeded tdbc::postgres 1.0.0 [list apply {{dir} {
if { $::tcl_platform(os) eq "Windows NT" &&
($::tcl_platform(machine) eq "intel" ||
$::tcl_platform(machine) eq "amd64") } {
package require twapi
set _ [file dirname [lindex [lsearch -inline -index 1 -glob \
[twapi::get_process_modules [twapi::get_current_process_id] -path] \
{*/twapi_base*.dll}] 1]]
if { $_ eq "." } {
error "couldn't find temp folder name for tdbc::postgres support library"
}
foreach fn [glob -types f -tails -directory $dir "*.dll"] {
if { [string match -nocase "tdbcpostgres*" $fn] } continue
file copy -force [file join $dir $fn] [file join $_ $fn]
}
} {
set _ [pwd]
}
source [file join $dir tdbcpostgres.tcl]
set tpwd [pwd]
cd $_
catch { load [file join $dir tdbcpostgres100.dll] tdbcpostgres } r o
cd $tpwd
return -options $o $r
}} $dir]
But still there was a problem with the removal of temporary files after the program exit. I see only one solution: at the start of the program to scan the folder $::env(TEMP) and try to delete all temporary folders that are named as TCLXXXXXXXX.
The "solution" to copy the files to c:\windows\system32 will not work without administrator access, which most applications starting with Windows Vista don't have. (You'd have to choose "run as admin") And what about newer files in the system32 directory? You just replace them.
Some alternatives:
Copy all the dlls yourself to a temporary directory, switch to that directory and load the dll (exploits the fact that you look into . as well on windows):
package ifneeded tdbc::postgres 1.0.0 [list apply {{dir} {
set dest [file join $::env(TEMP) tcl[file seconds]]
file mkdir $dest
foreach dll [glob -dir $dir *.dll] {
file copy $dll $dest
}
set cwd [pwd]
cd $dest
catch {
source [file join $dir tdbcpostgres.tcl]
load [file join $dest tdbcpostgres100.dll] tdbcpostgres
} res opt
cd $cwd
return -options $opt $res
}} $dir]
But how should we clean this up?
Compile the dlls into the starpack. That is hard.
Compile the extension yourself, so it does not have any dependencies. I don't know how to do that.
Load each required dll yourself. This is my favorite solution, but it requires twapi:
package ifneeded tdbc::postgres 1.0.0 [list apply {{dir} {
package require twapi
foreach dll [glob -dir $dir *.dll] {
::twapi::load_library $dll
}
source [file join $dir tdbcpostgres.tcl]
load [file join $dir tdbcpostgres100.dll] tdbcpostgres
}} $dir]
The main problem with that trick is that it requires write access to a system directory. You don't want to do that. However, you can instead use the fact that load doesn't undo the loading of the library if it fails to find the bootstrap symbol. (This is a variation from Tcl's usual “be as clean as possible in the failure mode” model, but it's damn useful here.)
package ifneeded tdbc::postgres 1.0.0 [list apply {{dir} {
global tcl_platform
if {$tcl_platform(os) eq "Windows NT" && $tcl_platform(machine) ne "amd64"} {
foreach n {libpq libeay32 ssleay32 comerr32 gssapi32
k5sprt32 krb5_32 libiconv-2 libintl-8} {
if {![file exist [file join $::env(WINDIR) System32 ${n}.dll]]} {
# Leverage Tcl's built-in loading magic
catch {load [file join $dir ${n}.dll]}
}
}
}
source [file join $dir tdbcpostgres.tcl]
load [file join $dir tdbcpostgres100.dll] tdbcpostgres
}} $dir]
This is still not very elegant, but intercepting the real dependency loading mechanism is damn hard; pre-loading is just way easier. (I've also stopped the code from doing tricks if the user already has the particular library.)
The proper fix is to get a build of tdbcpostgres100.dll that has those other dependencies as static libraries. This is quite a lot of work, I'd guess; I've not tried to do it.
I have a main TCL proc that sources tons of other tcl procs in other folders and subsequent subdirectories. For example, in the main proc it has:
source $basepath/folderA/1A.tcl
source $basepath/folderA/2A.tcl
source $basepath/folderA/3A.tcl
source $basepath/folderB/1B.tcl
source $basepath/folderB/2B.tcl
source $basepath/folderB/3B.tcl
and it seems kind of stupid to do it that way when I always know I will source everything in folderA and folderB. Is there a function (or simple way) that'll allow me to just source all the .tcl files in an entire folder?
Building on ramanman's reply, heres a routine that tackles the problem using the built in TCL file commands and which works it way down the directory tree recursively.
# findFiles
# basedir - the directory to start looking in
# pattern - A pattern, as defined by the glob command, that the files must match
proc findFiles { basedir pattern } {
# Fix the directory name, this ensures the directory name is in the
# native format for the platform and contains a final directory seperator
set basedir [string trimright [file join [file normalize $basedir] { }]]
set fileList {}
# Look in the current directory for matching files, -type {f r}
# means ony readable normal files are looked at, -nocomplain stops
# an error being thrown if the returned list is empty
foreach fileName [glob -nocomplain -type {f r} -path $basedir $pattern] {
lappend fileList $fileName
}
# Now look for any sub direcories in the current directory
foreach dirName [glob -nocomplain -type {d r} -path $basedir *] {
# Recusively call the routine on the sub directory and append any
# new files to the results
set subDirList [findFiles $dirName $pattern]
if { [llength $subDirList] > 0 } {
foreach subDirFile $subDirList {
lappend fileList $subDirFile
}
}
}
return $fileList
}
It gets trivial with tcllib on board:
package require fileutil
foreach file [fileutil::findByPattern $basepath *.tcl] {
source $file
}
Perhaps a little more platform independent and using builtins commands instead of piping to a process:
foreach script [glob [file join $basepath folderA *.tcl]] {
source $script
}
Repeat for folderB.
If you have more stringent selection criteria, and don't worry about running on any other platforms, using find may be more flexible.
Here is one way:
set includes [open "|find $basedir -name \*.tcl -print" r]
while { [gets $includes include] >= 0 } {
source $include
}
close $includes
Based on a previous answer, this version handles cycles created by symbolic links and in the process eliminates duplicate files due to symbolic links as well.
# findFiles
# basedir - the directory to start looking in
# pattern - A pattern, as defined by the glob command, that the files must match
proc findFiles {directory pattern} {
# Fix the directory name, this ensures the directory name is in the
# native format for the platform and contains a final directory seperator
set directory [string trimright [file join [file normalize $directory] { }]]
# Starting with the passed in directory, do a breadth first search for
# subdirectories. Avoid cycles by normalizing all file paths and checking
# for duplicates at each level.
set directories [list]
set parents $directory
while {[llength $parents] > 0} {
# Find all the children at the current level
set children [list]
foreach parent $parents {
set children [concat $children [glob -nocomplain -type {d r} -path $parent *]]
}
# Normalize the children
set length [llength $children]
for {set i 0} {$i < $length} {incr i} {
lset children $i [string trimright [file join [file normalize [lindex $children $i]] { }]]
}
# Make the list of children unique
set children [lsort -unique $children]
# Find the children that are not duplicates, use them for the next level
set parents [list]
foreach child $children {
if {[lsearch -sorted $directories $child] == -1} {
lappend parents $child
}
}
# Append the next level directories to the complete list
set directories [lsort -unique [concat $directories $parents]]
}
# Get all the files in the passed in directory and all its subdirectories
set result [list]
foreach directory $directories {
set result [concat $result [glob -nocomplain -type {f r} -path $directory -- $pattern]]
}
# Normalize the filenames
set length [llength $result]
for {set i 0} {$i < $length} {incr i} {
lset result $i [file normalize [lindex $result $i]]
}
# Return only unique filenames
return [lsort -unique $result]
}
Same idea as schlenk:
package require Tclx
for_recursive_glob scriptName $basepath *.tcl {
source $scriptName
}
If you only want folderA and folderB and not other folders under $basepath:
package require Tclx
for_recursive_glob scriptName [list $basepath/folderA $basepath/folderB] *.tcl {
source $scriptName
}
The answer by Joseph Bui works well except that it skips files in the initial folder.
Change:
set directories [list]
To:
set directories [list $directory]
to fix