Forum OpenACS Improvement Proposals (TIPs): TIP #130 (Implemented) Add -extra_args to search callback definition

This is a proposal to allow building more complex search queries by adding a new parameter to the search::search tcl procedure called "extra_args" This would be a list of key value pairs used to build up a complex query.

In addition the search::search callback for search drivers will add this new parameter. The search driver then takes the extra args parameter and calls a search::extra_args callback for each extra argument.

The extra argument will return a from clause and where clause to be added to the search query.

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_${n\
ame}]"
        if {[info exists local_$name]} {
            lappend extra_args $name [set local_$name]
        }
    }
    return $extra_args
}

ad_proc -callback search::search -impl tsearch2-driver {
    {-extra_args {}}
    query
    offset
    limit
    user_id
    df
    {packages {}}
} {
    ftsenginedriver search operation implementation for tsearch2

    @author Dave Bauer (dave@thedesignexperience.org)
    @creation-date 2004-06-05

    @param query

    @param offset

    @param limit

    @param user_id

    @param df

    @param packages list of packages to search for content in.

    @return

    @error
} {
    # 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 rang\
e just                                                                          
    # last six months, last year etc.  I hijack what was the old dt param and m\
ake 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]

    # don't use bind vars since pg7.3 yacks for '1' (which is what comes out of\
 bind vars)                                                                     
    set limit_clause ""
    set offset_clause ""
    if {[string is integer -strict $limit]} {
        set limit_clause " limit $limit "
    }
    if {[string is integer -strict $offset]} {
        set offset_clause " offset $offset "
    }

    if { $orig_query eq "" } {
    set base_query {
	from txt, acs_objects o
        where o.object_id = txt.object_id
        and exists (select 1
                    from acs_object_party_privilege_map m
                    where m.object_id = txt.object_id
                      and m.party_id = :user_id
                      and m.privilege = 'read')}
    } else {
    set base_query {
	from txt, acs_objects o
        where fti @@ to_tsquery('default',:query)
	and o.object_id = txt.object_id
        and exists (select 1
                    from acs_object_party_privilege_map m
                    where m.object_id = txt.object_id
                      and m.party_id = :user_id
                      and m.privilege = 'read')}
    }
    if {![empty_string_p $df]} {
        append base_query " and o.creation_date > :df"
    }
    if {![empty_string_p $dt]} {
        append base_query " and o.creation_date < :dt"
    }
ns_log notice "extra args $extra_args"
    foreach {arg value} $extra_args {
        array set arg_clauses [lindex [callback -impl $arg search::extra_arg -v\
alue $value -object_table_alias o] 0]
        ns_log notice "[array get arg_clauses]"
	if {[info exists arg_clauses(from_clause)] && $arg_clauses(from_clause)\
 ne ""} {
            # noop                                                              
	}
        if {[info exists arg_clauses(where_clause)] && $arg_clauses(where_claus\
e) ne ""} {
            ns_log notice "APPENDING"
            append base_query " and $arg_clauses(where_clause)"
        }
    }
    # generate the package id restriction.                                      
    set ids {}
    if {[info exists packages]} {
        foreach id $packages {
            if {[string is integer -strict $id]} {
                lappend ids $id
            }
	}
    }
    if {![empty_string_p $ids]} {
        append base_query " and o.package_id in ([join $ids ,])"
    }

    if { $orig_query eq "" } {
    set results_ids [db_list search \
                         "select o.object_id $base_query                        
   order by o.creation_date desc                                                
   $limit_clause $offset_clause"]
    } else {
    set results_ids [db_list search \
                        "select o.object_id $base_query                        
   order by rank(fti,to_tsquery('default',:query)) desc                         
   $limit_clause $offset_clause"]
    }

    set count [db_string count "select count(*) $base_query"]

    set stop_words [list]

    # lovely the search package requires count to be returned but the           
    # service contract definition doesn't specify it!                           
    return [list ids $results_ids stopwords $stop_words count $count]
}