]> git.evergreen-ils.org Git - Evergreen.git/blob - Open-ILS/src/perlmods/OpenILS/WWW/EGCatLoader.pm
ctx.responses was for debugging; don't need it
[Evergreen.git] / Open-ILS / src / perlmods / OpenILS / WWW / EGCatLoader.pm
1 package OpenILS::WWW::EGCatLoader;
2 use strict; use warnings;
3 use CGI;
4 use XML::LibXML;
5 use Digest::MD5 qw(md5_hex);
6 use Apache2::Const -compile => qw(OK DECLINED FORBIDDEN HTTP_INTERNAL_SERVER_ERROR REDIRECT HTTP_BAD_REQUEST);
7 use OpenSRF::AppSession;
8 use OpenSRF::EX qw/:try/;
9 use OpenSRF::Utils qw/:datetime/;
10 use OpenSRF::Utils::JSON;
11 use OpenSRF::Utils::Logger qw/$logger/;
12 use OpenILS::Application::AppUtils;
13 use OpenILS::Utils::CStoreEditor qw/:funcs/;
14 use OpenILS::Utils::Fieldmapper;
15 use DateTime::Format::ISO8601;
16 my $U = 'OpenILS::Application::AppUtils';
17
18 my %cache; # proc-level cache
19
20 sub new {
21     my($class, $apache, $ctx) = @_;
22
23     my $self = bless({}, ref($class) || $class);
24
25     $self->apache($apache);
26     $self->ctx($ctx);
27     $self->cgi(CGI->new);
28
29     OpenILS::Utils::CStoreEditor->init; # just in case
30     $self->editor(new_editor());
31
32     return $self;
33 }
34
35
36 # current Apache2::RequestRec;
37 sub apache {
38     my($self, $apache) = @_;
39     $self->{apache} = $apache if $apache;
40     return $self->{apache};
41 }
42
43 # runtime / template context
44 sub ctx {
45     my($self, $ctx) = @_;
46     $self->{ctx} = $ctx if $ctx;
47     return $self->{ctx};
48 }
49
50 # cstore editor
51 sub editor {
52     my($self, $editor) = @_;
53     $self->{editor} = $editor if $editor;
54     return $self->{editor};
55 }
56
57 # CGI handle
58 sub cgi {
59     my($self, $cgi) = @_;
60     $self->{cgi} = $cgi if $cgi;
61     return $self->{cgi};
62 }
63
64
65 # load common data, then load page data
66 sub load {
67     my $self = shift;
68
69     $self->load_helpers;
70     my $stat = $self->load_common;
71     return $stat unless $stat == Apache2::Const::OK;
72
73     my $path = $self->apache->path_info;
74
75     return $self->load_home if $path =~ /opac\/home/;
76     return $self->load_login if $path =~ /opac\/login/;
77     return $self->load_logout if $path =~ /opac\/logout/;
78     return $self->load_rresults if $path =~ /opac\/results/;
79     return $self->load_record if $path =~ /opac\/record/;
80
81     # ----------------------------------------------------------------
82     # These pages require authentication
83     # ----------------------------------------------------------------
84     return Apache2::Const::FORBIDDEN unless $self->cgi->https;
85     return $self->load_logout unless $self->editor->requestor;
86
87     return $self->load_place_hold if $path =~ /opac\/place_hold/;
88     return $self->load_myopac_holds if $path =~ /opac\/myopac\/holds/;
89     return $self->load_myopac_circs if $path =~ /opac\/myopac\/circs/;
90     return $self->load_myopac_fines if $path =~ /opac\/myopac\/fines/;
91     return $self->load_myopac if $path =~ /opac\/myopac/;
92     # ----------------------------------------------------------------
93
94     return Apache2::Const::OK;
95 }
96
97 # general purpose utility functions added to the environment
98 sub load_helpers {
99     my $self = shift;
100     my $e = $self->editor;
101     my $ctx = $self->ctx;
102
103     $cache{map} = {}; # public object maps
104     $cache{list} = {}; # public object lists
105
106     # fetch-on-demand-and-cache subs for commonly used public data
107     my @public_classes = qw/ccs aout/;
108
109     for my $hint (@public_classes) {
110
111         my ($class) = grep {
112             $Fieldmapper::fieldmap->{$_}->{hint} eq $hint
113         } keys %{ $Fieldmapper::fieldmap };
114
115             $class =~ s/Fieldmapper:://o;
116             $class =~ s/::/_/g;
117
118         # copy statuses
119         my $list_key = $hint . '_list';
120         my $find_key = "find_$hint";
121
122         $ctx->{$list_key} = sub {
123             my $method = "retrieve_all_$class";
124             $cache{list}{$hint} = $e->$method() unless $cache{list}{$hint};
125             return $cache{list}{$hint};
126         };
127     
128         $cache{map}{$hint} = {};
129
130         $ctx->{$find_key} = sub {
131             my $id = shift;
132             return $cache{map}{$hint}{$id} if $cache{map}{$hint}{$id}; 
133             ($cache{map}{$hint}{$id}) = grep { $_->id == $id } @{$ctx->{$list_key}->()};
134             return $cache{map}{$hint}{$id};
135         };
136
137     }
138
139     $ctx->{aou_tree} = sub {
140
141         # fetch the org unit tree
142         unless($cache{aou_tree}) {
143             my $tree = $e->search_actor_org_unit([
144                             {   parent_ou => undef},
145                             {   flesh            => -1,
146                                     flesh_fields    => {aou =>  ['children']},
147                                     order_by        => {aou => 'name'}
148                             }
149                     ])->[0];
150
151             # flesh the org unit type for each org unit
152             # and simultaneously set the id => aou map cache
153             sub flesh_aout {
154                 my $node = shift;
155                 my $ctx = shift;
156                 $node->ou_type( $ctx->{find_aout}->($node->ou_type) );
157                 $cache{map}{aou}{$node->id} = $node;
158                 flesh_aout($_, $ctx) foreach @{$node->children};
159             };
160             flesh_aout($tree, $ctx);
161
162             $cache{aou_tree} = $tree;
163         }
164
165         return $cache{aou_tree};
166     };
167
168     # Add a special handler for the tree-shaped org unit cache
169     $cache{map}{aou} = {};
170     $ctx->{find_aou} = sub {
171         my $org_id = shift;
172         $ctx->{aou_tree}->(); # force the org tree to load
173         return $cache{map}{aou}{$org_id};
174     };
175
176     # turns an ISO date into something TT can understand
177     $ctx->{parse_datetime} = sub {
178         my $date = shift;
179         $date = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($date));
180         return sprintf(
181             "%0.2d:%0.2d:%0.2d %0.2d-%0.2d-%0.4d",
182             $date->hour,
183             $date->minute,
184             $date->second,
185             $date->day,
186             $date->month,
187             $date->year
188         );
189     }
190 }
191
192 # context additions: 
193 #   authtoken : string
194 #   user : au object
195 #   user_status : hash of user circ numbers
196 sub load_common {
197     my $self = shift;
198
199     my $e = $self->editor;
200     my $ctx = $self->ctx;
201
202     if($e->authtoken($self->cgi->cookie('ses'))) {
203
204         if($e->checkauth) {
205
206             $ctx->{authtoken} = $e->authtoken;
207             $ctx->{user} = $e->requestor;
208             $ctx->{user_stats} = $U->simplereq(
209                 'open-ils.actor', 
210                 'open-ils.actor.user.opac.vital_stats', 
211                 $e->authtoken, $e->requestor->id);
212
213         } else {
214
215             return $self->load_logout;
216         }
217     }
218
219     return Apache2::Const::OK;
220 }
221
222 sub load_home {
223     my $self = shift;
224     $self->ctx->{page} = 'home';
225     return Apache2::Const::OK;
226 }
227
228
229 sub load_login {
230     my $self = shift;
231     my $cgi = $self->cgi;
232
233     $self->ctx->{page} = 'login';
234
235     my $username = $cgi->param('username');
236     my $password = $cgi->param('password');
237
238     return Apache2::Const::OK unless $username and $password;
239
240         my $seed = $U->simplereq(
241         'open-ils.auth', 
242                 'open-ils.auth.authenticate.init',
243         $username);
244
245         my $response = $U->simplereq(
246         'open-ils.auth', 
247                 'open-ils.auth.authenticate.complete', 
248                 {       username => $username, 
249                         password => md5_hex($seed . md5_hex($password)), 
250                         type => 'opac' 
251         }
252     );
253
254     # XXX check event, redirect as necessary
255
256     my $home = $self->apache->unparsed_uri;
257     $home =~ s/\/login/\/home/;
258
259     $self->apache->print(
260         $cgi->redirect(
261             -url => $cgi->param('origin') || $home,
262             -cookie => $cgi->cookie(
263                 -name => 'ses',
264                 -path => '/',
265                 -secure => 1,
266                 -value => $response->{payload}->{authtoken},
267                 -expires => CORE::time + $response->{payload}->{authtime}
268             )
269         )
270     );
271
272     return Apache2::Const::REDIRECT;
273 }
274
275 sub load_logout {
276     my $self = shift;
277
278     my $url = 'http://' . $self->apache->hostname . $self->ctx->{base_path} . "/opac/home";
279
280     $self->apache->print(
281         $self->cgi->redirect(
282             -url => $url,
283             -cookie => $self->cgi->cookie(
284                 -name => 'ses',
285                 -path => '/',
286                 -value => '',
287                 -expires => '-1h'
288             )
289         )
290     );
291
292     return Apache2::Const::REDIRECT;
293 }
294
295 # context additions: 
296 #   page_size
297 #   hit_count
298 #   records : list of bre's and copy-count objects
299 sub load_rresults {
300     my $self = shift;
301     my $cgi = $self->cgi;
302     my $ctx = $self->ctx;
303     my $e = $self->editor;
304
305     $ctx->{page} = 'rresult';
306     my $page = $cgi->param('page') || 0;
307     my $facet = $cgi->param('facet');
308     my $query = $cgi->param('query');
309     my $limit = $cgi->param('limit') || 10; # XXX user settings
310     my $args = {limit => $limit, offset => $page * $limit}; 
311     $query = "$query $facet" if $facet;
312     my $results;
313
314     try {
315         $results = $U->simplereq(
316             'open-ils.search',
317             'open-ils.search.biblio.multiclass.query.staff', 
318             $args, $query, 1);
319
320     } catch Error with {
321         my $err = shift;
322         $logger->error("multiclass search error: $err");
323         $results = {count => 0, ids => []};
324     };
325
326     my $rec_ids = [map { $_->[0] } @{$results->{ids}}];
327
328     $ctx->{records} = [];
329     $ctx->{search_facets} = {};
330     $ctx->{page_size} = $limit;
331     $ctx->{hit_count} = $results->{count};
332
333     return Apache2::Const::OK if @$rec_ids == 0;
334
335     my $cstore1 = OpenSRF::AppSession->create('open-ils.cstore');
336     my $bre_req = $cstore1->request(
337         'open-ils.cstore.direct.biblio.record_entry.search', {id => $rec_ids});
338
339     my $search = OpenSRF::AppSession->create('open-ils.search');
340     my $facet_req = $search->request('open-ils.search.facet_cache.retrieve', $results->{facet_key}, 10);
341
342     unless($cache{cmf}) {
343         $cache{cmf} = $e->search_config_metabib_field({id => {'!=' => undef}});
344         $ctx->{metabib_field} = $cache{cmf};
345         #$cache{cmc} = $e->search_config_metabib_class({name => {'!=' => undef}});
346         #$ctx->{metabib_class} = $cache{cmc};
347     }
348
349     my @data;
350     while(my $resp = $bre_req->recv) {
351         my $bre = $resp->content; 
352
353         # XXX farm out to multiple cstore sessions before loop, then collect after
354         my $copy_counts = $e->json_query(
355             {from => ['asset.record_copy_count', 1, $bre->id, 0]})->[0];
356
357         push(@data,
358             {
359                 bre => $bre,
360                 marc_xml => XML::LibXML->new->parse_string($bre->marc),
361                 copy_counts => $copy_counts
362             }
363         );
364     }
365
366     $cstore1->kill_me;
367
368     # shove recs into context in search results order
369     for my $rec_id (@$rec_ids) { 
370         push(
371             @{$ctx->{records}},
372             grep { $_->{bre}->id == $rec_id } @data
373         );
374     }
375
376     my $facets = $facet_req->gather(1);
377
378     for my $cmf_id (keys %$facets) {  # quick-n-dirty
379         my ($cmf) = grep { $_->id eq $cmf_id } @{$cache{cmf}};
380         $facets->{$cmf_id} = {cmf => $cmf, data => $facets->{$cmf_id}};
381     }
382     $ctx->{search_facets} = $facets;
383
384     return Apache2::Const::OK;
385 }
386
387 # context additions: 
388 #   record : bre object
389 sub load_record {
390     my $self = shift;
391     $self->ctx->{page} = 'record';
392
393     my $rec_id = $self->ctx->{page_args}->[0]
394         or return Apache2::Const::HTTP_BAD_REQUEST;
395
396     $self->ctx->{record} = $self->editor->retrieve_biblio_record_entry([
397         $rec_id,
398         {
399             flesh => 2, 
400             flesh_fields => {
401                 bre => ['call_numbers'],
402                 acn => ['copies'] # limit, paging, etc.
403             }
404         }
405     ]);
406
407     $self->ctx->{marc_xml} = XML::LibXML->new->parse_string($self->ctx->{record}->marc);
408
409     return Apache2::Const::OK;
410 }
411
412 # context additions: 
413 #   user : au object, fleshed
414 sub load_myopac {
415     my $self = shift;
416     $self->ctx->{page} = 'myopac';
417
418     $self->ctx->{user} = $self->editor->retrieve_actor_user([
419         $self->ctx->{user}->id,
420         {
421             flesh => 1,
422             flesh_fields => {
423                 au => ['card']
424                 # ...
425             }
426         }
427     ]);
428
429     return Apache2::Const::OK;
430 }
431
432 sub load_myopac_holds {
433     my $self = shift;
434     my $e = $self->editor;
435     my $ctx = $self->ctx;
436
437     my $limit = $self->cgi->param('limit') || 0;
438     my $offset = $self->cgi->param('offset') || 0;
439
440     my $circ = OpenSRF::AppSession->create('open-ils.circ');
441     my $hold_ids = $circ->request(
442         'open-ils.circ.holds.id_list.retrieve', 
443         $e->authtoken, 
444         $e->requestor->id
445     )->gather(1);
446
447     $hold_ids = [ grep { defined $_ } @$hold_ids[$offset..($offset + $limit - 1)] ] if $limit or $offset;
448
449     my $req = $circ->request(
450         'open-ils.circ.hold.details.batch.retrieve', 
451         $e->authtoken, 
452         $hold_ids,
453         {
454             suppress_notices => 1,
455             suppress_transits => 1,
456             suppress_mvr => 1,
457             suppress_patron_details => 1,
458             include_bre => 1
459         }
460     );
461
462     # any requests we can fire off here?
463     
464     $ctx->{holds} = []; 
465     while(my $resp = $req->recv) {
466         my $hold = $resp->content;
467         push(@{$ctx->{holds}}, {
468             hold => $hold,
469             marc_xml => XML::LibXML->new->parse_string($hold->{bre}->marc)
470         });
471     }
472
473     $circ->kill_me;
474     return Apache2::Const::OK;
475 }
476
477 sub load_place_hold {
478     my $self = shift;
479     my $ctx = $self->ctx;
480     my $e = $self->editor;
481     $self->ctx->{page} = 'place_hold';
482
483     $ctx->{hold_target} = $self->cgi->param('hold_target');
484     $ctx->{hold_type} = $self->cgi->param('hold_type');
485     $ctx->{default_pickup_lib} = $e->requestor->home_ou; # XXX staff
486
487     if($ctx->{hold_type} eq 'T') {
488         $ctx->{record} = $e->retrieve_biblio_record_entry($ctx->{hold_target});
489     }
490     # ...
491
492     $ctx->{marc_xml} = XML::LibXML->new->parse_string($ctx->{record}->marc);
493
494     if(my $pickup_lib = $self->cgi->param('pickup_lib')) {
495
496         my $args = {
497             patronid => $e->requestor->id,
498             titleid => $ctx->{hold_target}, # XXX
499             pickup_lib => $pickup_lib,
500             depth => 0, # XXX
501         };
502
503         my $allowed = $U->simplereq(
504             'open-ils.circ',
505             'open-ils.circ.title_hold.is_possible',
506             $e->authtoken, $args
507         );
508
509         if($allowed->{success} == 1) {
510             my $hold = Fieldmapper::action::hold_request->new;
511
512             $hold->pickup_lib($pickup_lib);
513             $hold->requestor($e->requestor->id);
514             $hold->usr($e->requestor->id); # XXX staff
515             $hold->target($ctx->{hold_target});
516             $hold->hold_type($ctx->{hold_type});
517             # frozen, expired, etc..
518
519             my $stat = $U->simplereq(
520                 'open-ils.circ',
521                 'open-ils.circ.holds.create',
522                 $e->authtoken, $hold
523             );
524
525             if($stat and $stat > 0) {
526                 $ctx->{hold_success} = 1;
527             } else {
528                 $ctx->{hold_failed} = 1; # XXX process the events, etc
529             }
530         }
531
532         # place the hold and deliver results
533     }
534
535     return Apache2::Const::OK;
536 }
537
538
539 sub fetch_user_circs {
540     my $self = shift;
541     my $flesh = shift; # flesh bib data, etc.
542     my $circ_ids = shift;
543     my $limit = shift;
544     my $offset = shift;
545
546     my $e = $self->editor;
547
548     my @circ_ids;
549
550     if($circ_ids) {
551         @circ_ids = @$circ_ids;
552
553     } else {
554
555         my $circ_data = $U->simplereq(
556             'open-ils.actor', 
557             'open-ils.actor.user.checked_out',
558             $e->authtoken, 
559             $e->requestor->id
560         );
561
562         @circ_ids =  ( @{$circ_data->{overdue}}, @{$circ_data->{out}} );
563
564         if($limit or $offset) {
565             @circ_ids = grep { defined $_ } @circ_ids[0..($offset + $limit - 1)];
566         }
567     }
568
569     return [] unless @circ_ids;
570
571     my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
572
573     my $qflesh = {
574         flesh => 3,
575         flesh_fields => {
576             circ => ['target_copy'],
577             acp => ['call_number'],
578             acn => ['record']
579         }
580     };
581
582     $e->xact_begin;
583     my $circs = $e->search_action_circulation(
584         [{id => \@circ_ids}, ($flesh) ? $qflesh : {}], {substream => 1});
585
586     my @circs;
587     for my $circ (@$circs) {
588         push(@circs, {
589             circ => $circ, 
590             marc_xml => ($flesh and $circ->target_copy->call_number->id != -1) ? 
591                 XML::LibXML->new->parse_string($circ->target_copy->call_number->record->marc) : 
592                 undef  # pre-cat copy, use the dummy title/author instead
593         });
594     }
595     $e->xact_rollback;
596
597     # make sure the final list is in the correct order
598     my @sorted_circs;
599     for my $id (@circ_ids) {
600         push(
601             @sorted_circs,
602             (grep { $_->{circ}->id == $id } @circs)
603         );
604     }
605
606     return \@sorted_circs;
607 }
608
609
610 sub handle_circ_renew {
611     my $self = shift;
612     my $action = shift;
613     my $ctx = $self->ctx;
614
615     my @renew_ids = $self->cgi->param('circ');
616
617     my $circs = $self->fetch_user_circs(0, ($action eq 'renew') ? [@renew_ids] : undef);
618
619     # TODO: fire off renewal calls in batches to speed things up
620     my @responses;
621     for my $circ (@$circs) {
622
623         my $evt = $U->simplereq(
624             'open-ils.circ', 
625             'open-ils.circ.renew',
626             $self->editor->authtoken,
627             {
628                 patron_id => $self->editor->requestor->id,
629                 copy_id => $circ->{circ}->target_copy,
630                 opac_renewal => 1
631             }
632         );
633
634         # TODO return these, then insert them into the circ data 
635         # blob that is shoved into the template for each circ
636         # so the template won't have to match them
637         push(@responses, {copy => $circ->{circ}->target_copy, evt => $evt});
638     }
639
640     return @responses;
641 }
642
643
644 sub load_myopac_circs {
645     my $self = shift;
646     my $e = $self->editor;
647     my $ctx = $self->ctx;
648
649     $ctx->{circs} = [];
650     my $limit = $self->cgi->param('limit') || 0; # 0 == unlimited
651     my $offset = $self->cgi->param('offset') || 0;
652     my $action = $self->cgi->param('action') || '';
653
654     # perform the renewal first if necessary
655     my @results = $self->handle_circ_renew($action) if $action =~ /renew/;
656
657     $ctx->{circs} = $self->fetch_user_circs(1, undef, $limit, $offset);
658
659     my $success_renewals = 0;
660     my $failed_renewals = 0;
661     for my $data (@{$ctx->{circs}}) {
662         my ($resp) = grep { $_->{copy} == $data->{circ}->target_copy->id } @results;
663
664         if($resp) {
665             #$self->apache->log->warn("renewal response: " . OpenSRF::Utils::JSON->perl2JSON($resp));
666             my $evt = ref($resp->{evt}) eq 'ARRAY' ? $resp->{evt}->[0] : $resp->{evt};
667             $data->{renewal_response} = $evt;
668             $success_renewals++ if $evt->{textcode} eq 'SUCCESS';
669             $failed_renewals++ if $evt->{textcode} ne 'SUCCESS';
670         }
671     }
672
673     $ctx->{success_renewals} = $success_renewals;
674     $ctx->{failed_renewals} = $failed_renewals;
675
676     return Apache2::Const::OK;
677 }
678
679 sub load_myopac_fines {
680     my $self = shift;
681     my $e = $self->editor;
682     my $ctx = $self->ctx;
683     $ctx->{"fines"} = {
684         "circulation" => [],
685         "grocery" => []
686     };
687
688     my $limit = $self->cgi->param('limit') || 0;
689     my $offset = $self->cgi->param('offset') || 0;
690
691     my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
692
693     # TODO: This should really use a ML call, but the existing calls 
694     # return an excessive amount of data and don't offer streaming
695
696     my %paging = ($limit or $offset) ? (limit => $limit, offset => $offset) : ();
697
698     my $req = $cstore->request(
699         'open-ils.cstore.direct.money.open_billable_transaction_summary.search',
700         {
701             usr => $e->requestor->id,
702             balance_owed => {'!=' => 0}
703         },
704         {
705             flesh => 4,
706             flesh_fields => {
707                 mobts => ['circulation', 'grocery'],
708                 mg => ['billings'],
709                 mb => ['btype'],
710                 circ => ['target_copy'],
711                 acp => ['call_number'],
712                 acn => ['record']
713             },
714             order_by => { mobts => 'xact_start' },
715             %paging
716         }
717     );
718
719     while(my $resp = $req->recv) {
720         my $mobts = $resp->content;
721         my $circ = $mobts->circulation;
722
723         my $last_billing;
724         if($mobts->grocery) {
725             my @billings = sort { $a->billing_ts cmp $b->billing_ts } @{$mobts->grocery->billings};
726             $last_billing = pop(@billings);
727         }
728
729         push(
730             @{$ctx->{"fines"}->{$mobts->grocery ? "grocery" : "circulation"}},
731             {
732                 xact => $mobts,
733                 last_grocery_billing => $last_billing,
734                 marc_xml => ($mobts->xact_type ne 'circulation' or $circ->target_copy->call_number->id == -1) ?
735                     undef :
736                     XML::LibXML->new->parse_string($circ->target_copy->call_number->record->marc),
737             } 
738         );
739     }
740
741      return Apache2::Const::OK;
742 }       
743
744
745 1;