Posted to tcl by jdc at Fri Apr 29 08:25:33 GMT 2011view raw
- proc /search {r {S ""} {long 0} args} {
- variable detect_robots
- if {$detect_robots && [dict get? $r -ua_class] eq "robot"} {
- return [robot $r]
- }
- perms $r read
- if {$S eq "" && [llength $args] > 0} {
- set S [lindex $args 0]
- }
- Debug.wikit {/search: '$S'}
- dict set r -prefix "/$S"
- dict set r -suffix $S
- set qd [Dict get? $r -Query]
- if {[Query exists $qd S]
- && [set key [Query value $qd S]] ne ""
- } {
- if {[Query exists $qd F]} {
- set qdate [Query value $qd F]
- if {![string is integer -strict $qdate]} {
- set qdate 0
- }
- } else {
- set qdate 0
- }
- if {$long eq "1" && [string index $key end] ne "*"} {
- append key "*"
- }
- if {[regexp {^(.*)\*+$} $key]} {
- variable wikitdbpath
- return [Httpd Thread {
- puts "SQLITE: [package require sqlite3]"
- puts "TDBC: [package require tdbc::sqlite3]"
- package require Dict
- catch {tdbc::sqlite3::connection create db $dbfnm -readonly 1} msg
- puts "DB OPEN: $msg"
- set long [regexp {^(.*)\*+$} $key x key] ;# trim trailing *
- set fields name
- 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"
- set stmtimg "SELECT a.id, a.name, a.date, a.type FROM pages a, pages_binary b WHERE a.id = b.id"
- if {$long} {
- set n 0
- foreach k [split $key " "] {
- set keynm "key$n"
- set $keynm "*$k*"
- puts "$keynm = *$k*"
- append stmttxt " AND (lower(a.name) GLOB lower(:$keynm) OR lower(b.content) GLOB lower(:$keynm))"
- append stmtimg " AND lower(a.name) GLOB lower(:$keynm)"
- incr n
- }
- } else {
- foreach k [split $key " "] {
- set keynm "key$n"
- set $keynm "*$k*"
- puts "$keynm = *$k*"
- append stmttxt " AND lower(a.name) GLOB lower(:$keynm)"
- append stmtimg " AND lower(a.name) GLOB lower(:$keynm)"
- incr n
- }
- }
- if {$date > 0} {
- append stmttxt " AND a.date >= $date"
- append stmtimg " AND a.date >= $date"
- } else {
- append stmttxt " AND a.date > 0"
- append stmtimg " AND a.date > 0"
- }
- append stmttxt " ORDER BY a.date DESC"
- append stmtimg " ORDER BY a.date DESC"
- puts "STMTTXT: $stmttxt"
- set results {}
- set n 0
- set stmt [db prepare $stmttxt]
- $stmt foreach -as dicts d {
- puts $d
- lappend results [list id [dict get $d id] name [dict get $d name] date [dict get $d date] type [dict get? $d type]]
- incr n
- if {$n >= $max} {
- break
- }
- }
- $stmt close
- set n 0
- set stmt [db prepare $stmtimg]
- $stmt foreach -as dicts d {
- lappend results [list id [dict get $d id] name [dict get $d name] date [dict get $d date] type [dict get? $d type]]
- incr n
- if {$n >= $max} {
- break
- }
- }
- $stmt close
- db close
- set eresult [lrange [lsort -integer -decreasing -index 5 $results] 0 [expr {$max-1}]]
- return [thread::send [dict get $r -thread] [list WikitWub::sendSearchResults $r $eresult]]
- } r $r key $key dbfnm $wikitdbpath date $qdate max 10000]
- }
- return [/searchp $r 0]
- } else {
- return [/searchp $r 0]
- }
- }