Tcl Library Source Code

2013-07-11  Andreas Kupries  <[email protected]>

	* fileutil.man: Ticket [8b317b4a63]: Added code to the 8.4+
	* fileutil.tcl: implementations of GLOBF and GLOBD to guard
	* fileutil.test: ourselves against VFS packages mishandling the
	* pkgIndex.tcl: -types option of [glob]. vfs::zip is an example.
	  This mishandling causes glob to return the same data for the two
	  calls with "-types x" and "-types {hidden x}", generating lists
	  with duplicate entries. We now generally de-duplicate the result
	  ourselves. Bumped the package version to 1.14.6. Thanks to
	  <[email protected]> for the investigation identifying
	  this problem.

2013-02-14  Andreas Kupries  <[email protected]>

	* decode.tcl: Bumped fileutil::decode to 0.2 to distinguish
	* pkgIndex.tcl: properly from the 0.1.xxx version which existed in
	  AS/perforce before it moved to tcllib/fossil. That should have
	  been done as part of the move, and was forgotten.

[vset PACKAGE_VERSION 1.14.6]
[comment {-*- tcl -*- doctools manpage}]
[manpage_begin fileutil n [vset PACKAGE_VERSION]]
[keywords cat]
[keywords {file utilities}]
[keywords grep]
[keywords {temp file}]
[keywords test]
[keywords touch]
[keywords type]
[moddesc   {file utilities}]
[titledesc {Procedures implementing some file utilities}]
[category  {Programming tools}]
[require Tcl 8]
[require fileutil [opt [vset PACKAGE_VERSION]]]
[description]
[para]

This package provides implementations of standard unix utilities.

[list_begin definitions]

# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: fileutil.tcl,v 1.78 2010/06/17 04:46:19 andreas_kupries Exp $

package require Tcl 8.2
package require cmdline
package provide fileutil 1.14.6

namespace eval ::fileutil {
    namespace export \
	    grep find findByPattern cat touch foreachLine \
	    jail stripPwd stripN stripPath tempdir tempfile \
	    install fileType writeFile appendToFile \
	    insertIntoFile removeFromFile replaceInFile \

	}
	if {([file type $current] eq "link") &&
	    !([file exists   [file readlink $current]] &&
	      [file readable [file readlink $current]])} {
	    return {}
	}

	set res [lsort -unique [concat \
		     [glob -nocomplain -directory $current -types f          -- *] \
		     [glob -nocomplain -directory $current -types {hidden f} -- *]]]

	# Look for broken links (They are reported as neither file nor directory).
	foreach l [lsort -unique [concat \
		       [glob -nocomplain -directory $current -types l          -- *] \
		       [glob -nocomplain -directory $current -types {hidden l} -- *]]] {
	    if {[file isfile      $l]} continue
	    if {[file isdirectory $l]} continue
	    lappend res $l
	}
	return [lsort -unique $res]
    }

    proc ::fileutil::GLOBD {current} {
	if {![file readable $current]} {
	    return {}
	}
	if {([file type $current] eq "link") &&
	    !([file exists   [file readlink $current]] &&
	      [file readable [file readlink $current]])} {
	    return {}
	}

	lsort -unique [concat \
	    [glob -nocomplain -directory $current -types d          -- *] \
	    [glob -nocomplain -directory $current -types {hidden d} -- *]]
    }

} elseif {[package vsatisfies [package present Tcl] 8.4]} {
    # Tcl 8.4+.
    # (Ad 1) We have -directory, and -types,
    # (Ad 2) Links are returned for -types f/d if they refer to files/dirs.
    # (Ad 3) No bug to code around

    proc ::fileutil::ACCESS {args} {}

    proc ::fileutil::GLOBF {current} {
	set res [lsort -unique [concat \
		    [glob -nocomplain -directory $current -types f          -- *] \
		    [glob -nocomplain -directory $current -types {hidden f} -- *]]]

	# Look for broken links (They are reported as neither file nor directory).
	foreach l [lsort -unique [concat \
		       [glob -nocomplain -directory $current -types l          -- *] \
		       [glob -nocomplain -directory $current -types {hidden l} -- *]]] {
	    if {[file isfile      $l]} continue
	    if {[file isdirectory $l]} continue
	    lappend res $l
	}
	return [lsort -unique $res]
    }

    proc ::fileutil::GLOBD {current} {
	lsort -unique [concat \
	    [glob -nocomplain -directory $current -types d          -- *] \
	    [glob -nocomplain -directory $current -types {hidden d} -- *]]
    }

} elseif {[package vsatisfies [package present Tcl] 8.3]} {
    # 8.3.
    # (Ad 1) We have -directory, and -types,
    # (Ad 2) Links are NOT returned for -types f/d, collect separately.
    #        No symbolic file links on Windows.

# -*- tcl -*-
# Tests for the find function.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 1998-2000 by Ajuba Solutions.
# Copyright (c) 2001 by ActiveState Tool Corp.
# Copyright (c) 2005-2013 by Andreas Kupries <[email protected]>
# All rights reserved.
#
# RCS: @(#) $Id: fileutil.test,v 1.56 2009/10/06 20:07:18 andreas_kupries Exp $

# TODO: Bug [8b317b4a63]: Create test cases for this bug. This
# requires the use of a custom VFS as the native filesystem does not
# contain the bug we are guarding ourselves against.

# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

if {![package vsatisfies [package provide Tcl] 8.2]} {return}
package ifneeded fileutil 1.14.6 [list source [file join $dir fileutil.tcl]]

if {![package vsatisfies [package provide Tcl] 8.3]} {return}
package ifneeded fileutil::traverse 0.4.3 [list source [file join $dir traverse.tcl]]

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded fileutil::multi     0.1   [list source [file join $dir multi.tcl]]
package ifneeded fileutil::multi::op 0.5.3 [list source [file join $dir multiop.tcl]]