Open-ILS/src/perlmods/OpenILS/Application/Circ/ScriptBuilder.pm

   1 package OpenILS::Application::Circ::ScriptBuilder;
   2 use strict; use warnings;
   3 use OpenILS::Utils::ScriptRunner;
   4 use OpenILS::Utils::CStoreEditor qw/:funcs/;
   5 use OpenILS::Application::AppUtils;
   6 use OpenILS::Application::Actor;
   7 use OpenSRF::Utils::Logger qw/$logger/;
   8 my $U = "OpenILS::Application::AppUtils";
   9 use Data::Dumper;
  10
  11 my $evt = "environment";
  12 my @COPY_STATUSES;
  13 my @COPY_LOCATIONS;
  14 my %GROUP_SET;
  15 my $GROUP_TREE;
  16 my $ORG_TREE;
  17 my @ORG_LIST;
  18
  19
  20 # -----------------------------------------------------------------------
  21 # Possible Args:
  22 #  copy
  23 #  copy_id
  24 #  copy_barcode
  25 #
  26 #  patron
  27 #  patron_id
  28 #  patron_barcode
  29 #
  30 #  fetch_patron_circ_info - load info on items out, overdues, and fines.
  31 #
  32 #  _direct - this is a hash of key/value pairs to shove directly into the
  33 #  script runner.  Use this to cover data not covered by this module
  34 # -----------------------------------------------------------------------
  35 sub build {
  36         my( $class, $args ) = @_;
  37
  38         my $evt;
  39         my @evts;
  40
  41         my $editor = $$args{editor} || new_editor();
  42
  43         $args->{_direct} = {} unless $args->{_direct};
  44
  45         $evt = fetch_bib_data($editor, $args);
  46         push(@evts, $evt) if $evt;
  47         $evt = fetch_user_data($editor, $args);
  48         push(@evts, $evt) if $evt;
  49         $args->{_event} = \@evts;
  50         return build_runner($editor, $args);
  51 }
  52
  53
  54 sub build_runner {
  55         my $editor      = shift;
  56         my $ctx         = shift;
  57
  58         my $runner = OpenILS::Utils::ScriptRunner->new;
  59
  60         $runner->insert( "$evt.groupTree",      $GROUP_TREE, 1);
  61
  62         $runner->insert( "$evt.patron",         $ctx->{patron}, 1);
  63         $runner->insert( "$evt.copy",                   $ctx->{copy}, 1);
  64         $runner->insert( "$evt.volume",         $ctx->{volume}, 1);
  65         $runner->insert( "$evt.title",          $ctx->{title}, 1);
  66         $runner->insert( "$evt.requestor",      $ctx->{requestor}, 1);
  67         $runner->insert( "$evt.titleDescriptor", $ctx->{titleDescriptor}, 1);
  68
  69         $runner->insert( "$evt.patronItemsOut", $ctx->{patronItemsOut}, 1 );
  70         $runner->insert( "$evt.patronOverdueCount", $ctx->{patronOverdue}, 1 );
  71         $runner->insert( "$evt.patronFines", $ctx->{patronFines}, 1 );
  72
  73         $runner->insert("$evt.$_", $ctx->{_direct}->{$_}) for keys %{$ctx->{_direct}};
  74
  75         $ctx->{runner} = $runner;
  76
  77         insert_org_methods( $editor, $ctx );
  78
  79         return $runner;
  80 }
  81
  82 sub fetch_bib_data {
  83         my $e = shift;
  84         my $ctx = shift;
  85
  86         if(!$ctx->{copy}) {
  87
  88                 if($ctx->{copy_id}) {
  89                         $ctx->{copy} = $e->retrieve_asset_copy($ctx->{copy_id})
  90                                 or return $e->event;
  91
  92                 } elsif( $ctx->{copy_barcode} ) {
  93
  94                         $ctx->{copy} = $e->search_asset_copy(
  95                                 {barcode => $ctx->{copy_barcode}}) or return $e->event;
  96                         $ctx->{copy} = $ctx->{copy}->[0];
  97                 }
  98         }
  99
 100         return undef unless my $copy = $ctx->{copy};
 101
 102         # --------------------------------------------------------------------
 103         # Fetch/Cache the copy status and location objects
 104         # --------------------------------------------------------------------
 105         if(!@COPY_STATUSES) {
 106                 my $s = $e->retrieve_all_config_copy_status();
 107                 @COPY_STATUSES = @$s;
 108                 $s = $e->retrieve_all_asset_copy_location();
 109                 @COPY_LOCATIONS = @$s;
 110         }
 111
 112         # Flesh the status and location
 113         $copy->status(
 114                 grep { $_->id == $copy->status } @COPY_STATUSES )
 115                 unless ref $copy->status;
 116
 117         $copy->location(
 118                 grep { $_->id == $copy->location } @COPY_LOCATIONS )
 119                 unless ref $copy->location;
 120
 121         $copy->circ_lib(
 122                 $e->retrieve_actor_org_unit($copy->circ_lib))
 123                 unless ref $copy->circ_lib;
 124
 125         $ctx->{volume} = $e->retrieve_asset_call_number(
 126                 $ctx->{copy}->call_number) or return $e->event;
 127
 128         $ctx->{title} = $e->retrieve_biblio_record_entry(
 129                 $ctx->{volume}->record) or return $e->event;
 130
 131         if(!$ctx->{titleDescriptor}) {
 132                 $ctx->{titleDescriptor} = $e->search_metabib_record_descriptor(
 133                         { record => $ctx->{title}->id }) or return $e->event;
 134
 135                 $ctx->{titleDescriptor} = $ctx->{titleDescriptor}->[0];
 136         }
 137
 138         return undef;
 139 }
 140
 141
 142
 143 sub fetch_user_data {
 144         my( $e, $ctx ) = @_;
 145
 146         if(!$ctx->{patron}) {
 147
 148                 if( $ctx->{patron_id} ) {
 149                         $ctx->{patron} = $e->retrieve_actor_user($ctx->{patron_id});
 150
 151                 } elsif( $ctx->{patron_barcode} ) {
 152
 153                         my $card = $e->search_actor_card(
 154                                 { barcode => $ctx->{patron_barcode} } ) or return $e->event;
 155
 156                         $ctx->{patron} = $e->search_actor_user(
 157                                 { card => $card->[0]->id }) or return $e->event;
 158                         $ctx->{patron} = $ctx->{patron}->[0];
 159                 }
 160         }
 161
 162         return undef unless my $patron = $ctx->{patron};
 163
 164         $patron->home_ou(
 165                 $e->retrieve_actor_org_unit($patron->home_ou) )
 166                 unless ref $patron->home_ou;
 167
 168
 169         if(!%GROUP_SET) {
 170                 $GROUP_TREE = $e->search_permission_grp_tree(
 171                         [
 172                                 { parent => undef },
 173                                 {
 174                                         flesh => 100,
 175                                         flesh_fields => { pgt => ['children'] }
 176                                 }
 177                         ]
 178                 )->[0];
 179
 180                 flatten_groups($GROUP_TREE);
 181         }
 182
 183         $patron->profile( $GROUP_SET{$patron->profile} )
 184                 unless ref $patron->profile;
 185
 186         $patron->card($e->retrieve_actor_card($patron->card));
 187
 188         $ctx->{requestor} = $ctx->{requestor} || $e->requestor;
 189
 190         # this could alter the requestor object within the editor..
 191         #if( my $req = $ctx->{requestor} ) {
 192         #       $req->home_ou( $e->retrieve_actor_org_unit($requestor->home_ou) );
 193         #       $req->ws_ou( $e->retrieve_actor_org_unit($requestor->ws_ou) );
 194         #}
 195
 196         if( $ctx->{fetch_patron_circ_info} ) {
 197
 198                 my $circ_counts =
 199                         OpenILS::Application::Actor::_checked_out(1, $e, $patron->id);
 200
 201                 $ctx->{patronOverdue} = $circ_counts->{overdue} || 0;
 202                 $ctx->{patronItemsOut} = $ctx->{patronOverdue} + $circ_counts->{out};
 203
 204                 # Grab the fines
 205                 my $fxacts = $e->search_money_open_billable_transaction_summary(
 206                         { usr => $patron->id, balance_owed => { ">" => 0 } });
 207
 208                 my $fines = 0;
 209                 $fines += $_->balance_owed for @$fxacts;
 210                 $ctx->{patronFines} = $fines;
 211
 212                 $logger->debug("script_builder: patron fines determined to be $fines");
 213                 $logger->debug("script_builder: patron overdue count is " . $ctx->{patronOverdue});
 214         }
 215
 216         return undef;
 217 }
 218
 219
 220 sub flatten_groups {
 221         my $tree = shift;
 222         return undef unless $tree;
 223         $GROUP_SET{$tree->id} = $tree;
 224         if( $tree->children ) {
 225                 flatten_groups($_) for @{$tree->children};
 226         }
 227 }
 228
 229 sub flatten_org_tree {
 230         my $tree = shift;
 231         return undef unless $tree;
 232         push( @ORG_LIST, $tree );
 233         if( $tree->children ) {
 234                 flatten_org_tree($_) for @{$tree->children};
 235         }
 236 }
 237
 238
 239
 240 sub insert_org_methods {
 241         my ( $editor, $ctx ) = @_;
 242         my $runner = $ctx->{runner};
 243
 244
 245         if(!$ORG_TREE) {
 246                 $ORG_TREE = $editor->search_actor_org_unit(
 247                         [
 248                                 {"parent_ou" => undef },
 249                                 {
 250                                         flesh                           => 2,
 251                                         flesh_fields    => { aou =>  ['children'] },
 252                                         order_by                        => { aou => 'name'}
 253                                 }
 254                         ]
 255                 )->[0];
 256                 flatten_org_tree($ORG_TREE);
 257         }
 258
 259         $runner->insert("$evt.__OILS_FUNC_isOrgDescendent",
 260                 sub {
 261                         my( $sname, $id ) = @_;
 262                         my ($parent)    = grep { $_->shortname eq $sname } @ORG_LIST;
 263                         my ($child)             = grep { $_->id == $id } @ORG_LIST;
 264                         return is_org_descendent( $parent, $child );
 265                 }
 266         );
 267 }
 268
 269
 270 sub is_org_descendent {
 271         my( $parent, $child ) = @_;
 272         return 0 unless $parent and $child;
 273         do {
 274                 return 1 if $parent->id == $child->id;
 275         } while( ($child) = grep { $_->id == $child->parent_ou } @ORG_LIST );
 276         return 0;
 277 }
 278
 279 1;
 280
 281