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 my $U = 'OpenILS::Application::AppUtils';
   9
  10 my $ro_object_subs; # cached subs
  11 our %cache = ( # cached data
  12     map => {aou => {}}, # others added dynamically as needed
  13     list => {},
  14     org_settings => {}
  15 );
  16
  17 sub init_ro_object_cache {
  18     my $self = shift;
  19     my $e = $self->editor;
  20     my $ctx = $self->ctx;
  21
  22     if($ro_object_subs) {
  23         # subs have been built.  insert into the context then move along.
  24         $ctx->{$_} = $ro_object_subs->{$_} for keys %$ro_object_subs;
  25         return;
  26     }
  27
  28     # make all "field_safe" classes accesible by default in the template context
  29     my @classes = grep {
  30         ($Fieldmapper::fieldmap->{$_}->{field_safe} || '') =~ /true/i
  31     } keys %{ $Fieldmapper::fieldmap };
  32
  33     for my $class (@classes) {
  34
  35         my $hint = $Fieldmapper::fieldmap->{$class}->{hint};
  36         next if $hint eq 'aou'; # handled separately
  37
  38         my $ident_field =  $Fieldmapper::fieldmap->{$class}->{identity};
  39         (my $eclass = $class) =~ s/Fieldmapper:://o;
  40         $eclass =~ s/::/_/g;
  41
  42         my $list_key = "${hint}_list";
  43         my $find_key = "find_$hint";
  44
  45         $ro_object_subs->{$list_key} = sub {
  46             my $method = "retrieve_all_$eclass";
  47             $cache{list}{$hint} = $e->$method() unless $cache{list}{$hint};
  48             return $cache{list}{$hint};
  49         };
  50
  51         $cache{map}{$hint} = {} unless $cache{map}{$hint};
  52
  53         $ro_object_subs->{$find_key} = sub {
  54             my $id = shift;
  55             return $cache{map}{$hint}{$id} if $cache{map}{$hint}{$id};
  56             ($cache{map}{$hint}{$id}) = grep { $_->$ident_field eq $id } @{$ro_object_subs->{$list_key}->()};
  57             return $cache{map}{$hint}{$id};
  58         };
  59     }
  60
  61     $ro_object_subs->{aou_tree} = sub {
  62
  63         # fetch the org unit tree
  64         unless($cache{aou_tree}) {
  65             my $tree = $e->search_actor_org_unit([
  66                             {   parent_ou => undef},
  67                             {   flesh            => -1,
  68                                     flesh_fields    => {aou =>  ['children']},
  69                                     order_by        => {aou => 'name'}
  70                             }
  71                     ])->[0];
  72
  73             # flesh the org unit type for each org unit
  74             # and simultaneously set the id => aou map cache
  75             sub flesh_aout {
  76                 my $node = shift;
  77                 my $ro_object_subs = shift;
  78                 $node->ou_type( $ro_object_subs->{find_aout}->($node->ou_type) );
  79                 $cache{map}{aou}{$node->id} = $node;
  80                 flesh_aout($_, $ro_object_subs) foreach @{$node->children};
  81             };
  82             flesh_aout($tree, $ro_object_subs);
  83
  84             $cache{aou_tree} = $tree;
  85         }
  86
  87         return $cache{aou_tree};
  88     };
  89
  90     # Add a special handler for the tree-shaped org unit cache
  91     $ro_object_subs->{find_aou} = sub {
  92         my $org_id = shift;
  93         $ro_object_subs->{aou_tree}->(); # force the org tree to load
  94         return $cache{map}{aou}{$org_id};
  95     };
  96
  97     # turns an ISO date into something TT can understand
  98     $ro_object_subs->{parse_datetime} = sub {
  99         my $date = shift;
 100         $date = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($date));
 101         return sprintf(
 102             "%0.2d:%0.2d:%0.2d %0.2d-%0.2d-%0.4d",
 103             $date->hour,
 104             $date->minute,
 105             $date->second,
 106             $date->day,
 107             $date->month,
 108             $date->year
 109         );
 110     };
 111
 112     # retrieve and cache org unit setting values
 113     $ro_object_subs->{get_org_setting} = sub {
 114         my($org_id, $setting) = @_;
 115
 116         $cache{org_settings}{$org_id} = {}
 117             unless $cache{org_settings}{$org_id};
 118
 119         $cache{org_settings}{$org_id}{$setting} =
 120             $U->ou_ancestor_setting_value($org_id, $setting)
 121                 unless exists $cache{org_settings}{$org_id}{$setting};
 122
 123         return $cache{org_settings}{$org_id}{$setting};
 124     };
 125
 126     $ctx->{$_} = $ro_object_subs->{$_} for keys %$ro_object_subs;
 127 }
 128
 129 sub generic_redirect {
 130     my $self = shift;
 131     my $url = shift;
 132     my $cookie = shift; # can be an array of cgi.cookie's
 133
 134     $self->apache->print(
 135         $self->cgi->redirect(
 136             -url => $url ||
 137                 $self->cgi->param('redirect_to') ||
 138                 $self->ctx->{referer} ||
 139                 $self->ctx->{home_page},
 140             -cookie => $cookie
 141         )
 142     );
 143
 144     return Apache2::Const::REDIRECT;
 145 }
 146
 147 sub get_records_and_facets {
 148     my ($self, $rec_ids, $facet_key) = @_;
 149
 150     my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
 151     my $bre_req = $cstore->request(
 152         'open-ils.cstore.direct.biblio.record_entry.search', {id => $rec_ids}
 153     );
 154
 155     my $search = OpenSRF::AppSession->create('open-ils.search');
 156     my $facet_req = $search->request(
 157         'open-ils.search.facet_cache.retrieve', $facet_key, 10
 158     ) if $facet_key;
 159
 160     my @data;
 161     while (my $resp = $bre_req->recv) {
 162         my $bre = $resp->content;
 163
 164         # XXX farm out to multiple cstore sessions before loop,
 165         # then collect after
 166         my $copy_counts = $self->editor->json_query(
 167             {from => ['asset.record_copy_count', 1, $bre->id, 0]}
 168         )->[0];
 169
 170         push @data, {
 171             bre => $bre,
 172             marc_xml => XML::LibXML->new->parse_string($bre->marc),
 173             copy_counts => $copy_counts
 174         };
 175     }
 176
 177     $cstore->kill_me;
 178
 179     my $facets;
 180     if ($facet_key) {
 181         $facets = $facet_req->gather(1);
 182
 183         $facets->{$_} = {
 184             cmf => $self->ctx->{find_cmf}->($_),
 185             data => $facets->{$_}
 186         } for keys %$facets;    # quick-n-dirty
 187     } else {
 188         $facets = undef;
 189     }
 190
 191     return ($facets, @data);
 192 }
 193
 194 sub fetch_marc_xml_by_id {
 195     my ($self, $id_list) = @_;
 196     $id_list = [$id_list] unless ref($id_list);
 197
 198     {
 199         no warnings qw/numeric/;
 200         $id_list = [map { int $_ } @$id_list];
 201         $id_list = [grep { $_ > 0} @$id_list];
 202     };
 203
 204     return {} if scalar(@$id_list) < 1;
 205
 206     # I'm just sure there needs to be some more efficient way to get all of
 207     # this.
 208     my $results = $self->editor->json_query({
 209         "select" => {"bre" => ["id", "marc"]},
 210         "from" => {"bre" => {}},
 211         "where" => {"id" => $id_list}
 212     }) or return $self->editor->die_event;
 213
 214     my $marc_xml = {};
 215     for my $r (@$results) {
 216         $marc_xml->{$r->{"id"}} =
 217             (new XML::LibXML)->parse_string($r->{"marc"});
 218     }
 219
 220     return $marc_xml;
 221 }
 222
 223 1;