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