Merge branch 'master' of git.evergreen-ils.org:Evergreen into template-toolkit-opac
[working/Evergreen.git] / Open-ILS / src / perlmods / lib / 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 OpenSRF::Utils::Logger qw/$logger/;
7 use OpenILS::Application::Circ::Holds;
8 use DateTime::Format::ISO8601;
9 use OpenSRF::Utils qw/:datetime/;
10 use Scalar::Util qw/weaken/;
11 my $U = "OpenILS::Application::AppUtils";
12 use Data::Dumper;
13
14 my $holdcode = "OpenILS::Application::Circ::Holds";
15
16 my $evt = "environment";
17 my %GROUP_SET;
18 my $GROUP_TREE;
19 my $ORG_TREE;
20 my @ORG_LIST;
21 my @OU_TYPES;
22
23
24 # -----------------------------------------------------------------------
25 # Possible Args:
26 #  copy
27 #  copy_id
28 #  copy_barcode
29 #
30 #  patron
31 #  patron_id
32 #  patron_barcode
33 #
34 #  fetch_patron_circ_info - load info on items out, overdues, and fines.
35 #
36 #  _direct - this is a hash of key/value pairs to shove directly into the 
37 #  script runner.  Use this to cover data not covered by this module
38 # -----------------------------------------------------------------------
39 sub build {
40         my( $class, $args ) = @_;
41
42         my $evt;
43         my @evts;
44
45         my $rollback;
46         my $editor = $$args{editor};
47
48         unless($editor) {
49                 $editor = new_editor(xact => 1);
50                 $rollback = 1;
51         }
52
53         $args->{_direct} = {} unless $args->{_direct};
54         #$args->{editor} = $editor;
55         
56         $evt = fetch_bib_data($editor, $args);
57         push(@evts, $evt) if $evt;
58         $evt = fetch_user_data($editor, $args);
59         push(@evts, $evt) if $evt;
60
61         if(@evts) {
62                 my @e;
63                 push( @e, $_->{textcode} ) for @evts;
64                 $logger->info("script_builder: some events occurred: @e");
65                 $logger->debug("script_builder: some events occurred: " . Dumper(\@evts));
66                 $args->{_events} = \@evts;
67         }
68
69         my $r = build_runner($editor, $args);
70         $editor->rollback if $rollback;
71         return $r;
72 }
73
74
75 sub build_runner {
76         my $editor      = shift;
77         my $ctx         = shift;
78
79         my $runner = OpenILS::Utils::ScriptRunner->new;
80
81         my $gt = $GROUP_TREE;
82         $runner->insert( "$evt.groupTree",      $gt, 1);
83
84
85         $runner->insert( "$evt.patron",         $ctx->{patron}, 1);
86         $runner->insert( "$evt.copy",                   $ctx->{copy}, 1);
87         $runner->insert( "$evt.volume",         $ctx->{volume}, 1);
88         $runner->insert( "$evt.title",          $ctx->{title}, 1);
89
90         if( ref $ctx->{requestor} ) {
91                 $runner->insert( "$evt.requestor",      $ctx->{requestor}, 1);
92                 if($ctx->{requestor}->ws_ou) {
93                         $runner->insert( "$evt.location",       
94                                 $editor->retrieve_actor_org_unit($ctx->{requestor}->ws_ou), 1);
95                 }
96         }
97
98         $runner->insert( "$evt.patronItemsOut", $ctx->{patronItemsOut}, 1 );
99         $runner->insert( "$evt.patronOverdueCount", $ctx->{patronOverdue}, 1 );
100         $runner->insert( "$evt.patronFines", $ctx->{patronFines}, 1 );
101
102         $runner->insert("$evt.$_", $ctx->{_direct}->{$_}, 1) for keys %{$ctx->{_direct}};
103
104         insert_org_methods( $editor, $runner );
105         insert_copy_methods( $editor, $ctx, $runner );
106    insert_user_funcs( $editor, $ctx, $runner );
107
108         return $runner;
109 }
110
111 sub fetch_bib_data {
112         my $e = shift;
113         my $ctx = shift;
114
115         my $flesh = { 
116                 flesh => 2, 
117                 flesh_fields => { 
118                         acp => [ 'location', 'status', 'circ_lib', 'age_protect', 'call_number' ],
119                         acn => [ 'record' ]
120                 } 
121         };
122
123         if( $ctx->{copy} ) {
124                 $ctx->{copy_id} = $ctx->{copy}->id 
125                         unless $ctx->{copy_id} or $ctx->{copy_barcode};
126         }
127
128         my $copy;
129
130         if($ctx->{copy_id}) {
131                 $copy = $e->retrieve_asset_copy(
132                         [$ctx->{copy_id}, $flesh ]) or return $e->event;
133
134         } elsif( $ctx->{copy_barcode} ) {
135
136                 $copy = $e->search_asset_copy(
137                         [{barcode => $ctx->{copy_barcode}, deleted => 'f'}, $flesh ])->[0]
138                         or return $e->event;
139         }
140
141         return undef unless $copy;
142
143         my $vol = $copy->call_number;
144         my $rec = $vol->record;
145         $ctx->{copy} = $copy;
146         $ctx->{volume} = $vol;
147         $copy->call_number($vol->id);
148         $ctx->{title} = $rec;
149         $vol->record($rec->id);
150
151         return undef;
152 }
153
154
155
156 sub fetch_user_data {
157         my( $e, $ctx ) = @_;
158
159         my $flesh = {
160                 flesh => 2,
161                 flesh_fields => {
162                         au => [ qw/ profile home_ou card / ],
163                         aou => [ 'ou_type' ],
164                 }
165         };
166
167         if( $ctx->{patron} ) {
168                 $ctx->{patron_id} = $ctx->{patron}->id unless $ctx->{patron_id};
169         }
170
171         my $patron;
172         
173         if( $ctx->{patron_id} ) {
174                 $patron = $e->retrieve_actor_user([$ctx->{patron_id}, $flesh]);
175
176         } elsif( $ctx->{patron_barcode} ) {
177
178                 my $card = $e->search_actor_card( 
179                         { barcode => $ctx->{patron_barcode} } )->[0] or return $e->event;
180
181                 $patron = $e->search_actor_user( 
182                         [{ card => $card->id }, $flesh ]
183                         )->[0] or return $e->event;
184
185         } elsif( $ctx->{fetch_patron_by_circ_copy} ) {
186
187                 if( my $copy = $ctx->{copy} ) {
188                         my $circs = $e->search_action_circulation(
189                                 { target_copy => $copy->id, checkin_time => undef });
190
191                         if( my $circ = $circs->[0] ) {
192                                 $patron = $e->retrieve_actor_user([$circ->usr, $flesh])
193                                         or return $e->event;
194                         }
195                 }
196         }
197
198         return undef unless $ctx->{patron} = $patron;
199
200         flatten_groups($e);
201
202         $ctx->{requestor} = $ctx->{requestor} || $e->requestor;
203
204         if( $ctx->{fetch_patron_circ_info} ) {
205                 my $circ_counts = $U->storagereq('open-ils.storage.actor.user.checked_out.count', $patron->id);
206
207                 $ctx->{patronOverdue} = $circ_counts->{overdue}  + $circ_counts->{long_overdue};
208                 my $out = $ctx->{patronOverdue} + $circ_counts->{out};
209
210                 $ctx->{patronItemsOut} = $out 
211                         unless( $ctx->{patronItemsOut} and $ctx->{patronItemsOut} > $out );
212
213                 $logger->debug("script_builder: patron overdue count is " . $ctx->{patronOverdue});
214         }
215
216         if( $ctx->{fetch_patron_money_info} ) {
217                 $ctx->{patronFines} = $U->patron_money_owed($patron->id);
218                 $logger->debug("script_builder: patron fines determined to be ".$ctx->{patronFines});
219         }
220
221         unless( $ctx->{ignore_user_status} ) {
222                 return OpenILS::Event->new('PATRON_INACTIVE')
223                         unless $U->is_true($patron->active);
224         
225                 return OpenILS::Event->new('PATRON_CARD_INACTIVE')
226                         unless $U->is_true($patron->card->active);
227         
228                 my $expire = DateTime::Format::ISO8601->new->parse_datetime(
229                         cleanse_ISO8601($patron->expire_date));
230         
231                 return OpenILS::Event->new('PATRON_ACCOUNT_EXPIRED')
232                         if( CORE::time > $expire->epoch ) ;
233         }
234
235         return undef;
236 }
237
238
239 sub flatten_groups {
240         my $e = shift;
241         my $tree = shift;
242
243         if(!%GROUP_SET) {
244                 $GROUP_TREE = $e->search_permission_grp_tree(
245                         [
246                                 { parent => undef }, 
247                                 { 
248                                 flesh => 100,
249                                         flesh_fields => { pgt => ['children'] }
250                                 } 
251                         ]
252                 )->[0];
253                 $tree = $GROUP_TREE;
254         }
255
256         return undef unless $tree;
257         $GROUP_SET{$tree->id} = $tree;
258         if( $tree->children ) {
259                 flatten_groups($e, $_) for @{$tree->children};
260         }
261 }
262
263 sub flatten_org_tree {
264         my $tree = shift;
265         return undef unless $tree;
266         push( @ORG_LIST, $tree );
267         if( $tree->children ) {
268                 flatten_org_tree($_) for @{$tree->children};
269         }
270 }
271
272
273
274 sub insert_org_methods {
275         my ( $editor, $runner ) = @_;
276
277         if(!$ORG_TREE) {
278                 $ORG_TREE = $editor->search_actor_org_unit(
279                         [
280                                 {"parent_ou" => undef },
281                                 {
282                                         flesh                           => -1,
283                                         flesh_fields    => { aou =>  ['children'] },
284                                         order_by                        => { aou => 'name'}
285                                 }
286                         ]
287                 )->[0];
288                 flatten_org_tree($ORG_TREE);
289         }
290
291         my $r = $runner;
292         weaken($r);
293
294         $r->insert(__OILS_FUNC_isOrgDescendent  => 
295                 sub {
296                         my( $write_key, $sname, $id ) = @_;
297                         my ($parent)    = grep { $_->shortname eq $sname } @ORG_LIST;
298                         my ($child)             = grep { $_->id == $id } @ORG_LIST;
299                         my $val = is_org_descendent( $parent, $child );
300                         $logger->debug("script_builder: is_org_desc $sname:$id returned val $val, writing to $write_key");
301                         $r->insert($write_key, $val, 1) if $val;
302                         return $val;
303                 }
304         );
305
306         $r->insert(__OILS_FUNC_hasCommonAncestor  => 
307                 sub {
308                         my( $write_key, $orgid1, $orgid2, $depth ) = @_;
309                         my $val = has_common_ancestor( $orgid1, $orgid2, $depth );
310                         $logger->debug("script_builder: has_common_ancestor resturned $val");
311                         $r->insert($write_key, $val, 1) if $val;
312                         return $val;
313                 }
314         );
315 }
316
317
318 sub is_org_descendent {
319         my( $parent, $child ) = @_;
320         return 0 unless $parent and $child;
321         $logger->debug("script_builder: is_org_desc checking parent=".$parent->id.", child=".$child->id);
322         do {
323                 return 0 unless defined $child->parent_ou;
324                 return 1 if $parent->id == $child->id;
325         } while( ($child) = grep { $_->id == $child->parent_ou } @ORG_LIST );
326         return 0;
327 }
328
329 sub has_common_ancestor {
330         my( $org1, $org2, $depth ) = @_;
331         return 0 unless $org1 and $org2;
332         $logger->debug("script_builder: has_common_ancestor checking orgs $org1 : $org2");
333
334         return 1 if $org1 == $org2;
335         ($org1) = grep { $_->id == $org1 } @ORG_LIST;
336         ($org2) = grep { $_->id == $org2 } @ORG_LIST;
337
338         my $p1 = find_parent_at_depth($org1, $depth);
339         my $p2 = find_parent_at_depth($org2, $depth);
340
341         return 1 if $p1->id == $p2->id;
342         return 0;
343 }
344
345
346 sub find_parent_at_depth {
347         my $org = shift;
348         my $depth = shift;
349         return undef unless $org and $depth;
350         fetch_ou_types();
351         do {
352                 my ($t) = grep { $_->id == $org->ou_type } @OU_TYPES;
353                 return $org if $t->depth == $depth;
354         } while( ($org) = grep { $_->id == $org->parent_ou } @ORG_LIST );
355         return undef;   
356 }
357
358
359 sub fetch_ou_types {
360         return if @OU_TYPES;
361         @OU_TYPES = @{new_editor()->retrieve_all_actor_org_unit_type()};
362 }
363
364 sub insert_copy_methods {
365         my( $e, $ctx,  $runner ) = @_;
366         my $reqr = $ctx->{requestor} || $e->requestor;
367         if( my $copy = $ctx->{copy} ) {
368                 $runner->insert_method( 'environment.copy', '__OILS_FUNC_fetch_best_hold', sub {
369                                 my $key = shift;
370                                 $logger->debug("script_builder: searching for permitted hold for copy ".$copy->barcode);
371                                 my ($hold) = $holdcode->find_nearest_permitted_hold( $e, $copy, $reqr, 1 );  # do we need a new editor here since the xact may be dead??
372                                 $runner->insert( $key, $hold, 1 );
373                         }
374                 );
375         }
376 }
377
378 sub insert_user_funcs {
379    my( $e, $ctx, $runner ) = @_;
380
381    # tells how many holds a user has
382         $runner->insert(__OILS_FUNC_userHoldCount  => 
383                 sub {
384                         my( $write_key, $userid ) = @_;
385          my $val = $holdcode->__user_hold_count(new_editor(), $userid);
386          $logger->info("script_runner: user hold count is $val");
387                         $runner->insert($write_key, $val, 1) if $val;
388                         return $val;
389                 }
390         );
391
392         $runner->insert(__OILS_FUNC_userCircsByCircmod  => 
393                 sub {
394                         my( $write_key, $userid ) = @_;
395             use OpenSRF::Utils::JSON;
396
397             # this bug ugly thing generates a count of checkouts by circ_modifier
398              my $query = {
399                 "select" => {
400                     "acp" => ["circ_modifier"],
401                     "circ"=>[{
402                         "aggregate"=> OpenSRF::Utils::JSON->true,
403                         "transform"=>"count",
404                         "alias"=>"count",
405                         "column"=>"id"
406                     }],
407                 },
408                 "from"=>{"acp"=>{"circ"=>{"field"=>"target_copy","fkey"=>"id"}}},
409                 "where"=>{
410                     "+circ"=>{
411                         "checkin_time"=>undef,
412                         "usr"=>$userid,
413                         "-or"=>[
414                             {"stop_fines"=>["MAXFINES","LONGOVERDUE"]},
415                             {"stop_fines"=>undef}
416                         ]
417                     }
418                 }
419             };
420
421             my $mods = $e->json_query($query);
422             my $breakdown = {};
423             $breakdown->{$_->{circ_modifier}} = $_->{count} for @$mods;
424             $logger->info("script_runner: Loaded checkouts by circ_modifier breakdown:". 
425                 OpenSRF::Utils::JSON->perl2JSON($breakdown));
426                         $runner->insert($write_key, $breakdown, 1) if (keys %$breakdown);
427                 }
428         );
429
430 }
431
432
433
434
435 1;