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

   1 package OpenILS::Application::Search::Authority;
   2 use base qw/OpenSRF::Application/;
   3 use strict; use warnings;
   4
   5 use OpenILS::EX;
   6
   7 use OpenILS::Utils::Fieldmapper;
   8 use OpenILS::Application::AppUtils;
   9
  10 use JSON;
  11
  12 use Time::HiRes qw(time);
  13 use OpenSRF::EX qw(:try);
  14 use Digest::MD5 qw(md5_hex);
  15
  16 sub crossref_authority {
  17         my $self = shift;
  18         my $client = shift;
  19         my $class = shift;
  20         my $term = shift;
  21
  22         my $session = OpenSRF::AppSession->create("open-ils.storage");
  23         $session->connect;
  24
  25         my $freq = $session->request("open-ils.storage.authority.$class.see_from.controlled.atomic",$term);
  26         my $areq = $session->request("open-ils.storage.authority.$class.see_also_from.controlled.atomic",$term);
  27
  28         my $fr = $freq->gather(1);
  29         my $al = $areq->gather(1);
  30         $session->disconnect;
  31
  32         return _auth_flatten( $term, $fr, $al );
  33 }
  34
  35 sub _auth_flatten {
  36         my $term = shift;
  37         my $fr = shift;
  38         my $al = shift;
  39
  40         my %hash = ();
  41         for my $x (@$fr) {
  42                 my $string = $$x[0];
  43                 for my $i (1..10) {
  44                         last unless ($$x[$i]);
  45                         if ($string =~ /\W$/o) {
  46                                 $string .= ' '.$$x[$i];
  47                         } else {
  48                                 $string .= ' -- '.$$x[$i];
  49                         }
  50                 }
  51                 next if (lc($string) eq lc($term));
  52                 $hash{$string}++;
  53                 $hash{$string}++ if (lc($$x[0]) eq lc($term));
  54         }
  55         my $from = [ sort { $hash{$b} <=> $hash{$a} || $a cmp $b } keys %hash ];
  56
  57         %hash = ();
  58         for my $x (@$al) {
  59                 my $string = $$x[0];
  60                 for my $i (1..10) {
  61                         last unless ($$x[$i]);
  62                         if ($string =~ /\W$/o) {
  63                                 $string .= ' '.$$x[$i];
  64                         } else {
  65                                 $string .= ' -- '.$$x[$i];
  66                         }
  67                 }
  68                 next if (lc($string) eq lc($term));
  69                 $hash{$string}++;
  70                 $hash{$string}++ if (lc($$x[0]) eq lc($term));
  71         }
  72         my $also = [ sort { $hash{$b} <=> $hash{$a} || $a cmp $b } keys %hash ];
  73
  74
  75         return { from => $from, also => $also };
  76 }
  77
  78 __PACKAGE__->register_method(
  79         method          => "crossref_authority",
  80         api_name        => "open-ils.search.authority.crossref",
  81         argc            => 2,
  82         note            => "Searches authority data for existing controlled terms and crossrefs",
  83 );
  84
  85 __PACKAGE__->register_method(
  86         method          => "crossref_authority_batch",
  87    api_name     => "open-ils.search.authority.crossref.batch",
  88    argc         => 1,
  89    note         => <<"  NOTE");
  90         Takes an array of class,term pair sub-arrays and performs an authority lookup for each
  91
  92         PARAMS( [ ["subject", "earth"], ["author","shakespeare"] ] );
  93
  94         Returns an object like so:
  95         {
  96                 "classname" : {
  97                         "term" : { "from" : [ ...], "also" : [...] }
  98                         "term2" : { "from" : [ ...], "also" : [...] }
  99                 }
 100         }
 101         NOTE
 102
 103 =head comment should work...
 104 sub crossref_authority_batch {
 105         my( $self, $client, $reqs ) = @_;
 106
 107         my $appreqs = {};
 108         for my $req (@$reqs) {
 109
 110                 my $class = $req->[0];
 111                 my $term = $req->[1];
 112                 next unless $class and $term;
 113                 $appreqs->{$class} = {} unless exists $appreqs->{$class};
 114                 $appreqs->{$class}->{$term} = [];
 115
 116                 warn "Sending auth request for $class : $term\n";
 117                 my $session = OpenSRF::AppSession->create("open-ils.storage");
 118                 my $freq = $session->request("open-ils.storage.authority.$class.see_from.controlled.atomic",$term);
 119                 my $areq = $session->request("open-ils.storage.authority.$class.see_also_from.controlled.atomic",$term);
 120                 $appreqs->{$class}->{$term}->[0] = $freq;
 121                 $appreqs->{$class}->{$term}->[1] = $areq;
 122         }
 123
 124         my $response = {};
 125         for my $class (keys %$appreqs) {
 126                 $response->{$class} = {} unless exists $response->{$class};
 127                 for my $term (keys %{$appreqs->{$class}}) {
 128                         warn "Receiving auth request for $class : $term\n";
 129                         my $fr = $appreqs->{$class}->{$term}->[0]->gather(1);
 130                         my $al = $appreqs->{$class}->{$term}->[1]->gather(1);
 131                         warn "Flattenting..\n";
 132                         $response->{$class}->{$term} = _auth_flatten( $term, $fr, $al );
 133                         warn "Done with $term\n";
 134                 }
 135                 warn "Done with $class\n";
 136         }
 137
 138         use Data::Dumper;
 139         warn "Returning responses: " . Dumper($response) . "\n";
 140
 141         return $response;
 142 }
 143
 144 =cut
 145
 146 sub crossref_authority_batch {
 147         my( $self, $client, $reqs ) = @_;
 148
 149         my $response = {};
 150         my $lastr = [];
 151         my $session = OpenSRF::AppSession->create("open-ils.storage");
 152
 153         for my $req (@$reqs) {
 154
 155                 my $class = $req->[0];
 156                 my $term = $req->[1];
 157                 next unless $class and $term;
 158                 warn "Sending authority request for $class : $term\n";
 159                 my $freq = $session->request("open-ils.storage.authority.$class.see_from.controlled.atomic",$term);
 160                 my $areq = $session->request("open-ils.storage.authority.$class.see_also_from.controlled.atomic",$term);
 161
 162                 if( $lastr->[0] ) { #process old data while waiting on new data
 163                         my $cls = $lastr->[0];
 164                         my $trm = $lastr->[1];
 165                         my $fr  = $lastr->[2];
 166                         my $al  = $lastr->[3];
 167                         warn "Flattening $class : $term\n";
 168                         $response->{$cls} = {} unless exists $response->{$cls};
 169                         $response->{$cls}->{$trm} = _auth_flatten( $trm, $fr, $al );
 170                 }
 171
 172                 $lastr->[0] = $class;
 173                 $lastr->[1] = $term;
 174                 $lastr->[2] = $freq->gather(1);
 175                 $lastr->[3] = $areq->gather(1);
 176         }
 177
 178         if( $lastr->[0] ) { #process old data while waiting on new data
 179                 my $cls = $lastr->[0];
 180                 my $trm = $lastr->[1];
 181                 my $fr  = $lastr->[2];
 182                 my $al  = $lastr->[3];
 183                 warn "Flattening $cls : $trm\n";
 184                 $response->{$cls} = {} unless exists $response->{$cls};
 185                 $response->{$cls}->{$trm} = _auth_flatten( $trm, $fr, $al );
 186         }
 187
 188         return $response;
 189 }
 190
 191
 192 1;