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