Open-ILS/src/perlmods/OpenILS/Application/Search.pm

   1 package OpenILS::Application::Search;
   2 use base qw/OpenSRF::Application/;
   3 use strict; use warnings;
   4 use JSON;
   5
   6 use OpenILS::Utils::Fieldmapper;
   7 use OpenILS::Utils::ModsParser;
   8 use OpenSRF::Utils::SettingsClient;
   9 use OpenSRF::Utils::Cache;
  10
  11
  12 #use OpenILS::Application::Search::StaffClient;
  13 use OpenILS::Application::Search::Biblio;
  14 use OpenILS::Application::Search::Actor;
  15 use OpenILS::Application::Search::Z3950;
  16
  17 use OpenILS::Application::AppUtils;
  18
  19 use Time::HiRes qw(time);
  20 use OpenSRF::EX qw(:try);
  21
  22 # Houses generic search utilites
  23
  24 sub child_init {
  25         OpenILS::Application::SearchCache->child_init();
  26 }
  27
  28 sub filter_search {
  29         my($self, $str, $full) = @_;
  30
  31         my $string = $str;
  32
  33         $string =~ s/\s+the\s+/ /oi;
  34         $string =~ s/\s+an\s+/ /oi;
  35         $string =~ s/\s+a\s+/ /oi;
  36
  37         $string =~ s/^the\s+//io;
  38         $string =~ s/^an\s+//io;
  39         $string =~ s/^a\s+//io;
  40
  41         $string =~ s/\s+the$//io;
  42         $string =~ s/\s+an$//io;
  43         $string =~ s/\s+a$//io;
  44
  45         $string =~ s/^the$//io;
  46         $string =~ s/^an$//io;
  47         $string =~ s/^a$//io;
  48
  49
  50         if(!$full) {
  51                 if($string =~ /^\s*$/o) {
  52                         return "";
  53                 } else {
  54                         return $str;
  55                 }
  56         }
  57
  58         my @words = qw/
  59         fiction
  60         bibliograph
  61         juvenil
  62         histor
  63         literatur
  64         biograph
  65         stor
  66         american
  67         videorecord
  68         count
  69         film
  70         life
  71         book
  72         children
  73         centur
  74         war
  75         genealog
  76         etc
  77         state
  78         unit
  79         /;
  80
  81         push @words, "united state";
  82
  83         for my $word (@words) {
  84                 if($string =~ /^\s*"?\s*$word\w*\s*"?\s*$/i) {
  85                         return "";
  86                 }
  87         }
  88
  89         warn "Cleansed string to: $string\n";
  90         if($string =~ /^\s*$/o) {
  91                 return "";
  92         } else {
  93                 return $str;
  94         }
  95
  96         return $string;
  97 }
  98
  99
 100
 101 __PACKAGE__->register_method(
 102         method  => "get_org_sub_tree",
 103         api_name        => "open-ils.search.actor.org_subtree.retrieve",
 104         argc            => 1,
 105         note            => "Returns the entire org tree structure",
 106 );
 107
 108 sub get_sub_org_tree {
 109
 110         my( $self, $client, $user_session ) = @_;
 111
 112         if(!$user_session) {
 113                 throw OpenSRF::EX::InvalidArg
 114                         ("No User session provided to org_subtree.retrieve");
 115         }
 116
 117         if( $user_session ) {
 118
 119                 my $user_obj =
 120                         OpenILS::Application::AppUtils->check_user_session( $user_session ); #throws EX on error
 121
 122
 123                 my $session = OpenSRF::AppSession->create("open-ils.storage");
 124                 my $request = $session->request(
 125                                 "open-ils.storage.direct.actor.org_unit.retrieve", $user_obj->home_ou );
 126                 my $response = $request->recv();
 127
 128                 if(!$response) {
 129                         throw OpenSRF::EX::ERROR (
 130                                         "No response from storage for org_unit retrieve");
 131                 }
 132                 if(UNIVERSAL::isa($response,"Error")) {
 133                         throw $response ($response->stringify);
 134                 }
 135
 136                 my $home_ou = $response->content;
 137
 138                 # XXX grab descendants and build org tree from them
 139 =head comment
 140                 my $request = $session->request(
 141                                 "open-ils.storage.actor.org_unit_descendants" );
 142                 my $response = $request->recv();
 143                 if(!$response) {
 144                         throw OpenSRF::EX::ERROR (
 145                                         "No response from storage for org_unit retrieve");
 146                 }
 147                 if(UNIVERSAL::isa($response,"Error")) {
 148                         throw $response ($response->stringify);
 149                 }
 150
 151                 my $descendants = $response->content;
 152 =cut
 153
 154                 $request->finish();
 155                 $session->disconnect();
 156
 157                 return $home_ou;
 158         }
 159
 160         return undef;
 161
 162 }
 163
 164
 165
 166
 167
 168
 169
 170
 171 package OpenILS::Application::SearchCache;
 172 use strict; use warnings;
 173
 174 my $cache_handle;
 175 my $max_timeout;
 176
 177 sub child_init {
 178
 179         my $config_client = OpenSRF::Utils::SettingsClient->new();
 180         my $memcache_servers =
 181                 $config_client->config_value(
 182                                 "apps","open-ils.search", "app_settings","memcache" );
 183
 184         if( !$memcache_servers ) {
 185                 throw OpenSRF::EX::Config ("
 186                                 No Memcache servers specified for open-ils.search!");
 187         }
 188
 189         if(!ref($memcache_servers)) {
 190                 $memcache_servers = [$memcache_servers];
 191         }
 192         $cache_handle = OpenSRF::Utils::Cache->new( "open-ils.search", 0, $memcache_servers );
 193         $max_timeout = $config_client->config_value(
 194                         "apps", "open-ils.search", "app_settings", "max_cache_time" );
 195
 196         if(ref($max_timeout) eq "ARRAY") {
 197                 $max_timeout = $max_timeout->[0];
 198         }
 199
 200 }
 201
 202 sub new {return bless({},shift());}
 203
 204 sub put_cache {
 205         my($self, $key, $data, $timeout) = @_;
 206         return undef unless( $key and $data );
 207
 208         $timeout ||= $max_timeout;
 209         $timeout = ($timeout <= $max_timeout) ? $timeout : $max_timeout;
 210
 211         warn "putting $key into cache for $timeout seconds\n";
 212         $cache_handle->put_cache( "_open-ils.search_$key", JSON->perl2JSON($data), $timeout );
 213 }
 214
 215 sub get_cache {
 216         my( $self, $key ) = @_;
 217         my $json =  $cache_handle->get_cache("_open-ils.search_$key");
 218         if($json) {
 219                 warn "retrieving from cache $key\n  =>>>  $json";
 220         }
 221         return JSON->JSON2perl($json);
 222 }
 223
 224
 225
 226
 227 1;