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::Web;
  14
  15 use OpenILS::Application::AppUtils;
  16
  17 use Time::HiRes qw(time);
  18 use OpenSRF::EX qw(:try);
  19
  20 # Houses generic search utilites
  21
  22 sub child_init {
  23         OpenILS::Application::SearchCache->child_init();
  24 }
  25
  26
  27
  28 __PACKAGE__->register_method(
  29         method  => "biblio_search_marc",
  30         api_name        => "open-ils.search.biblio.marc",
  31         argc            => 1,
  32         note            => "Searches biblio information by marc tag",
  33 );
  34
  35 sub biblio_search_marc {
  36
  37         my( $self, $client, $search_hash, $string ) = @_;
  38
  39         warn "Building biblio marc session\n";
  40         my $session = OpenSRF::AppSession->create("open-ils.storage");
  41
  42         warn "Sending biblio marc request\n";
  43         my $request = $session->request(
  44                         "open-ils.storage.metabib.full_rec.search_fts.index_vector",
  45                         $search_hash, $string );
  46
  47         warn "Waiting complete\n";
  48         $request->wait_complete();
  49
  50         warn "Calling recv\n";
  51         my $response = $request->recv(20);
  52
  53         warn "out of recv\n";
  54         if($response and UNIVERSAL::isa($response,"OpenSRF::EX")) {
  55                 throw $response ($response->stringify);
  56         }
  57
  58
  59         my $data = [];
  60         if($response and UNIVERSAL::can($response,"content")) {
  61                 $data = $response->content;
  62         }
  63         warn "finishing request\n";
  64
  65         $request->finish();
  66         $session->finish();
  67         $session->disconnect();
  68
  69         return $data;
  70
  71 }
  72
  73
  74
  75 __PACKAGE__->register_method(
  76         method  => "get_org_tree",
  77         api_name        => "open-ils.search.actor.org_tree.retrieve",
  78         argc            => 1,
  79         note            => "Returns the entire org tree structure",
  80 );
  81
  82 sub get_org_tree {
  83
  84         my( $self, $client, $user_session ) = @_;
  85
  86         if( $user_session ) { # keep for now for backwards compatibility
  87
  88                 my $user_obj =
  89                         OpenILS::Application::AppUtils->check_user_session( $user_session ); #throws EX on error
  90
  91                 my $session = OpenSRF::AppSession->create("open-ils.storage");
  92                 my $request = $session->request(
  93                                 "open-ils.storage.actor.org_unit.retrieve", $user_obj->home_ou );
  94                 my $response = $request->recv();
  95
  96                 if(!$response) {
  97                         throw OpenSRF::EX::ERROR (
  98                                         "No response from storage for org_unit retrieve");
  99                 }
 100                 if(UNIVERSAL::isa($response,"Error")) {
 101                         throw $response ($response->stringify);
 102                 }
 103
 104                 my $home_ou = $response->content;
 105                 $request->finish();
 106                 $session->disconnect();
 107
 108                 return $home_ou;
 109         }
 110
 111         return OpenILS::Application::AppUtils->get_org_tree();
 112 }
 113
 114
 115
 116 __PACKAGE__->register_method(
 117         method  => "get_org_sub_tree",
 118         api_name        => "open-ils.search.actor.org_subtree.retrieve",
 119         argc            => 1,
 120         note            => "Returns the entire org tree structure",
 121 );
 122
 123 sub get_sub_org_tree {
 124
 125         my( $self, $client, $user_session ) = @_;
 126
 127         if(!$user_session) {
 128                 throw OpenSRF::EX::InvalidArg
 129                         ("No User session provided to org_subtree.retrieve");
 130         }
 131
 132         if( $user_session ) {
 133
 134                 my $user_obj =
 135                         OpenILS::Application::AppUtils->check_user_session( $user_session ); #throws EX on error
 136
 137
 138                 my $session = OpenSRF::AppSession->create("open-ils.storage");
 139                 my $request = $session->request(
 140                                 "open-ils.storage.actor.org_unit.retrieve", $user_obj->home_ou );
 141                 my $response = $request->recv();
 142
 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 $home_ou = $response->content;
 152
 153                 # XXX grab descendants and build org tree from them
 154 =head comment
 155                 my $request = $session->request(
 156                                 "open-ils.storage.actor.org_unit_descendants" );
 157                 my $response = $request->recv();
 158                 if(!$response) {
 159                         throw OpenSRF::EX::ERROR (
 160                                         "No response from storage for org_unit retrieve");
 161                 }
 162                 if(UNIVERSAL::isa($response,"Error")) {
 163                         throw $response ($response->stringify);
 164                 }
 165
 166                 my $descendants = $response->content;
 167 =cut
 168
 169                 $request->finish();
 170                 $session->disconnect();
 171
 172                 return $home_ou;
 173         }
 174
 175         return undef;
 176
 177 }
 178
 179
 180
 181
 182 # ---------------------------------------------------------------------------
 183 # takes a list of record id's and turns the docs into friendly
 184 # mods structures. Creates one MODS structure for each doc id.
 185 # ---------------------------------------------------------------------------
 186 sub _records_to_mods {
 187         my @ids = @_;
 188
 189         my @results;
 190         my @marcxml_objs;
 191
 192         my $session = OpenSRF::AppSession->create("open-ils.storage");
 193         my $request = $session->request(
 194                         "open-ils.storage.biblio.record_marc.batch.retrieve",  @ids );
 195
 196         my $last_content = undef;
 197
 198         while( my $response = $request->recv() ) {
 199
 200                 if( $last_content ) {
 201                         my $u = OpenILS::Utils::ModsParser->new();
 202                         $u->start_mods_batch( $last_content->marc );
 203                         my $mods = $u->finish_mods_batch();
 204                         $mods->{doc_id} = $last_content->id();
 205                         warn "Turning doc " . $mods->{doc_id} . " into MODS\n";
 206                         $last_content = undef;
 207                         push @results, $mods;
 208                 }
 209
 210                 next unless $response;
 211
 212                 if($response->isa("OpenSRF::EX")) {
 213                         throw $response ($response->stringify);
 214                 }
 215
 216                 $last_content = $response->content;
 217
 218         }
 219
 220         if( $last_content ) {
 221                 my $u = OpenILS::Utils::ModsParser->new();
 222                 $u->start_mods_batch( $last_content->marc );
 223                 my $mods = $u->finish_mods_batch();
 224                 $mods->{doc_id} = $last_content->id();
 225                 push @results, $mods;
 226         }
 227
 228         $request->finish();
 229         $session->finish();
 230         $session->disconnect();
 231
 232         return \@results;
 233
 234 }
 235
 236 __PACKAGE__->register_method(
 237         method  => "record_id_to_mods",
 238         api_name        => "open-ils.search.biblio.record.mods.retrieve",
 239         argc            => 1,
 240         note            => "Provide ID, we provide the mods"
 241 );
 242
 243 # converts a record into a mods object with copy counts attached
 244 sub record_id_to_mods {
 245
 246         my( $self, $client, $org_id, $id ) = @_;
 247
 248         my $mods_list = _records_to_mods( $id );
 249         my $mods_obj = $mods_list->[0];
 250         my $cmethod = $self->method_lookup(
 251                         "open-ils.search.biblio.record.copy_count");
 252         my ($count) = $cmethod->run($org_id, $id);
 253         $mods_obj->{copy_count} = $count;
 254
 255         return $mods_obj;
 256 }
 257
 258
 259
 260 # Returns the number of copies attached to a record based on org location
 261 __PACKAGE__->register_method(
 262         method  => "record_id_to_copy_count",
 263         api_name        => "open-ils.search.biblio.record.copy_count",
 264         argc            => 2,
 265         note            => "Provide ID, we provide the copy count"
 266 );
 267
 268 sub record_id_to_copy_count {
 269         my( $self, $client, $org_id, $record_id ) = @_;
 270
 271         my $session = OpenSRF::AppSession->create("open-ils.storage");
 272         warn "mods retrieve $record_id\n";
 273         my $request = $session->request(
 274                 "open-ils.storage.biblio.record_copy_count",  $org_id, $record_id );
 275
 276         warn "mods retrieve wait $record_id\n";
 277         $request->wait_complete;
 278
 279         warn "mods retrieve recv $record_id\n";
 280         my $response = $request->recv();
 281         return undef unless $response;
 282
 283         warn "mods retrieve after recv $record_id\n";
 284
 285         if( $response and UNIVERSAL::isa($response, "Error")) {
 286                 throw $response ($response->stringify);
 287         }
 288
 289         my $count = $response->content;
 290
 291         $request->finish();
 292         $session->finish();
 293         $session->disconnect();
 294
 295         return $count;
 296 }
 297
 298
 299
 300
 301
 302 package OpenILS::Application::SearchCache;
 303 use strict; use warnings;
 304
 305 my $cache_handle;
 306 my $max_timeout;
 307
 308 sub child_init {
 309
 310         my $config_client = OpenSRF::Utils::SettingsClient->new();
 311         my $memcache_servers =
 312                 $config_client->config_value(
 313                                 "apps","open-ils.search", "app_settings","memcache" );
 314
 315         if( !$memcache_servers ) {
 316                 throw OpenSRF::EX::Config ("
 317                                 No Memcache servers specified for open-ils.search!");
 318         }
 319
 320         if(!ref($memcache_servers)) {
 321                 $memcache_servers = [$memcache_servers];
 322         }
 323         $cache_handle = OpenSRF::Utils::Cache->new( "open-ils.search", 0, $memcache_servers );
 324         $max_timeout = $config_client->config_value(
 325                         "apps", "open-ils.search", "app_settings", "max_cache_time" );
 326
 327         if(ref($max_timeout) eq "ARRAY") {
 328                 $max_timeout = $max_timeout->[0];
 329         }
 330
 331 }
 332
 333 sub new {return bless({},shift());}
 334
 335 sub put_cache {
 336         my($self, $key, $data, $timeout) = @_;
 337         return undef unless( $key and $data );
 338
 339         $timeout ||= $max_timeout;
 340         $timeout = ($timeout <= $max_timeout) ? $timeout : $max_timeout;
 341
 342         warn "putting $key into cache for $timeout seconds\n";
 343         $cache_handle->put_cache( "_open-ils.search_$key", JSON->perl2JSON($data), $timeout );
 344 }
 345
 346 sub get_cache {
 347         my( $self, $key ) = @_;
 348         my $json =  $cache_handle->get_cache("_open-ils.search_$key");
 349         if($json) {
 350                 warn "retrieving from cache $key\n  =>>>  $json";
 351         }
 352         return JSON->JSON2perl($json);
 353 }
 354
 355
 356
 357
 358 1;