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

  1. package require Thread
  2. package require fileutil
  3. package require tdom
  4.  
  5. set start [clock milliseconds]
  6.  
  7. proc parsefile {{path {}}} {
  8. set state {}
  9. while 1 {
  10. set path [yield true]
  11. # return current state if no path specified
  12. if {$path eq {}} {
  13. yield $state
  14. }
  15. if {[string match *.wsdl $path]} {
  16. set service [file tail $path]
  17. if {[lsearch -index 0 $state $service] == -1} {
  18. lappend state [format "%-20s: %s" $service [join [get_operations $path] ", "]]
  19. }
  20. }
  21. }
  22. }
  23.  
  24.  
  25. proc naive_find {path callback} {
  26. # A faster find function which only calls a callback
  27. # for every file and doesn't worry about
  28. # symlink loops or revisiting the same folder twice.
  29. # as a result it's much faster than fileutil::find
  30. foreach file [glob [file join $path *]] {
  31. if {[file isdirectory $file]} {
  32. naive_find $file $callback
  33. } else {
  34. $callback $file
  35. }
  36. }
  37. }
  38.  
  39.  
  40. proc get_operations {path} {
  41. set f [open $path]
  42. dom parse -channel $f doc
  43. close $f
  44. set namespaces [list wsdl http://schemas.xmlsoap.org/wsdl/]
  45. return [lmap x [$doc selectNodes -namespaces $namespaces /wsdl:definitions/wsdl:binding/wsdl:operation/@name] {lindex $x end}]
  46. }
  47.  
  48. puts "Naive [time {
  49. coroutine filtercmd parsefile
  50. naive_find ../xml/service filtercmd
  51. naive_find ../xml/legacy filtercmd
  52. } 1]us"
  53. # puts "Tcllib [time {
  54. # coroutine filtercmd parsefile
  55. # fileutil::find ../xml/service filtercmd
  56. # fileutil::find ../xml/legacy filtercmd
  57. # } 1]"
  58.  
  59. puts [join [lsort [filtercmd]] \n]
  60. puts "Puts took [expr {[clock milliseconds]-$start}]ms"
  61.