Fossil SCM
| a106404… | drh | 1 | #!/usr/bin/tclsh |
| a106404… | drh | 2 | # |
| a106404… | drh | 3 | # Run this script from within any open Fossil checkout. Example: |
| a106404… | drh | 4 | # |
| a106404… | drh | 5 | # tclsh many-www.tcl | tee out.txt |
| a106404… | drh | 6 | # |
| a106404… | drh | 7 | # About 10,000 different web page requests will be made. Each is timed |
| a106404… | drh | 8 | # and the time shown on output. Use this script to search for segfault problems |
| a106404… | drh | 9 | # or to look for pages that need optimization. |
| a106404… | drh | 10 | # |
| a106404… | drh | 11 | proc run_query {url} { |
| a106404… | drh | 12 | set fd [open q.txt w] |
| a106404… | drh | 13 | puts $fd "GET $url HTTP/1.0\r\n\r" |
| a106404… | drh | 14 | close $fd |
| a106404… | drh | 15 | return [exec fossil test-http <q.txt] |
| a106404… | drh | 16 | } |
| a106404… | drh | 17 | set todo {} |
| a106404… | drh | 18 | foreach url { |
| a106404… | drh | 19 | /home |
| a106404… | drh | 20 | /timeline |
| a106404… | drh | 21 | /brlist |
| a106404… | drh | 22 | /taglist |
| a106404… | drh | 23 | /reportlist |
| a106404… | drh | 24 | /setup |
| a106404… | drh | 25 | /dir |
| a106404… | drh | 26 | /wcontent |
| 691f188… | drh | 27 | /attachlist |
| 691f188… | drh | 28 | /taglist |
| 5df726a… | drh | 29 | /test-env |
| 691f188… | drh | 30 | /stat |
| 691f188… | drh | 31 | /rcvfromlist |
| 691f188… | drh | 32 | /urllist |
| 691f188… | drh | 33 | /modreq |
| 691f188… | drh | 34 | /info/d5c4 |
| 691f188… | drh | 35 | /test-all-help |
| 691f188… | drh | 36 | /leaves |
| 691f188… | drh | 37 | /timeline?a=1970-01-01 |
| a106404… | drh | 38 | } { |
| a106404… | drh | 39 | set seen($url) 1 |
| a106404… | drh | 40 | set pending($url) 1 |
| a106404… | drh | 41 | } |
| 691f188… | drh | 42 | set round 1 |
| 691f188… | drh | 43 | set limit 25000 |
| a106404… | drh | 44 | set npending [llength [array names pending]] |
| a106404… | drh | 45 | proc get_pending {} { |
| 691f188… | drh | 46 | global pending npending round next |
| 691f188… | drh | 47 | if {$npending==0} { |
| 691f188… | drh | 48 | incr round |
| 691f188… | drh | 49 | array set pending [array get next] |
| 691f188… | drh | 50 | set npending [llength [array names pending]] |
| 691f188… | drh | 51 | unset -nocomplain next |
| 691f188… | drh | 52 | } |
| a106404… | drh | 53 | set res [lindex [array names pending] [expr {int(rand()*$npending)}]] |
| a106404… | drh | 54 | unset pending($res) |
| a106404… | drh | 55 | incr npending -1 |
| a106404… | drh | 56 | return $res |
| a106404… | drh | 57 | } |
| 691f188… | drh | 58 | for {set i 0} {$i<$limit} {incr i} { |
| a106404… | drh | 59 | set url [get_pending] |
| 691f188… | drh | 60 | puts -nonewline "($round/[expr {$i+1}]) $url " |
| a106404… | drh | 61 | flush stdout |
| a106404… | drh | 62 | set tm [time {set x [run_query $url]}] |
| a106404… | drh | 63 | set ms [lindex $tm 0] |
| a106404… | drh | 64 | puts [format {%.3fs} [expr {$ms/1000000.0}]] |
| a106404… | drh | 65 | flush stdout |
| a106404… | drh | 66 | if {[string length $x]>1000000} { |
| a106404… | drh | 67 | set x [string range $x 0 1000000] |
| a106404… | drh | 68 | } |
| 76e8600… | drh | 69 | set k 0 |
| a106404… | drh | 70 | while {[regexp {<[aA] .*?href="(/[a-z].*?)".*?>(.*)$} $x all url tail]} { |
| a106404… | drh | 71 | # if {$npending>2*($limit - $i)} break |
| 76e8600… | drh | 72 | incr k |
| 76e8600… | drh | 73 | if {$k>100} break |
| a106404… | drh | 74 | set u2 [string map {< < > > " \" & &} $url] |
| a106404… | drh | 75 | if {![info exists seen($u2)]} { |
| 691f188… | drh | 76 | set next($u2) 1 |
| a106404… | drh | 77 | set seen($u2) 1 |
| a106404… | drh | 78 | } |
| a106404… | drh | 79 | set x $tail |
| a106404… | drh | 80 | } |
| a106404… | drh | 81 | } |