Fix some issues with pcrud and cstore calls in NCIP::ILS::Evergreen.
[working/NCIPServer.git] / lib / NCIP / ILS / Evergreen.pm
1 # ---------------------------------------------------------------
2 # Copyright © 2014 Jason J.A. Stephenson <jason@sigio.com>
3 #
4 # This file is part of NCIPServer.
5 #
6 # NCIPServer is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
10 #
11 # NCIPServer is distributed in the hope that it will be useful, but
12 # WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14 # General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License
17 # along with NCIPServer.  If not, see <http://www.gnu.org/licenses/>.
18 # ---------------------------------------------------------------
19 package NCIP::ILS::Evergreen;
20
21 use Modern::Perl;
22 use XML::LibXML::Simple qw(XMLin);
23 use DateTime;
24 use DateTime::Format::ISO8601;
25 use Digest::MD5 qw/md5_hex/;
26 use OpenSRF::System;
27 use OpenSRF::Utils qw/:datetime/;
28 use OpenSRF::Utils::SettingsClient;
29 use OpenILS::Utils::Fieldmapper;
30 use OpenILS::Application::AppUtils;
31 use OpenILS::Const qw/:const/;
32 use MARC::Record;
33 use MARC::Field;
34 use MARC::File::XML;
35
36 # We need a bunch of NCIP::* objects.
37 use NCIP::Response;
38 use NCIP::Problem;
39 use NCIP::User;
40 use NCIP::User::OptionalFields;
41 use NCIP::User::AddressInformation;
42 use NCIP::User::Id;
43 use NCIP::User::BlockOrTrap;
44 use NCIP::User::Privilege;
45 use NCIP::User::PrivilegeStatus;
46 use NCIP::StructuredPersonalUserName;
47 use NCIP::StructuredAddress;
48 use NCIP::ElectronicAddress;
49
50 # Inherit from NCIP::ILS.
51 use parent qw(NCIP::ILS);
52
53 # Default values we define for things that might be missing in our
54 # runtime environment or configuration file that absolutely must have
55 # values.
56 #
57 # OILS_NCIP_CONFIG_DEFAULT is the default location to find our
58 # driver's configuration file.  This location can be overridden by
59 # setting the path in the OILS_NCIP_CONFIG environment variable.
60 #
61 # BIB_SOURCE_DEFAULT is the config.bib_source.id to use when creating
62 # "short" bibs.  It is used only if no entry is supplied in the
63 # configuration file.  The provided default is 2, the id of the
64 # "System Local" source that comes with a default Evergreen
65 # installation.
66 use constant {
67     OILS_NCIP_CONFIG_DEFAULT => '/openils/conf/oils_ncip.xml',
68     BIB_SOURCE_DEFAULT => 2
69 };
70
71 # A common Evergreen code shortcut to use AppUtils:
72 my $U = 'OpenILS::Application::AppUtils';
73
74 # The usual constructor:
75 sub new {
76     my $class = shift;
77     $class = ref($class) if (ref $class);
78
79     # Instantiate our parent with the rest of the arguments.  It
80     # creates a blessed hashref.
81     my $self = $class->SUPER::new(@_);
82
83     # Look for our configuration file, load, and parse it:
84     $self->_configure();
85
86     # Bootstrap OpenSRF and prepare some OpenILS components.
87     $self->_bootstrap();
88
89     # Initialize the rest of our internal state.
90     $self->_init();
91
92     return $self;
93 }
94
95 sub lookupuser {
96     my $self = shift;
97     my $request = shift;
98
99     # Check our session and login if necessary.
100     $self->login() unless ($self->checkauth());
101
102     my $message_type = $self->parse_request_type($request);
103
104     # Let's go ahead and create our response object. We need this even
105     # if there is a problem.
106     my $response = NCIP::Response->new({type => $message_type . "Response"});
107     $response->header($self->make_header($request));
108
109     # Need to parse the request object to get the user barcode.
110     my ($barcode, $idfield) = $self->find_user_barcode($request);
111
112     # If we can't find a barcode, report a problem.
113     unless ($barcode) {
114         $idfield = 'AuthenticationInputType' unless ($idfield);
115         # Fill in a problem object and stuff it in the response.
116         my $problem = NCIP::Problem->new();
117         $problem->ProblemType('Needed Data Missing');
118         $problem->ProblemDetail('Cannot find user barcode in message.');
119         $problem->ProblemElement($idfield);
120         $problem->ProblemValue('Barcode');
121         $response->problem($problem);
122         return $response;
123     }
124
125     # Look up our patron by barcode:
126     my $user = $U->simplereq(
127         'open-ils.actor',
128         'open-ils.actor.user.fleshed.retrieve_by_barcode',
129         $self->{session}->{authtoken},
130         $barcode,
131         1
132     );
133
134     # Check for a failure, or a deleted, inactive, or expired user,
135     # and if so, return empty userdata.
136     if (!$user || $U->event_code($user) || $U->is_true($user->deleted())
137             || !grep {$_->barcode() eq $barcode && $U->is_true($_->active())} @{$user->cards()}) {
138
139         my $problem = NCIP::Problem->new();
140         $problem->ProblemType('Unknown User');
141         $problem->ProblemDetail("User with barcode $barcode unknown");
142         $problem->ProblemElement($idfield);
143         $problem->ProblemValue($barcode);
144         $response->problem($problem);
145         return $response;
146     }
147
148     # We got the information, so lets fill in our userdata.
149     my $userdata = NCIP::User->new();
150
151     # Make an array of the user's active barcodes.
152     my $ids = [];
153     foreach my $card (@{$user->cards()}) {
154         if ($U->is_true($card->active())) {
155             my $id = NCIP::User::Id->new({
156                 UserIdentifierType => 'Barcode',
157                 UserIdentifierValue => $card->barcode()
158             });
159             push(@$ids, $id);
160         }
161     }
162     $userdata->UserId($ids);
163
164     # Check if they requested any optional fields and return those.
165     my $elements = $request->{$message_type}->{UserElementType};
166     if ($elements) {
167         $elements = [$elements] unless (ref $elements eq 'ARRAY');
168         my $optionalfields = NCIP::User::OptionalFields->new();
169
170         # First, we'll look for name information.
171         if (grep {$_ eq 'Name Information'} @$elements) {
172             my $name = NCIP::StructuredPersonalUserName->new();
173             $name->Surname($user->family_name());
174             $name->GivenName($user->first_given_name());
175             $name->Prefix($user->prefix());
176             $name->Suffix($user->suffix());
177             $optionalfields->NameInformation($name);
178         }
179
180         # Next, check for user address information.
181         if (grep {$_ eq 'User Address Information'} @$elements) {
182             my $addresses = [];
183
184             # See if the user has any valid, physcial addresses.
185             foreach my $addr (@{$user->addresses()}) {
186                 next if ($U->is_true($addr->pending()));
187                 my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>$addr->address_type()});
188                 my $physical = NCIP::StructuredAddress->new();
189                 $physical->Line1($addr->street1());
190                 $physical->Line2($addr->street2());
191                 $physical->Locality($addr->city());
192                 $physical->Region($addr->state());
193                 $physical->PostalCode($addr->post_code());
194                 $physical->Country($addr->country());
195                 $address->PhysicalAddress($physical);
196                 push @$addresses, $address;
197             }
198
199             # Right now, we're only sharing email address if the user
200             # has it. We don't share phone numbers.
201             if ($user->email()) {
202                 my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>'Email Address'});
203                 $address->ElectronicAddress(
204                     NCIP::ElectronicAddress->new({
205                         Type=>'Email Address',
206                         Data=>$user->email()
207                     })
208                 );
209                 push @$addresses, $address;
210             }
211
212             $optionalfields->UserAddressInformation($addresses);
213         }
214
215         # Check for User Privilege.
216         if (grep {$_ eq 'User Privilege'} @$elements) {
217             # Get the user's group:
218             my $pgt = $U->simplereq(
219                 'open-ils.pcrud',
220                 'open-ils.pcrud.retrieve.pgt',
221                 $self->{session}->{authtoken},
222                 $user->profile()
223             );
224             if ($pgt) {
225                 my $privilege = NCIP::User::Privilege->new();
226                 $privilege->AgencyId($user->home_ou->shortname());
227                 $privilege->AgencyUserPrivilegeType($pgt->name());
228                 $privilege->ValidToDate($user->expire_date());
229                 $privilege->ValidFromDate($user->create_date());
230
231                 my $status = 'Active';
232                 if (_expired($user)) {
233                     $status = 'Expired';
234                 } elsif ($U->is_true($user->barred())) {
235                     $status = 'Barred';
236                 } elsif (!$U->is_true($user->active())) {
237                     $status = 'Inactive';
238                 }
239                 if ($status) {
240                     $privilege->UserPrivilegeStatus(
241                         NCIP::User::PrivilegeStatus->new({
242                             UserPrivilegeStatusType => $status
243                         })
244                     );
245                 }
246
247                 $optionalfields->UserPrivilege([$privilege]);
248             }
249         }
250
251         # Check for Block Or Trap.
252         if (grep {$_ eq 'Block Or Trap'} @$elements) {
253             my $blocks = [];
254
255             # First, let's check if the profile is blocked from ILL.
256             if (grep {$_->id() == $user->profile()} @{$self->{blocked_profiles}}) {
257                 my $block = NCIP::User::BlockOrTrap->new();
258                 $block->AgencyId($user->home_ou->shortname());
259                 $block->BlockOrTrapType('Block Interlibrary Loan');
260                 push @$blocks, $block;
261             }
262
263             # Next, we loop through the user's standing penalties
264             # looking for blocks on CIRC, HOLD, and RENEW.
265             my ($have_circ, $have_renew, $have_hold) = (0,0,0);
266             foreach my $penalty (@{$user->standing_penalties()}) {
267                 next unless($penalty->standing_penalty->block_list());
268                 my @block_list = split(/\|/, $penalty->standing_penalty->block_list());
269                 my $ou = $U->simplereq(
270                     'open-ils.pcrud',
271                     'open-ils.pcrud.retrieve.aou',
272                     $self->{session}->{authtoken},
273                     $penalty->org_unit()
274                 );
275
276                 # Block checkout.
277                 if (!$have_circ && grep {$_ eq 'CIRC'} @block_list) {
278                     my $bot = NCIP::User::BlockOrTrap->new();
279                     $bot->AgencyId($ou->shortname());
280                     $bot->BlockOrTrapType('Block Checkout');
281                     push @$blocks, $bot;
282                     $have_circ = 1;
283                 }
284
285                 # Block holds.
286                 if (!$have_hold && grep {$_ eq 'HOLD' || $_ eq 'FULFILL'} @block_list) {
287                     my $bot = NCIP::User::BlockOrTrap->new();
288                     $bot->AgencyId($ou->shortname());
289                     $bot->BlockOrTrapType('Block Holds');
290                     push @$blocks, $bot;
291                     $have_hold = 1;
292                 }
293
294                 # Block renewals.
295                 if (!$have_renew && grep {$_ eq 'RENEW'} @block_list) {
296                     my $bot = NCIP::User::BlockOrTrap->new();
297                     $bot->AgencyId($ou->shortname());
298                     $bot->BlockOrTrapType('Block Renewals');
299                     push @$blocks, $bot;
300                     $have_renew = 1;
301                 }
302
303                 # Stop after we report one of each, even if more
304                 # blocks remain.
305                 last if ($have_circ && $have_renew && $have_hold);
306             }
307
308             $optionalfields->BlockOrTrap($blocks);
309         }
310
311         $userdata->UserOptionalFields($optionalfields);
312     }
313
314     $response->data($userdata);
315
316     return $response;
317 }
318
319 # Implementation functions that might be useful to a subclass.
320
321 # Login via OpenSRF to Evergreen.
322 sub login {
323     my $self = shift;
324
325     # Get the authentication seed.
326     my $seed = $U->simplereq(
327         'open-ils.auth',
328         'open-ils.auth.authenticate.init',
329         $self->{config}->{credentials}->{username}
330     );
331
332     # Actually login.
333     if ($seed) {
334         my $response = $U->simplereq(
335             'open-ils.auth',
336             'open-ils.auth.authenticate.complete',
337             {
338                 username => $self->{config}->{credentials}->{username},
339                 password => md5_hex(
340                     $seed . md5_hex($self->{config}->{credentials}->{password})
341                 ),
342                 type => 'staff',
343                 workstation => $self->{config}->{credentials}->{workstation}
344             }
345         );
346         if ($response) {
347             $self->{session}->{authtoken} = $response->{payload}->{authtoken};
348             $self->{session}->{authtime} = $response->{payload}->{authtime};
349         }
350     }
351 }
352
353 # Return 1 if we have a 'valid' authtoken, 0 if not.
354 sub checkauth {
355     my $self = shift;
356
357     # We use AppUtils to do the heavy lifting.
358     if (defined($self->{session})) {
359         if ($U->check_user_session($self->{session}->{authtoken})) {
360             return 1;
361         } else {
362             return 0;
363         }
364     }
365
366     # If we reach here, we don't have a session, so we are definitely
367     # not logged in.
368     return 0;
369 }
370
371 # private subroutines not meant to be used directly by subclasses.
372 # Most have to do with setup and/or state checking of implementation
373 # components.
374
375 # Find, load, and parse our configuration file:
376 sub _configure {
377     my $self = shift;
378
379     # Find the configuration file via variables:
380     my $file = OILS_NCIP_CONFIG_DEFAULT;
381     $file = $ENV{OILS_NCIP_CONFIG} if ($ENV{OILS_NCIP_CONFIG});
382
383     $self->{config} = XMLin($file, NormaliseSpace => 2,
384                             ForceArray => ['block_profile', 'stat_cat_entry']);
385 }
386
387 # Bootstrap OpenSRF::System and load the IDL.
388 sub _bootstrap {
389     my $self = shift;
390
391     my $bootstrap_config = $self->{config}->{bootstrap};
392     OpenSRF::System->bootstrap_client(config_file => $bootstrap_config);
393
394     my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
395     Fieldmapper->import(IDL => $idl);
396 }
397
398 # Login and then initialize some object data based on the
399 # configuration.
400 sub _init {
401     my $self = shift;
402
403     # Login to Evergreen.
404     $self->login();
405
406     # Retrieve the work_ou as an object.
407     $self->{work_ou} = $U->simplereq(
408         'open-ils.pcrud',
409         'open-ils.pcrud.search.aou',
410         $self->{session}->{authtoken},
411         {shortname => $self->{config}->{credentials}->{work_ou}}
412     );
413
414     # Load the barred groups as pgt objects into a blocked_profiles
415     # list.
416     $self->{blocked_profiles} = [];
417     foreach (@{$self->{config}->{patrons}->{block_profile}}) {
418         my $pgt;
419         if (ref $_) {
420             $pgt = $U->simplereq(
421                 'open-ils.pcrud',
422                 'open-ils.pcrud.retrieve.pgt',
423                 $self->{session}->{authtoken},
424                 $_->{grp}
425             );
426         } else {
427             $pgt = $U->simplereq(
428                 'open-ils.pcrud',
429                 'open-ils.pcrud.search.pgt',
430                 $self->{session}->{authtoken},
431                 {name => $_}
432             );
433         }
434         push(@{$self->{blocked_profiles}}, $pgt) if ($pgt);
435     }
436
437     # Load the bib source if we're not using precats.
438     unless ($self->{config}->{items}->{use_precats}) {
439         # Retrieve the default
440         $self->{bib_source} = $U->simplereq(
441             'open-ils.pcrud',
442             'open-ils.pcrud.retrieve.cbs',
443             $self->{session}->{authtoken},
444             BIB_SOURCE_DEFAULT);
445         my $data = $self->{config}->{items}->{bib_source};
446         if ($data) {
447             $data = $data->[0] if (ref($data) eq 'ARRAY');
448             my $result;
449             if (ref $data) {
450                 $result = $U->simplereq(
451                     'open-ils.pcrud',
452                     'open-ils.pcrud.retrieve.cbs',
453                     $self->{session}->{authtoken},
454                     $data->{cbs}
455                 );
456             } else {
457                 $result = $U->simplereq(
458                     'open-ils.pcrud',
459                     'open-ils.pcrud.search.cbs',
460                     $self->{session}->{authtoken},
461                     {source => $data}
462                 );
463             }
464             $self->{bib_source} = $result if ($result);
465         }
466     }
467
468     # Load the required asset.stat_cat_entries:
469     $self->{stat_cat_entries} = [];
470     foreach (@{$self->{config}->{items}->{stat_cat_entry}}) {
471         # Must have the stat_cat attr and the name, so we must have a
472         # reference.
473         next unless(ref $_);
474         # We want to limit the search to the work org and its
475         # ancestors.
476         my $ancestors = $U->get_org_ancestors($self->{work_ou}->id());
477         # We only want 1, so we don't do .atomic.
478         my $result = $U->simplereq(
479             'open-ils.cstore',
480             'open-ils.cstore.direct.asset.stat_cat_entry.search',
481             {
482                 stat_cat => $_->{stat_cat},
483                 value => $_->{content},
484                 owner => $ancestors
485             }
486         );
487         push(@{$self->{stat_cat_entries}}, $result) if ($result);
488     }
489 }
490
491 # Standalone, "helper" functions.  These do not take an object or
492 # class reference.
493
494 # Check if a user is past their expiration date.
495 sub _expired {
496     my $user = shift;
497     my $expired = 0;
498
499     # Users might not expire.  If so, they have no expire_date.
500     if ($user->expire_date()) {
501         my $expires = DateTime::Format::ISO8601->parse_datetime(
502             cleanse_ISO8601($user->expire_date())
503         )->epoch();
504         my $now = DateTime->now()->epoch();
505         $expired = $now > $expires;
506     }
507
508     return $expired;
509 }
510
511 1;