release/src/router/usbmodeswitch/jim/glob.tcl

   1 # Implements a Tcl-compatible glob command based on readdir
   2 #
   3 # (c) 2008 Steve Bennett <steveb@workware.net.au>
   4 #
   5 # See LICENCE in this directory for licensing.
   6
   7 package require readdir
   8
   9 # Implements the Tcl glob command
  10 #
  11 # Usage: glob ?-nocomplain? pattern ...
  12 #
  13 # Patterns use 'string match' (glob) pattern matching for each
  14 # directory level, plus support for braced alternations.
  15 #
  16 # e.g. glob "te[a-e]*/*.{c,tcl}"
  17 #
  18 # Note: files starting with . will only be returned if matching component
  19 #       of the pattern starts with .
  20 proc glob {args} {
  21
  22         # If $dir is a directory, return a list of all entries
  23         # it contains which match $pattern
  24         #
  25         local proc glob.readdir_pattern {dir pattern} {
  26                 set result {}
  27
  28                 # readdir doesn't return . or .., so simulate it here
  29                 if {$pattern in {. ..}} {
  30                         return $pattern
  31                 }
  32
  33                 # If the pattern isn't actually a pattern...
  34                 if {[string match {*[*?]*} $pattern]} {
  35                         # Use -nocomplain here to return nothing if $dir is not a directory
  36                         set files [readdir -nocomplain $dir]
  37                 } elseif {[file isdir $dir] && [file exists $dir/$pattern]} {
  38                         set files [list $pattern]
  39                 } else {
  40                         set files ""
  41                 }
  42
  43                 foreach name $files {
  44                         if {[string match $pattern $name]} {
  45                                 # Only include entries starting with . if the pattern starts with .
  46                                 if {[string index $name 0] eq "." && [string index $pattern 0] ne "."} {
  47                                         continue
  48                                 }
  49                                 lappend result $name
  50                         }
  51                 }
  52
  53                 return $result
  54         }
  55
  56         # If the pattern contains a braced expression, return a list of
  57         # patterns with the braces expanded. {c,b}* => c* b*
  58         # Otherwise just return the pattern
  59         # Note: Only supports one braced expression. i.e. not {a,b}*{c,d}*
  60         proc glob.expandbraces {pattern} {
  61                 # Avoid regexp for dependency reasons.
  62                 # XXX: Doesn't handle backslashed braces
  63                 if {[set fb [string first "\{" $pattern]] < 0} {
  64                         return $pattern
  65                 }
  66                 if {[set nb [string first "\}" $pattern $fb]] < 0} {
  67                         return $pattern
  68                 }
  69                 set before [string range $pattern 0 $fb-1]
  70                 set braced [string range $pattern $fb+1 $nb-1]
  71                 set after [string range $pattern $nb+1 end]
  72
  73                 lmap part [split $braced ,] {
  74                         set pat $before$part$after
  75                 }
  76         }
  77
  78         # Core glob implementation. Returns a list of files/directories matching the pattern
  79         proc glob.glob {pattern} {
  80                 set dir [file dirname $pattern]
  81                 if {$dir eq $pattern} {
  82                         # At the top level
  83                         return [list $dir]
  84                 }
  85
  86                 # Recursively expand the parent directory
  87                 set dirlist [glob.glob $dir]
  88                 set pattern [file tail $pattern]
  89
  90                 # Now collect the fiels/directories
  91                 set result {}
  92                 foreach dir $dirlist {
  93                         set globdir $dir
  94                         if {[string match "*/" $dir]} {
  95                                 set sep ""
  96                         } elseif {$dir eq "."} {
  97                                 set globdir ""
  98                                 set sep ""
  99                         } else {
 100                                 set sep /
 101                         }
 102                         foreach pat [glob.expandbraces $pattern] {
 103                                 foreach name [glob.readdir_pattern $dir $pat] {
 104                                         lappend result $globdir$sep$name
 105                                 }
 106                         }
 107                 }
 108                 return $result
 109         }
 110
 111         # Start of main glob
 112         set nocomplain 0
 113
 114         if {[lindex $args 0] eq "-nocomplain"} {
 115                 set nocomplain 1
 116                 set args [lrange $args 1 end]
 117         }
 118
 119         set result {}
 120         foreach pattern $args {
 121                 lappend result {*}[glob.glob $pattern]
 122         }
 123
 124         if {$nocomplain == 0 && [llength $result] == 0} {
 125                 return -code error "no files matched glob patterns"
 126         }
 127
 128         return $result
 129 }