Index: openacs-4/packages/search/tcl/extra-args-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/search/tcl/extra-args-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/search/tcl/extra-args-procs.tcl 13 Mar 2009 18:57:19 -0000 1.1 @@ -0,0 +1,36 @@ +# + +ad_library { + + Handle extra arguments not defined in service contract. + Preliminary support for package_ids and object_type as an example + + @author Dave Bauer (dave@thedesignexperience.org) + @creation-date 2009-03-13 + @cvs-id $Id: extra-args-procs.tcl,v 1.1 2009/03/13 18:57:19 daveb Exp $ +} + +ad_proc -callback search::extra_arg -impl object_type { + -value + -object_table_alias +} { + Implement per object type search +} { + if {$object_table_alias eq "" || ![info exists object_table_alias] || $value eq ""} { + return [list] + } + return [list from_clause {} where_clause "$object_table_alias.object_type = '[db_quote $value]'"] + +} + +ad_proc -callback search::extra_arg -impl package_ids { + -value + -object_table_alias +} { + Implement per package_id search +} { + if {$object_table_alias eq "" || ![info exists object_table_alias] || $value eq ""} { + return [list] + } + return [list from_clause {} where_clause "$object_table_alias.package_id in ([template::util::tcl_to_sql_list $value])"] +} \ No newline at end of file Index: openacs-4/packages/search/tcl/search-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/search/tcl/search-procs.tcl,v diff -u -N -r1.45 -r1.46 --- openacs-4/packages/search/tcl/search-procs.tcl 13 Feb 2009 21:26:43 -0000 1.45 +++ openacs-4/packages/search/tcl/search-procs.tcl 13 Mar 2009 18:57:19 -0000 1.46 @@ -285,6 +285,7 @@ {-dt ""} {-package_ids ""} {-object_type ""} + {-extra_args {}} } { This callback is invoked when a search is to be performed. Query will be a list of lists. The first list is required and will be a @@ -380,3 +381,63 @@ } return "" } + +ad_proc -callback search::extra_arg { + -value + {-object_table_alias {}} +} { + Generate a query fragment for search filtering by extra argument + Argument name will be the implementation name called + + Search driver should call this for every extra argument and then build the search query using the query fragments returned + + @param value value of the argument + @param object_table_alias SQL alias of table that contains the object_id to join against + + @return list in array format of {from_clause {} where_clause {}} +} - + +ad_proc search::extra_args_names { +} { + List of names of extra args implemented +} { + set names [list] + foreach procname [info procs ::callback::search::extra_arg::impl::*] { + lappend names [namespace tail $procname] + } + return $names +} + +ad_proc search::extra_args_page_contract { +} { + Generate ad_page_contract fragment for extra_args options + + Get all the callback impls for extra_args and add + a page contract declaration + + @return string containing the ad_page_contract query delcarations + for the extra_args that are implemented +} { + set contract "" + foreach name [extra_args_names] { + append contract "\{$name \{\}\}\n" + } + return $contract +} + +ad_proc search::extra_args { +} { + List of extra_args to pass to search::search callback +} { + set extra_args [list] + foreach name [extra_args_names] { + upvar $name local_$name + ns_log debug "extra_args name = '${name}' exists [info exists local_${name}]" + if {[info exists local_$name]} { + lappend extra_args $name [set local_$name] + } + } + return $extra_args +} + + Index: openacs-4/packages/search/www/search.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/search/www/search.tcl,v diff -u -N -r1.34 -r1.35 --- openacs-4/packages/search/www/search.tcl 13 Feb 2009 21:26:43 -0000 1.34 +++ openacs-4/packages/search/www/search.tcl 13 Mar 2009 18:57:19 -0000 1.35 @@ -11,7 +11,7 @@ {dts:trim ""} {search_package_id ""} {scope ""} - {object_type "all"} + {object_type ""} } -validate { keywords_p { if {![exists_and_not_null q]} { @@ -117,7 +117,7 @@ # FIXME do this in the intermedia driver! # set final_query_string [db_string final_query_select "select site_wide_search.im_convert(:q) from dual"] - array set result [lindex [callback -impl $driver search::search -query $q -offset $offset -limit $limit -user_id $user_id -df $df -package_ids $search_package_id -object_type $object_type] 0] + array set result [lindex [callback -impl $driver search::search -query $q -offset $offset -limit $limit -user_id $user_id -df $df -extra_args [list package_ids $search_package_id object_type $object_type]] 0] } else { array set result [acs_sc_call FtsEngineDriver search $params $driver] } @@ -160,14 +160,17 @@ template::multirow create searchresult title_summary txt_summary url_one object_id for { set __i 0 } { $__i < [expr {$high - $low +1}] } { incr __i } { - set object_id [lindex $result(ids) $__i] + if {$object_id eq ""} { + ns_log warning "Search object_id is empty, this should never happen query was '${q}'" + continue + } set object_type [acs_object_type $object_id] if {[callback::impl_exists -impl $object_type -callback search::datasource]} { array set datasource [lindex [callback -impl $object_type search::datasource -object_id $object_id] 0] set url_one [lindex [callback -impl $object_type search::url -object_id $object_id] 0] } else { - ns_log notice "SEARCH search/www/search.tcl callback::datasource::$object_type not found" + ns_log warning "SEARCH search/www/search.tcl callback::datasource::$object_type not found" array set datasource [acs_sc_call FtsContentProvider datasource [list $object_id] $object_type] set url_one [acs_sc_call FtsContentProvider url [list $object_id] $object_type] } Index: openacs-4/packages/tsearch2-driver/tcl/tsearch2-driver-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/tsearch2-driver/tcl/tsearch2-driver-procs-postgresql.xql,v diff -u -N -r1.7 -r1.8 --- openacs-4/packages/tsearch2-driver/tcl/tsearch2-driver-procs-postgresql.xql 20 Oct 2008 17:03:21 -0000 1.7 +++ openacs-4/packages/tsearch2-driver/tcl/tsearch2-driver-procs-postgresql.xql 13 Mar 2009 18:57:19 -0000 1.8 @@ -11,7 +11,7 @@ - + postgresql8.3 where fti @@ to_tsquery(:query) @@ -23,10 +23,15 @@ - + postgresql8.3 - select txt.object_id $base_query + select txt.object_id + from + [join $from_clauses ","] + $base_query + [expr {[llength $where_clauses] > 0 ? " and " : ""}] + [join $where_clauses " and "] order by ts_rank(fti,to_tsquery(:query)) desc $limit_clause $offset_clause @@ -61,7 +66,7 @@ - + postgresql8.0 where fti @@ to_tsquery('default',:query) @@ -73,10 +78,15 @@ - + postgresql8.0 - select txt.object_id $base_query + select txt.object_id + from + [join $from_clauses ","] + $base_query + [expr {[llength $where_clauses] > 0 ? " and " : ""}] + [join $where_clauses " and "] order by rank(fti,to_tsquery('default',:query)) desc $limit_clause $offset_clause @@ -85,7 +95,7 @@ postgresql8.0 - select headline(:txt,to_tsquery('default',:query)) + select headline('default',:txt,to_tsquery('default',:query)) Index: openacs-4/packages/tsearch2-driver/tcl/tsearch2-driver-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/tsearch2-driver/tcl/tsearch2-driver-procs.tcl,v diff -u -N -r1.25 -r1.26 --- openacs-4/packages/tsearch2-driver/tcl/tsearch2-driver-procs.tcl 22 Sep 2008 16:26:56 -0000 1.25 +++ openacs-4/packages/tsearch2-driver/tcl/tsearch2-driver-procs.tcl 13 Mar 2009 18:57:19 -0000 1.26 @@ -84,13 +84,13 @@ } } -ad_proc -public tsearch2::search { +ad_proc -callback search::search -impl tsearch2-driver { + {-extra_args {}} query offset limit user_id df - packages } { ftsenginedriver search operation implementation for tsearch2 @@ -113,12 +113,15 @@ @error } { + set packages {} # JCD: I have done something horrible. I took out dt and # made it packages. when you search there is no way to specify a date range just # last six months, last year etc. I hijack what was the old dt param and make it # the package_id list and just empty string for dt. set dt {} + set orig_query $query + # clean up query for tsearch2 set query [tsearch2::build_query -query $query] @@ -136,13 +139,26 @@ set base_query [db_map base_query] if {$df ne ""} { set need_acs_objects 1 - append base_query " and o.creation_date > :df" + lappend where_clauses " and o.creation_date > :df" } if {$dt ne ""} { set need_acs_objects 1 - append base_query " and o.creation_date < :dt" + lappend where_clauses " and o.creation_date < :dt" } + foreach {arg value} $extra_args { + array set arg_clauses [lindex [callback -impl $arg search::extra_arg -value $value -object_table_alias "o"] 0] + if {[info exists arg_clauses(from_clause)] && $arg_clauses(from_clause) ne ""} { + lappend from_clauses $arg_clauses(from_clause) + } + if {[info exists arg_clauses(where_clause)] && $arg_clauses(where_clause) ne ""} { + lappend where_clauses "$arg_clauses(where_clause)" + } + } + if {[llength $extra_args]} { + # extra_args can assume a join on acs_objects + set need_acs_objects 1 + } # generate the package id restriction. set ids {} foreach id $packages { @@ -152,17 +168,18 @@ } if {$ids ne ""} { set need_acs_objects 1 - append base_query " and o.package_id in ([join $ids ,])" + lappend where_clauses "o.package_id in ([join $ids ,])" } if {$need_acs_objects} { - set base_query "from txt, acs_objects o $base_query and o.object_id = txt.object_id" + lappend from_clauses "txt" "acs_objects o" + lappend where_clauses "o.object_id = txt.object_id" } else { - set base_query "from txt $base_query" + lappend from_clauses "txt" } - + set results_ids [db_list search {}] - set count [db_string count "select count(*) $base_query"] + set count [db_string count "select count(*) from txt $base_query"] set stop_words [list] @@ -189,9 +206,16 @@ @error } { set query [tsearch2::build_query -query $query] - return [db_string summary {}] + return [db_string summary {}] } +ad_proc -callback search::driver_info -impl tsearch2-driver { +} { + Search driver info callback +} { + return [tsearch2::driver_info] +} + ad_proc -public tsearch2::driver_info { } { @@ -290,12 +314,6 @@ set end_q 0 set valid_operators [tsearch2_driver::valid_operators] foreach e [split $query] { - ns_log notice " -DB -------------------------------------------------------------------------------- -DB DAVE debugging procedure tsearch2::seperate_query_and_operators -DB -------------------------------------------------------------------------------- -DB e = '${e}' -DB --------------------------------------------------------------------------------" if {[regexp {(^\w*):} $e discard operator] \ && [lsearch -exact $valid_operators $operator] != -1} { # query element contains an operator, split operator from