Posted to tcl by mjanssen at Fri Apr 28 11:35:18 GMT 2017view pretty

package require Thread
package require fileutil
package require tdom

set start [clock milliseconds]

proc parsefile {{path {}}} {
  set state {}
  while 1 {
    set path [yield true] 
    # return current state if no path specified
    if {$path eq {}} {
      yield $state
    }
    if {[string match *.wsdl $path]} {
      set service [file tail $path]
      if {[lsearch -index 0 $state $service] == -1} {
        lappend state [format "%-20s: %s" $service [join [get_operations $path] ", "]]
      }
    } 
  }
}


proc naive_find {path callback} {
  # A faster find function which only calls a callback
  # for every file and doesn't worry about 
  # symlink loops or revisiting the same folder twice.
  # as a result it's much faster than fileutil::find
  foreach file [glob [file join $path *]] {
    if {[file isdirectory $file]} {
      naive_find $file $callback
    } else {
      $callback $file
    }
  }
}


proc get_operations {path} {
  set f [open $path]
  dom parse -channel $f doc
  close $f
  set namespaces [list wsdl http://schemas.xmlsoap.org/wsdl/]
  return [lmap x [$doc selectNodes -namespaces $namespaces /wsdl:definitions/wsdl:binding/wsdl:operation/@name] {lindex $x end}]
}

puts "Naive [time {
coroutine filtercmd parsefile
naive_find ../xml/service filtercmd
naive_find ../xml/legacy filtercmd
} 1]us"
# puts "Tcllib [time {
# coroutine filtercmd parsefile
# fileutil::find ../xml/service filtercmd
# fileutil::find ../xml/legacy filtercmd
# } 1]"

puts [join [lsort [filtercmd]] \n]
puts "Puts took [expr {[clock milliseconds]-$start}]ms"