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