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         $ro_object_subs->{aou_tree}->(); # force the org tree to load
 109         return $cache{map}{aou}{$org_id};
 110     };
 111
 112     # turns an ISO date into something TT can understand
 113     $ro_object_subs->{parse_datetime} = sub {
 114         my $date = shift;
 115         $date = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($date));
 116         return sprintf(
 117             "%0.2d:%0.2d:%0.2d %0.2d-%0.2d-%0.4d",
 118             $date->hour,
 119             $date->minute,
 120             $date->second,
 121             $date->day,
 122             $date->month,
 123             $date->year
 124         );
 125     };
 126
 127     # retrieve and cache org unit setting values
 128     $ro_object_subs->{get_org_setting} = sub {
 129         my($org_id, $setting) = @_;
 130
 131         $cache{org_settings}{$org_id} = {}
 132             unless $cache{org_settings}{$org_id};
 133
 134         $cache{org_settings}{$org_id}{$setting} =
 135             $U->ou_ancestor_setting_value($org_id, $setting)
 136                 unless exists $cache{org_settings}{$org_id}{$setting};
 137
 138         return $cache{org_settings}{$org_id}{$setting};
 139     };
 140
 141     $ctx->{$_} = $ro_object_subs->{$_} for keys %$ro_object_subs;
 142 }
 143
 144 sub generic_redirect {
 145     my $self = shift;
 146     my $url = shift;
 147     my $cookie = shift; # can be an array of cgi.cookie's
 148
 149     $self->apache->print(
 150         $self->cgi->redirect(
 151             -url => $url ||
 152                 $self->cgi->param('redirect_to') ||
 153                 $self->ctx->{referer} ||
 154                 $self->ctx->{home_page},
 155             -cookie => $cookie
 156         )
 157     );
 158
 159     return Apache2::Const::REDIRECT;
 160 }
 161
 162 sub get_records_and_facets {
 163     my ($self, $rec_ids, $facet_key, $unapi_args) = @_;
 164
 165     $unapi_args ||= {};
 166     $unapi_args->{site} ||= $self->ctx->{aou_tree}->()->shortname;
 167     $unapi_args->{depth} ||= $self->ctx->{aou_tree}->()->ou_type->depth;
 168     $unapi_args->{flesh_depth} ||= 5;
 169
 170     my @data;
 171     my $ses = OpenSRF::MultiSession->new(
 172         app => 'open-ils.cstore',
 173         cap => 10, # XXX config
 174         success_handler => sub {
 175             my($self, $req) = @_;
 176             my $data = $req->{response}->[0]->content;
 177             my $xml = XML::LibXML->new->parse_string($data->{'unapi.bre'})->documentElement;
 178             my $bre_id =  $xml->find('*[@tag="901"]/*[@code="c"]')->[0]->textContent;
 179             push(@data, {id => $bre_id, marc_xml => $xml});
 180         }
 181     );
 182
 183     $ses->request(
 184         'open-ils.cstore.json_query',
 185          {from => [
 186             'unapi.bre', $_, 'marcxml','record',
 187             $unapi_args->{flesh},
 188             $unapi_args->{site},
 189             $unapi_args->{depth},
 190             $unapi_args->{flesh_depth},
 191         ]}
 192     ) for @$rec_ids;
 193
 194     # collect the facet data
 195     my $search = OpenSRF::AppSession->create('open-ils.search');
 196     my $facet_req = $search->request(
 197         'open-ils.search.facet_cache.retrieve', $facet_key, 10
 198     ) if $facet_key;
 199
 200     # gather up the unapi recs
 201     $ses->session_wait(1);
 202
 203     my $facets;
 204     if ($facet_key) {
 205         $facets = $facet_req->gather(1);
 206         $facets->{$_} = {
 207             cmf => $self->ctx->{get_cmf}->($_),
 208             data => $facets->{$_}
 209         } for keys %$facets;    # quick-n-dirty
 210     } else {
 211         $facets = undef;
 212     }
 213
 214     return ($facets, @data);
 215 }
 216
 217 # TODO: blend this code w/ ^-- get_records_and_facets
 218 sub fetch_marc_xml_by_id {
 219     my ($self, $id_list) = @_;
 220     $id_list = [$id_list] unless ref($id_list);
 221
 222     {
 223         no warnings qw/numeric/;
 224         $id_list = [map { int $_ } @$id_list];
 225         $id_list = [grep { $_ > 0} @$id_list];
 226     };
 227
 228     return {} if scalar(@$id_list) < 1;
 229
 230     # I'm just sure there needs to be some more efficient way to get all of
 231     # this.
 232     my $results = $self->editor->json_query({
 233         "select" => {"bre" => ["id", "marc"]},
 234         "from" => {"bre" => {}},
 235         "where" => {"id" => $id_list}
 236     }) or return $self->editor->die_event;
 237
 238     my $marc_xml = {};
 239     for my $r (@$results) {
 240         $marc_xml->{$r->{"id"}} =
 241             (new XML::LibXML)->parse_string($r->{"marc"});
 242     }
 243
 244     return $marc_xml;
 245 }
 246
 247 1;