Posted to tcl by jdc at Fri Apr 29 08:25:33 GMT 2011view raw

  1. proc /search {r {S ""} {long 0} args} {
  2. variable detect_robots
  3. if {$detect_robots && [dict get? $r -ua_class] eq "robot"} {
  4. return [robot $r]
  5. }
  6.  
  7. perms $r read
  8.  
  9. if {$S eq "" && [llength $args] > 0} {
  10. set S [lindex $args 0]
  11. }
  12.  
  13. Debug.wikit {/search: '$S'}
  14. dict set r -prefix "/$S"
  15. dict set r -suffix $S
  16.  
  17. set qd [Dict get? $r -Query]
  18. if {[Query exists $qd S]
  19. && [set key [Query value $qd S]] ne ""
  20. } {
  21. if {[Query exists $qd F]} {
  22. set qdate [Query value $qd F]
  23. if {![string is integer -strict $qdate]} {
  24. set qdate 0
  25. }
  26. } else {
  27. set qdate 0
  28. }
  29. if {$long eq "1" && [string index $key end] ne "*"} {
  30. append key "*"
  31. }
  32. if {[regexp {^(.*)\*+$} $key]} {
  33. variable wikitdbpath
  34. return [Httpd Thread {
  35. puts "SQLITE: [package require sqlite3]"
  36. puts "TDBC: [package require tdbc::sqlite3]"
  37. package require Dict
  38. catch {tdbc::sqlite3::connection create db $dbfnm -readonly 1} msg
  39. puts "DB OPEN: $msg"
  40. set long [regexp {^(.*)\*+$} $key x key] ;# trim trailing *
  41. set fields name
  42. set stmttxt "SELECT a.id, a.name, a.date, a.type FROM pages a, pages_content b WHERE a.id = b.id AND length(a.name) > 0 AND length(b.content) > 1"
  43. set stmtimg "SELECT a.id, a.name, a.date, a.type FROM pages a, pages_binary b WHERE a.id = b.id"
  44. if {$long} {
  45. set n 0
  46. foreach k [split $key " "] {
  47. set keynm "key$n"
  48. set $keynm "*$k*"
  49. puts "$keynm = *$k*"
  50. append stmttxt " AND (lower(a.name) GLOB lower(:$keynm) OR lower(b.content) GLOB lower(:$keynm))"
  51. append stmtimg " AND lower(a.name) GLOB lower(:$keynm)"
  52. incr n
  53. }
  54. } else {
  55. foreach k [split $key " "] {
  56. set keynm "key$n"
  57. set $keynm "*$k*"
  58. puts "$keynm = *$k*"
  59. append stmttxt " AND lower(a.name) GLOB lower(:$keynm)"
  60. append stmtimg " AND lower(a.name) GLOB lower(:$keynm)"
  61. incr n
  62. }
  63. }
  64. if {$date > 0} {
  65. append stmttxt " AND a.date >= $date"
  66. append stmtimg " AND a.date >= $date"
  67. } else {
  68. append stmttxt " AND a.date > 0"
  69. append stmtimg " AND a.date > 0"
  70. }
  71. append stmttxt " ORDER BY a.date DESC"
  72. append stmtimg " ORDER BY a.date DESC"
  73.  
  74. puts "STMTTXT: $stmttxt"
  75.  
  76. set results {}
  77. set n 0
  78. set stmt [db prepare $stmttxt]
  79. $stmt foreach -as dicts d {
  80. puts $d
  81. lappend results [list id [dict get $d id] name [dict get $d name] date [dict get $d date] type [dict get? $d type]]
  82. incr n
  83. if {$n >= $max} {
  84. break
  85. }
  86. }
  87. $stmt close
  88.  
  89. set n 0
  90. set stmt [db prepare $stmtimg]
  91. $stmt foreach -as dicts d {
  92. lappend results [list id [dict get $d id] name [dict get $d name] date [dict get $d date] type [dict get? $d type]]
  93. incr n
  94. if {$n >= $max} {
  95. break
  96. }
  97. }
  98. $stmt close
  99.  
  100. db close
  101. set eresult [lrange [lsort -integer -decreasing -index 5 $results] 0 [expr {$max-1}]]
  102. return [thread::send [dict get $r -thread] [list WikitWub::sendSearchResults $r $eresult]]
  103. } r $r key $key dbfnm $wikitdbpath date $qdate max 10000]
  104. }
  105. return [/searchp $r 0]
  106. } else {
  107. return [/searchp $r 0]
  108. }
  109. }