Open-ILS/src/perlmods/lib/OpenILS/WWW/EGCatLoader/Util.pm

   1 package OpenILS::WWW::EGCatLoader;
   2 use strict; use warnings;
   3 use Apache2::Const -compile => qw(OK DECLINED FORBIDDEN HTTP_INTERNAL_SERVER_ERROR REDIRECT HTTP_BAD_REQUEST);
   4 use OpenSRF::Utils::Logger qw/$logger/;
   5 use OpenILS::Utils::CStoreEditor qw/:funcs/;
   6 use OpenILS::Utils::Fieldmapper;
   7 use OpenILS::Application::AppUtils;
   8 use OpenSRF::MultiSession;
   9 my $U = 'OpenILS::Application::AppUtils';
  10
  11 my $ro_object_subs; # cached subs
  12 our %cache = ( # cached data
  13     map => {aou => {}}, # others added dynamically as needed
  14     list => {},
  15     search => {},
  16     org_settings => {}
  17 );
  18
  19 sub init_ro_object_cache {
  20     my $self = shift;
  21     my $e = $self->editor;
  22     my $ctx = $self->ctx;
  23
  24     if($ro_object_subs) {
  25         # subs have been built.  insert into the context then move along.
  26         $ctx->{$_} = $ro_object_subs->{$_} for keys %$ro_object_subs;
  27         return;
  28     }
  29
  30     # make all "field_safe" classes accesible by default in the template context
  31     my @classes = grep {
  32         ($Fieldmapper::fieldmap->{$_}->{field_safe} || '') =~ /true/i
  33     } keys %{ $Fieldmapper::fieldmap };
  34
  35     for my $class (@classes) {
  36
  37         my $hint = $Fieldmapper::fieldmap->{$class}->{hint};
  38         next if $hint eq 'aou'; # handled separately
  39
  40         my $ident_field =  $Fieldmapper::fieldmap->{$class}->{identity};
  41         (my $eclass = $class) =~ s/Fieldmapper:://o;
  42         $eclass =~ s/::/_/g;
  43
  44         my $list_key = "${hint}_list";
  45         my $get_key = "get_$hint";
  46         my $search_key = "search_$hint";
  47
  48         # Retrieve the full set of objects with class $hint
  49         $ro_object_subs->{$list_key} = sub {
  50             my $method = "retrieve_all_$eclass";
  51             $cache{list}{$hint} = $e->$method() unless $cache{list}{$hint};
  52             return $cache{list}{$hint};
  53         };
  54
  55         # locate object of class $hint with Ident field $id
  56         $cache{map}{$hint} = {};
  57         $ro_object_subs->{$get_key} = sub {
  58             my $id = shift;
  59             return $cache{map}{$hint}{$id} if $cache{map}{$hint}{$id};
  60             ($cache{map}{$hint}{$id}) = grep { $_->$ident_field eq $id } @{$ro_object_subs->{$list_key}->()};
  61             return $cache{map}{$hint}{$id};
  62         };
  63
  64         # search for objects of class $hint where field=value
  65         $cache{search}{$hint} = {};
  66         $ro_object_subs->{$search_key} = sub {
  67             my ($field, $val) = @_;
  68             my $method = "search_$eclass";
  69             $cache{search}{$hint}{$field} = {} unless $cache{search}{$hint}{$field};
  70             $cache{search}{$hint}{$field}{$val} = $e->$method({$field => $val})
  71                 unless $cache{search}{$hint}{$field}{$val};
  72             return $cache{search}{$hint}{$field}{$val};
  73         };
  74     }
  75
  76     $ro_object_subs->{aou_tree} = sub {
  77
  78         # fetch the org unit tree
  79         unless($cache{aou_tree}) {
  80             my $tree = $e->search_actor_org_unit([
  81                             {   parent_ou => undef},
  82                             {   flesh            => -1,
  83                                     flesh_fields    => {aou =>  ['children']},
  84                                     order_by        => {aou => 'name'}
  85                             }
  86                     ])->[0];
  87
  88             # flesh the org unit type for each org unit
  89             # and simultaneously set the id => aou map cache
  90             sub flesh_aout {
  91                 my $node = shift;
  92                 my $ro_object_subs = shift;
  93                 $node->ou_type( $ro_object_subs->{get_aout}->($node->ou_type) );
  94                 $cache{map}{aou}{$node->id} = $node;
  95                 flesh_aout($_, $ro_object_subs) foreach @{$node->children};
  96             };
  97             flesh_aout($tree, $ro_object_subs);
  98
  99             $cache{aou_tree} = $tree;
 100         }
 101
 102         return $cache{aou_tree};
 103     };
 104
 105     # Add a special handler for the tree-shaped org unit cache
 106     $ro_object_subs->{get_aou} = sub {
 107         my $org_id = shift;
 108         return undef unless defined $org_id;
 109         $ro_object_subs->{aou_tree}->(); # force the org tree to load
 110         return $cache{map}{aou}{$org_id};
 111     };
 112
 113     # turns an ISO date into something TT can understand
 114     $ro_object_subs->{parse_datetime} = sub {
 115         my $date = shift;
 116         $date = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($date));
 117         return sprintf(
 118             "%0.2d:%0.2d:%0.2d %0.2d-%0.2d-%0.4d",
 119             $date->hour,
 120             $date->minute,
 121             $date->second,
 122             $date->day,
 123             $date->month,
 124             $date->year
 125         );
 126     };
 127
 128     # retrieve and cache org unit setting values
 129     $ro_object_subs->{get_org_setting} = sub {
 130         my($org_id, $setting) = @_;
 131
 132         $cache{org_settings}{$org_id} = {}
 133             unless $cache{org_settings}{$org_id};
 134
 135         $cache{org_settings}{$org_id}{$setting} =
 136             $U->ou_ancestor_setting_value($org_id, $setting)
 137                 unless exists $cache{org_settings}{$org_id}{$setting};
 138
 139         return $cache{org_settings}{$org_id}{$setting};
 140     };
 141
 142     $ctx->{$_} = $ro_object_subs->{$_} for keys %$ro_object_subs;
 143 }
 144
 145 sub generic_redirect {
 146     my $self = shift;
 147     my $url = shift;
 148     my $cookie = shift; # can be an array of cgi.cookie's
 149
 150     $self->apache->print(
 151         $self->cgi->redirect(
 152             -url => $url ||
 153                 $self->cgi->param('redirect_to') ||
 154                 $self->ctx->{referer} ||
 155                 $self->ctx->{home_page},
 156             -cookie => $cookie
 157         )
 158     );
 159
 160     return Apache2::Const::REDIRECT;
 161 }
 162
 163 sub get_records_and_facets {
 164     my ($self, $rec_ids, $facet_key, $unapi_args) = @_;
 165
 166     $unapi_args ||= {};
 167     $unapi_args->{site} ||= $self->ctx->{aou_tree}->()->shortname;
 168     $unapi_args->{depth} ||= $self->ctx->{aou_tree}->()->ou_type->depth;
 169     $unapi_args->{flesh_depth} ||= 5;
 170
 171     my @data;
 172     my $ses = OpenSRF::MultiSession->new(
 173         app => 'open-ils.cstore',
 174         cap => 10, # XXX config
 175         success_handler => sub {
 176             my($self, $req) = @_;
 177             my $data = $req->{response}->[0]->content;
 178             my $xml = XML::LibXML->new->parse_string($data->{'unapi.bre'})->documentElement;
 179             my $bre_id =  $xml->find('*[@tag="901"]/*[@code="c"]')->[0]->textContent;
 180             push(@data, {id => $bre_id, marc_xml => $xml});
 181         }
 182     );
 183
 184     $ses->request(
 185         'open-ils.cstore.json_query',
 186          {from => [
 187             'unapi.bre', $_, 'marcxml','record',
 188             $unapi_args->{flesh},
 189             $unapi_args->{site},
 190             $unapi_args->{depth},
 191             $unapi_args->{flesh_depth},
 192         ]}
 193     ) for @$rec_ids;
 194
 195     # collect the facet data
 196     my $search = OpenSRF::AppSession->create('open-ils.search');
 197     my $facet_req = $search->request(
 198         'open-ils.search.facet_cache.retrieve', $facet_key, 10
 199     ) if $facet_key;
 200
 201     # gather up the unapi recs
 202     $ses->session_wait(1);
 203
 204     my $facets;
 205     if ($facet_key) {
 206         $facets = $facet_req->gather(1);
 207         $facets->{$_} = {
 208             cmf => $self->ctx->{get_cmf}->($_),
 209             data => $facets->{$_}
 210         } for keys %$facets;    # quick-n-dirty
 211     } else {
 212         $facets = undef;
 213     }
 214
 215     $search->kill_me;
 216
 217     return ($facets, @data);
 218 }
 219
 220 # TODO: blend this code w/ ^-- get_records_and_facets
 221 sub fetch_marc_xml_by_id {
 222     my ($self, $id_list) = @_;
 223     $id_list = [$id_list] unless ref($id_list);
 224
 225     {
 226         no warnings qw/numeric/;
 227         $id_list = [map { int $_ } @$id_list];
 228         $id_list = [grep { $_ > 0} @$id_list];
 229     };
 230
 231     return {} if scalar(@$id_list) < 1;
 232
 233     # I'm just sure there needs to be some more efficient way to get all of
 234     # this.
 235     my $results = $self->editor->json_query({
 236         "select" => {"bre" => ["id", "marc"]},
 237         "from" => {"bre" => {}},
 238         "where" => {"id" => $id_list}
 239     }, {substream => 1}) or return $self->editor->die_event;
 240
 241     my $marc_xml = {};
 242     for my $r (@$results) {
 243         $marc_xml->{$r->{"id"}} =
 244             (new XML::LibXML)->parse_string($r->{"marc"});
 245     }
 246
 247     return $marc_xml;
 248 }
 249
 250 1;