Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | 2011-03-30 Steve Huntley <[email protected]> * globfind.tcl: Updated to latest file version (1.5.3). |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
391a075003455876f8aff07d1c275990 |
| User & Date: | blacksqr 2011-03-30 05:14:58 |
Context
|
2011-03-30
| ||
| 06:44 | 2011-03-30 Steve Huntley <[email protected]> * vfslib.tcl, zipvfs.tcl: Added contributed patches to fix bugs 3160686 & 3224057. check-in: d888143e47 user: blacksqr tags: trunk | |
| 05:14 | 2011-03-30 Steve Huntley <[email protected]> * globfind.tcl: Updated to latest file version (1.5.3). check-in: 391a075003 user: blacksqr tags: trunk | |
|
2010-12-31
| ||
| 07:31 | 2010-12-31 Steve Huntley <[email protected]> * vfs.tcl: Removed requirement for 8.6 for sourcing of vfslib.tcl, since that file contains 8.5-relevant utils for chan command. Vfslib.tcl includes adequate conditional checks for version-dependent commands. check-in: a86dc1c7cc user: blacksqr tags: trunk | |
Changes
Changes to ChangeLog.
1 2 3 4 5 6 7 |
2010-12-31 Steve Huntley <[email protected]> * vfs.tcl: Removed requirement for 8.6 for sourcing of vfslib.tcl, since that file contains 8.5-relevant utils for chan command. Vfslib.tcl includes adequate conditional checks for version-dependent commands. 2010-12-30 Steve Huntley <[email protected]> |
> > > > |
1 2 3 4 5 6 7 8 9 10 11 |
2011-03-30 Steve Huntley <[email protected]> * globfind.tcl: Updated to latest file version (1.5.3). 2010-12-31 Steve Huntley <[email protected]> * vfs.tcl: Removed requirement for 8.6 for sourcing of vfslib.tcl, since that file contains 8.5-relevant utils for chan command. Vfslib.tcl includes adequate conditional checks for version-dependent commands. 2010-12-30 Steve Huntley <[email protected]> |
Changes to library/template/globfind.tcl.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 .. 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 ... 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 ... 330 331 332 333 334 335 336 337 338 |
if 0 {
########################
globfind.tcl --
Written by Stephen Huntley ([email protected])
License: Tcl license
Version 1.5
The proc globfind is a replacement for tcllib's fileutil::find
Usage: globfind ?basedir ?filtercmd? ?switches??
Options:
................................................................................
-types - any value acceptable to the "types" switch of the glob command.
ex: -types {d hidden}
Side effects:
If somewhere within the search space a directory is a link to another directory within
the search space, then the variable ::globfind::REDUNDANCY will be set to 1 (otherwise
it will be set to 0). The name of the redundant directory will be appended to the
variable ::globfind::redundant_files. This may be used to help track down and eliminate
infinitely looping links in the search space.
Unlike fileutil::find, the name of the basedir will be included in the results if it fits
the prefilter and filtercmd criteria (thus emulating the behavior of the standard Unix
GNU find utility).
----
................................................................................
set item [lindex $contents end-$i]
incr i
# kludge to fully resolve link to native name:
set linkValue [file dirname [file normalize [file join $item __dummy__]]]
# if item is a link, and native name is already in the search space, skip it:
if {($linkValue != $item) && (![string first $basedir $linkValue])} {
set [namespace current]::REDUNDANCY 1
lappend [namespace current]::redundant_files $item
continue
}
lappend checkDirs $item
}
................................................................................
# Eliminate emulation of [file normalize] if version 8.4 or better:
if [package vsatisfies [package present Tcl] 8.4] {
rename ::fileutil::globfind::file {}
} else {
package require fileutil 1.13
}
}
# end namespace ::fileutil::globfind
|
| | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 .. 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 ... 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 ... 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 |
if 0 {
########################
globfind.tcl --
Written by Stephen Huntley ([email protected])
License: Tcl license
Version 1.5.3
The proc globfind is a replacement for tcllib's fileutil::find
Usage: globfind ?basedir ?filtercmd? ?switches??
Options:
................................................................................
-types - any value acceptable to the "types" switch of the glob command.
ex: -types {d hidden}
Side effects:
If somewhere within the search space a directory is a link to another directory within
the search space, then the variable ::fileutil::globfind::REDUNDANCY will be set to 1
(otherwise it will be set to 0). The name of the redundant directory will be appended to the
variable ::fileutil::globfind::redundant_files. This information may be used to help track down
and eliminate infinitely looping links in the search space.
Unlike fileutil::find, the name of the basedir will be included in the results if it fits
the prefilter and filtercmd criteria (thus emulating the behavior of the standard Unix
GNU find utility).
----
................................................................................
set item [lindex $contents end-$i]
incr i
# kludge to fully resolve link to native name:
set linkValue [file dirname [file normalize [file join $item __dummy__]]]
# if item is a link, and native name is already in the search space, skip it:
if {($linkValue != $item) && (![string first $basedir/ $linkValue/])} {
set [namespace current]::REDUNDANCY 1
lappend [namespace current]::redundant_files $item
continue
}
lappend checkDirs $item
}
................................................................................
# Eliminate emulation of [file normalize] if version 8.4 or better:
if [package vsatisfies [package present Tcl] 8.4] {
rename ::fileutil::globfind::file {}
} else {
package require fileutil 1.13
}
# -----------------
# Following are sample filter commands that can be used with globfind:
# scfind: a command suitable for use as a filtercmd with globfind, arguments
# duplicate a subset of GNU find args.
proc scfind {args} {
set filename [file join [pwd] [lindex $args end]]
set switches [lrange $args 0 end-1]
array set types {
f file
d directory
c characterSpecial
b blockSpecial
p fifo
l link
s socket
}
array set signs {
- <
+ >
}
array set multiplier {
time 86400
min 3600
}
file stat $filename fs
set pass 1
set switchLength [llength $switches]
for {set i 0} {$i < $switchLength} {incr i} {
set sw [lindex $switches $i]
switch -- $sw {
-type {
set value [lindex $switches [incr i]]
if ![string equal $fs(type) $types($value)] {return 0}
}
-regex {
set value [lindex $switches [incr i]]
if ![regexp $value $filename] {return 0}
}
-size {
set value [lindex $switches [incr i]]
set sign "=="
if [info exists signs([string index $value 0])] {
set sign $signs([string index $value 0])
set value [string range $value 1 end]
}
set sizetype [string index $value end]
set value [string range $value 0 end-1]
if [string equal $sizetype b] {set value [expr $value * 512]}
if [string equal $sizetype k] {set value [expr $value * 1024]}
if [string equal $sizetype w] {set value [expr $value * 2]}
if ![expr $fs(size) $sign $value] {return 0}
}
-atime -
-mtime -
-ctime -
-amin -
-mmin -
-cmin {
set value [lindex $switches [incr i]]
set sw [string range $sw 1 end]
set time "[string index $sw 0]time"
set interval [string range $sw 1 end]
set sign "=="
if [info exists signs([string index $value 0])] {
set sign $signs([string index $value 0])
set value [string range $value 1 end]
}
set value [expr [clock seconds] - ($value * $multiplier($interval))]
if ![expr $value $sign $fs($time)] {return 0}
}
}
}
return 1
}
# find: example use of globfind and scfind to duplicate a subset of the
# command line interface of GNU find.
# ex:
# find $env(HOME) -type l -atime +1
proc find {args} {
globfind [lindex $args 0] [list [subst "scfind $args"]]
}
# -----------------
# globsync: sync two locations so that the target looks just like the source:
# If "destructive" is set to 1, files in the target will be deleted if files in equivalent
# locations in source don't exist. If 0, files that exist only in target will be left
# alone, leaving target not an exact duplicate of source.
# if "log" is set to 1, progress messages will be written to stdout. If 0, not.
# "source" is location to be duplicated.
# "target" is location to be synced to look like source.
# file is parameter fed to globsync by globfind.
# ex: globfind ~user_a {globsync 1 1 ~user_a ~user_b}
proc globsync {destructive log source target file} {
set source [file normalize $source]
set target [file normalize $target]
set sourceLength [llength [file split $source]]
set targetLength [llength [file split $target]]
set targetFile [file normalize [file join $target [join [lrange [file split $file] $sourceLength end] /]]]
array set sourceAttr [file attributes $file]
file stat $file fs
array set sourceAttr "mtime $fs(mtime)"
if ![file isdirectory $file] {
if [file isdirectory $targetFile] {file delete -force -- $targetFile}
set err [catch {file copy -force -- $file $targetFile} result]
if $err {set err [catch {file mkdir [file dirname $targetFile] ; file copy -force -- $file $targetFile} result]}
if $err {errHandle $result}
if $log {puts "copied $file to $targetFile"}
array set targetAttr [file attributes $targetFile]
foreach attr [array names sourceAttr] {
if {[array get sourceAttr $attr] != [array get targetAttr $attr]} {catch {file attributes $targetFile $attr $sourceAttr($attr)}}
}
return 0
}
set err [catch {file mkdir $targetFile} result]
if $err {set err [catch {file delete -force -- $targetFile ; file mkdir $targetFile} result]}
if $err {errHandle $result}
array set targetAttr [file attributes $targetFile]
file stat $targetFile fs
array set targetAttr "mtime $fs(mtime)"
foreach attr [array names sourceAttr] {
if {[array get sourceAttr $attr] != [array get targetAttr $attr]} {
catch {file attributes $targetFile $attr $sourceAttr($attr)}
}
}
set sourceDirs [glob -dir $file -nocomplain -type d *]
if {[lindex [file system $file] 0] != "tclvfs"} {append sourceDirs " [glob -dir $file -nocomplain -type {d hidden} *]"}
set targetDirs [glob -dir $targetFile -nocomplain -type d *]
if {[lindex [file system $targetFile] 0] != "tclvfs"} {append sourceDirs " [glob -dir $targetFile -nocomplain -type {d hidden} *]"}
if !$destructive {set targetDirs {}}
foreach td $targetDirs {
set sd [file join $source [join [lrange [file split $td] $targetLength end] /]]
if {[lsearch $sourceDirs $sd] < 0} {
file delete -force -- $td
if $log {puts "deleted directory $td"}
}
}
set sourceFiles [glob -dir $file -nocomplain -types {b c f l p s} *]
if {[lindex [file system $file] 0] != "tclvfs"} {append sourceFiles " [glob -dir $file -nocomplain -types {b c f l p s hidden} *]"}
set targetFiles {}
if $destructive {
set targetFiles [glob -dir $targetFile -nocomplain -types {b c f l p s} *]
if {[lindex [file system $targetFile] 0] != "tclvfs"} {append targetFiles " [glob -dir $targetFile -nocomplain -types {b c f l p s hidden} *]"}
}
foreach tf $targetFiles {
set sf [file join $source [join [lrange [file split $tf] $targetLength end] /]]
if {[lsearch $sourceFiles $sf] < 0} {
file delete -force -- $tf
if $log {puts "deleted file $tf"}
}
}
return 0
}
proc errHandle {result} {
error $result
}
}
# end namespace ::fileutil::globfind
|