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 our %cache = (
  11     map => {aou => {}}, # others added dynamically as needed
  12     list => {},
  13     org_settings => {}
  14 );
  15
  16 sub init_ro_object_cache {
  17     my $self = shift;
  18     my $e = $self->editor;
  19     my $ctx = $self->ctx;
  20
  21     # fetch-on-demand-and-cache subs for commonly used public data
  22     my @public_classes = qw/ccs aout cifm citm clm cmf crahp/;
  23
  24     for my $hint (@public_classes) {
  25
  26         my ($class) = grep {
  27             $Fieldmapper::fieldmap->{$_}->{hint} eq $hint
  28         } keys %{ $Fieldmapper::fieldmap };
  29
  30         my $ident_field =  $Fieldmapper::fieldmap->{$class}->{identity};
  31
  32             $class =~ s/Fieldmapper:://o;
  33             $class =~ s/::/_/g;
  34
  35         # copy statuses
  36         my $list_key = $hint . '_list';
  37         my $find_key = "find_$hint";
  38
  39         $ctx->{$list_key} = sub {
  40             my $method = "retrieve_all_$class";
  41             $cache{list}{$hint} = $e->$method() unless $cache{list}{$hint};
  42             return $cache{list}{$hint};
  43         };
  44
  45         $cache{map}{$hint} = {} unless $cache{map}{$hint};
  46
  47         $ctx->{$find_key} = sub {
  48             my $id = shift;
  49             return $cache{map}{$hint}{$id} if $cache{map}{$hint}{$id};
  50             ($cache{map}{$hint}{$id}) = grep { $_->$ident_field eq $id } @{$ctx->{$list_key}->()};
  51             return $cache{map}{$hint}{$id};
  52         };
  53
  54     }
  55
  56     $ctx->{aou_tree} = sub {
  57
  58         # fetch the org unit tree
  59         unless($cache{aou_tree}) {
  60             my $tree = $e->search_actor_org_unit([
  61                             {   parent_ou => undef},
  62                             {   flesh            => -1,
  63                                     flesh_fields    => {aou =>  ['children']},
  64                                     order_by        => {aou => 'name'}
  65                             }
  66                     ])->[0];
  67
  68             # flesh the org unit type for each org unit
  69             # and simultaneously set the id => aou map cache
  70             sub flesh_aout {
  71                 my $node = shift;
  72                 my $ctx = shift;
  73                 $node->ou_type( $ctx->{find_aout}->($node->ou_type) );
  74                 $cache{map}{aou}{$node->id} = $node;
  75                 flesh_aout($_, $ctx) foreach @{$node->children};
  76             };
  77             flesh_aout($tree, $ctx);
  78
  79             $cache{aou_tree} = $tree;
  80         }
  81
  82         return $cache{aou_tree};
  83     };
  84
  85     # Add a special handler for the tree-shaped org unit cache
  86     $ctx->{find_aou} = sub {
  87         my $org_id = shift;
  88         $ctx->{aou_tree}->(); # force the org tree to load
  89         return $cache{map}{aou}{$org_id};
  90     };
  91
  92     # turns an ISO date into something TT can understand
  93     $ctx->{parse_datetime} = sub {
  94         my $date = shift;
  95         $date = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($date));
  96         return sprintf(
  97             "%0.2d:%0.2d:%0.2d %0.2d-%0.2d-%0.4d",
  98             $date->hour,
  99             $date->minute,
 100             $date->second,
 101             $date->day,
 102             $date->month,
 103             $date->year
 104         );
 105     };
 106
 107     # retrieve and cache org unit setting values
 108     $ctx->{get_org_setting} = sub {
 109         my($org_id, $setting) = @_;
 110
 111         $cache{org_settings}{$org_id} = {}
 112             unless $cache{org_settings}{$org_id};
 113
 114         $cache{org_settings}{$org_id}{$setting} =
 115             $U->ou_ancestor_setting_value($org_id, $setting)
 116                 unless exists $cache{org_settings}{$org_id}{$setting};
 117
 118         return $cache{org_settings}{$org_id}{$setting};
 119     };
 120 }
 121
 122 1;