d9929e9e19d4a20d6811d0fbd769033ad8ff77ad
[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::AppSession;
28 use OpenSRF::Utils qw/:datetime/;
29 use OpenSRF::Utils::SettingsClient;
30 use OpenILS::Utils::Fieldmapper;
31 use OpenILS::Utils::Normalize qw(clean_marc);
32 use OpenILS::Application::AppUtils;
33 use OpenILS::Const qw/:const/;
34 use MARC::Record;
35 use MARC::Field;
36 use MARC::File::XML;
37 use List::MoreUtils qw/uniq/;
38 use POSIX qw/strftime/;
39
40 # We need a bunch of NCIP::* objects.
41 use NCIP::Response;
42 use NCIP::Problem;
43 use NCIP::User;
44 use NCIP::User::OptionalFields;
45 use NCIP::User::AddressInformation;
46 use NCIP::User::Id;
47 use NCIP::User::BlockOrTrap;
48 use NCIP::User::Privilege;
49 use NCIP::User::PrivilegeStatus;
50 use NCIP::StructuredPersonalUserName;
51 use NCIP::StructuredAddress;
52 use NCIP::ElectronicAddress;
53 use NCIP::PhysicalAddress;
54 use NCIP::RequestId;
55 use NCIP::Item::Id;
56 use NCIP::Item::OptionalFields;
57 use NCIP::Item::BibliographicDescription;
58 use NCIP::Item::BibliographicItemId;
59 use NCIP::Item::BibliographicRecordId;
60 use NCIP::Item::Description;
61
62 # Inherit from NCIP::ILS.
63 use parent qw(NCIP::ILS);
64
65 =head1 NAME
66
67 Evergreen - Evergreen driver for NCIPServer
68
69 =head1 SYNOPSIS
70
71     my $ils = NCIP::ILS::Evergreen->new(name => $config->{NCIP.ils.value});
72
73 =head1 DESCRIPTION
74
75 NCIP::ILS::Evergreen is the default driver for Evergreen and
76 NCIPServer. It was initially developed to work with Auto-Graphics'
77 SHAREit software using a subset of an unspecified ILL/DCB profile.
78
79 =cut
80
81 # Default values we define for things that might be missing in our
82 # runtime environment or configuration file that absolutely must have
83 # values.
84 #
85 # OILS_NCIP_CONFIG_DEFAULT is the default location to find our
86 # driver's configuration file.  This location can be overridden by
87 # setting the path in the OILS_NCIP_CONFIG environment variable.
88 #
89 # BIB_SOURCE_DEFAULT is the config.bib_source.id to use when creating
90 # "short" bibs.  It is used only if no entry is supplied in the
91 # configuration file.  The provided default is 2, the id of the
92 # "System Local" source that comes with a default Evergreen
93 # installation.
94 use constant {
95     OILS_NCIP_CONFIG_DEFAULT => '/openils/conf/oils_ncip.xml',
96     BIB_SOURCE_DEFAULT => 2
97 };
98
99 # A common Evergreen code shortcut to use AppUtils:
100 my $U = 'OpenILS::Application::AppUtils';
101
102 # The usual constructor:
103 sub new {
104     my $class = shift;
105     $class = ref($class) if (ref $class);
106
107     # Instantiate our parent with the rest of the arguments.  It
108     # creates a blessed hashref.
109     my $self = $class->SUPER::new(@_);
110
111     # Look for our configuration file, load, and parse it:
112     $self->_configure();
113
114     # Bootstrap OpenSRF and prepare some OpenILS components.
115     $self->_bootstrap();
116
117     # Initialize the rest of our internal state.
118     $self->_init();
119
120     return $self;
121 }
122
123 =head1 HANDLER METHODS
124
125 =head2 lookupuser
126
127     $ils->lookupuser($request);
128
129 Processes a LookupUser request.
130
131 =cut
132
133 sub lookupuser {
134     my $self = shift;
135     my $request = shift;
136
137     # Check our session and login if necessary.
138     $self->login() unless ($self->checkauth());
139
140     my $message_type = $self->parse_request_type($request);
141
142     # Let's go ahead and create our response object. We need this even
143     # if there is a problem.
144     my $response = NCIP::Response->new({type => $message_type . "Response"});
145     $response->header($self->make_header($request));
146
147     # Need to parse the request object to get the user barcode.
148     my ($barcode, $idfield) = $self->find_user_barcode($request);
149
150     # If we did not find a barcode, then report the problem.
151     if (ref($barcode) eq 'NCIP::Problem') {
152         $response->problem($barcode);
153         return $response;
154     }
155
156     # Look up our patron by barcode:
157     my $user = $self->retrieve_user_by_barcode($barcode, $idfield);
158     if (ref($user) eq 'NCIP::Problem') {
159         $response->problem($user);
160         return $response;
161     }
162
163     # We got the information, so lets fill in our userdata.
164     my $userdata = NCIP::User->new();
165
166     # Use the user's main card as the UserId.
167     my $id = NCIP::User::Id->new({
168         UserIdentifierType => 'Barcode',
169         UserIdentifierValue => $user->card->barcode() || $barcode
170     });
171     $userdata->UserId($id);
172
173     # Check if they requested any optional fields and return those.
174     my $elements = $request->{$message_type}->{UserElementType};
175     if ($elements) {
176         $elements = [$elements] unless (ref $elements eq 'ARRAY');
177         my $optionalfields = $self->handle_user_elements($user, $elements);
178         $userdata->UserOptionalFields($optionalfields);
179     }
180
181     $response->data($userdata);
182
183     return $response;
184 }
185
186 =head2 acceptitem
187
188     $ils->acceptitem($request);
189
190 Processes an AcceptItem request.
191
192 =cut
193
194 sub acceptitem {
195     my $self = shift;
196     my $request = shift;
197
198     # Check our session and login if necessary.
199     $self->login() unless ($self->checkauth());
200
201     # Common preparation.
202     my $message = $self->parse_request_type($request);
203     my $response = NCIP::Response->new({type => $message . 'Response'});
204     $response->header($self->make_header($request));
205
206     # We only accept holds for the time being.
207     if ($request->{$message}->{RequestedActionType} =~ /^hold\W/i) {
208         # We need the item id or we can't do anything at all.
209         my ($item_barcode, $item_idfield) = $self->find_item_barcode($request);
210         if (ref($item_barcode) eq 'NCIP::Problem') {
211             $response->problem($item_barcode);
212             return $response;
213         }
214
215         # We need to find a patron barcode or we can't look anyone up
216         # to place a hold.
217         my ($user_barcode, $user_idfield) = $self->find_user_barcode($request, 'UserIdentifierValue');
218         if (ref($user_barcode) eq 'NCIP::Problem') {
219             $response->problem($user_barcode);
220             return $response;
221         }
222         # Look up our patron by barcode:
223         my $user = $self->retrieve_user_by_barcode($user_barcode, $user_idfield);
224         if (ref($user) eq 'NCIP::Problem') {
225             $response->problem($user);
226             return $response;
227         }
228         # We're doing patron checks before looking for bibliographic
229         # information and creating the item because problems with the
230         # patron are more likely to occur.
231         my $problem = $self->check_user_for_problems($user, 'HOLD');
232         if ($problem) {
233             $response->problem($problem);
234             return $response;
235         }
236
237         # Check if the item barcode already exists:
238         my $item = $self->retrieve_copy_details_by_barcode($item_barcode);
239         if ($item) {
240             # What to do here was not defined in the
241             # specification. Since the copies that we create this way
242             # should get deleted when checked in, it would be an error
243             # if we try to create another one. It means that something
244             # has gone wrong somewhere.
245             $response->problem(
246                 NCIP::Problem->new(
247                     {
248                         ProblemType => 'Duplicate Item',
249                         ProblemDetail => "Item with barcode $item_barcode already exists.",
250                         ProblemElement => $item_idfield,
251                         ProblemValue => $item_barcode
252                     }
253                 )
254             );
255             return $response;
256         }
257
258         # Now, we have to create our new copy and/or bib and call number.
259
260         # First, we have to gather the necessary information from the
261         # request.  Store in a hashref for convenience. We may write a
262         # method to get this information in the future if we find we
263         # need it in other handlers. Such a function would be a
264         # candidate to go into our parent, NCIP::ILS.
265         my $item_info = {
266             barcode => $item_barcode,
267             call_number => $request->{$message}->{ItemOptionalFields}->{ItemDescription}->{CallNumber},
268             title => $request->{$message}->{ItemOptionalFields}->{BibliographicDescription}->{Title},
269             author => $request->{$message}->{ItemOptionalFields}->{BibliographicDescription}->{Author},
270             publisher => $request->{$message}->{ItemOptionalFields}->{BibliographicDescription}->{Publisher},
271             publication_date => $request->{$message}->{ItemOptionalFields}->{BibliographicDescription}->{PublicationDate},
272             medium => $request->{$message}->{ItemOptionalFields}->{BibliographicDescription}->{MediumType},
273             electronic => $request->{$message}->{ItemOptionalFields}->{BibliographicDescription}->{ElectronicResource}
274         };
275
276         if ($self->{config}->{items}->{use_precats}) {
277             # We only need to create a precat copy.
278             $item = $self->create_precat_copy($item_info);
279         } else {
280             # We have to create a "partial" bib record, a call number and a copy.
281             $item = $self->create_fuller_copy($item_info);
282         }
283
284         # If we failed to create the copy, report a problem.
285         unless ($item) {
286             $response->problem(
287                 {
288                     ProblemType => 'Temporary Processing Failure',
289                     ProblemDetail => 'Failed to create the item in the system',
290                     ProblemElement => $item_idfield,
291                     ProblemValue => $item_barcode
292                 }
293             );
294             return $response;
295         }
296
297         # We try to find the pickup location in our database. It's OK
298         # if it does not exist, the user's home library will be used
299         # instead.
300         my $location = $self->find_location_failover($request->{$message}->{PickupLocation}, $request, $message);
301
302         # Now, we place the hold on the newly created copy on behalf
303         # of the patron retrieved above.
304         my $hold = $self->place_hold($item, $user, $location, undef, undef, 1);
305         if (ref($hold) eq 'NCIP::Problem') {
306             $response->problem($hold);
307             return $response;
308         }
309
310         # Add a hold note with the RequestIdentifierValue for later
311         # lookup in CancelRequestItem.  We do not care if it fails.
312         $self->create_hold_note($hold, 'NCIP Remote Request ID', $request->{$message}->{RequestId}->{RequestIdentifierValue});
313
314         # We return the RequestId and optionally, the ItemID. We'll
315         # just return what was sent to us, since we ignored all of it
316         # but the barcode.
317         my $data = {};
318         $data->{RequestId} = NCIP::RequestId->new(
319             {
320                 AgencyId => $request->{$message}->{RequestId}->{AgencyId},
321                 RequestIdentifierType => $request->{$message}->{RequestId}->{RequestIdentifierType},
322                 RequestIdentifierValue => $request->{$message}->{RequestId}->{RequestIdentifierValue}
323             }
324         );
325         $data->{ItemId} = NCIP::Item::Id->new(
326             {
327                 AgencyId => $request->{$message}->{ItemId}->{AgencyId},
328                 ItemIdentifierType => $request->{$message}->{ItemId}->{ItemIdentifierType},
329                 ItemIdentifierValue => $request->{$message}->{ItemId}->{ItemIdentifierValue}
330             }
331         );
332         $response->data($data);
333
334     } else {
335         my $problem = NCIP::Problem->new();
336         $problem->ProblemType('Unauthorized Combination Of Element Values For System');
337         $problem->ProblemDetail('We only support Hold For Pickup');
338         $problem->ProblemElement('RequestedActionType');
339         $problem->ProblemValue($request->{$message}->{RequestedActionType});
340         $response->problem($problem);
341     }
342
343     return $response;
344 }
345
346 =head2 checkinitem
347
348     $response = $ils->checkinitem($request);
349
350 Checks the item in if we can find the barcode in the message. It
351 returns problems if it cannot find the item in the system or if the
352 item is not checked out.
353
354 It could definitely use some more brains at some point as it does not
355 fully support everything that the standard allows. It also does not
356 really check if the checkin succeeded or not.
357
358 =cut
359
360 sub checkinitem {
361     my $self = shift;
362     my $request = shift;
363
364     # Check our session and login if necessary:
365     $self->login() unless ($self->checkauth());
366
367     # Common stuff:
368     my $message = $self->parse_request_type($request);
369     my $response = NCIP::Response->new({type => $message . 'Response'});
370     $response->header($self->make_header($request));
371
372     # We need the copy barcode from the message.
373     my ($item_barcode, $item_idfield) = $self->find_item_barcode($request);
374     if (ref($item_barcode) eq 'NCIP::Problem') {
375         $response->problem($item_barcode);
376         return $response;
377     }
378
379     # Retrieve the copy details.
380     my $details = $self->retrieve_copy_details_by_barcode($item_barcode);
381     unless ($details) {
382         # Return an Unknown Item problem unless we find the copy.
383         $response->problem(
384             NCIP::Problem->new(
385                 {
386                     ProblemType => 'Unknown Item',
387                     ProblemDetail => "Item with barcode $item_barcode is not known.",
388                     ProblemElement => $item_idfield,
389                     ProblemValue => $item_barcode
390                 }
391             )
392         );
393         return $response;
394     }
395
396     # Check if a UserId was provided. If so, this is the patron to
397     # whom the copy should be checked out.
398     my $user;
399     my ($user_barcode, $user_idfield) = $self->find_user_barcode($request);
400     # We ignore the problem, because the UserId is optional.
401     if (ref($user_barcode) ne 'NCIP::Problem') {
402         $user = $self->retrieve_user_by_barcode($user_barcode, $user_idfield);
403         # We don't ignore a problem here, however.
404         if (ref($user) eq 'NCIP::Problem') {
405             $response->problem($user);
406             return $response;
407         }
408     }
409
410     # Isolate the copy.
411     my $copy = $details->{copy};
412
413     # Look for a circulation and examine its information:
414     my $circ = $details->{circ};
415
416     # Check the circ details to see if the copy is checked out and, if
417     # the patron was provided, that it is checked out to the patron in
418     # question. We also verify the copy ownership and circulation
419     # location.
420     my $problem = $self->check_circ_details($details, $user);
421     if ($problem) {
422         # We need to fill in some information, however.
423         if (!$problem->ProblemValue() && !$problem->ProblemElement()) {
424             $problem->ProblemValue($user_barcode);
425             $problem->ProblemElement($user_idfield);
426         } elsif (!$problem->ProblemElement()) {
427             $problem->ProblemElement($item_idfield);
428         }
429         $response->problem($problem);
430         return $response;
431     }
432
433     # Checkin parameters. We want to skip hold targeting or making
434     # transits, to force the checkin despite the copy status, as
435     # well as void overdues.
436     my $params = {
437         copy_barcode => $copy->barcode(),
438         force => 1,
439         noop => 1,
440         void_overdues => 1
441     };
442     my $result = $U->simplereq(
443         'open-ils.circ',
444         'open-ils.circ.checkin.override',
445         $self->{session}->{authtoken},
446         $params
447     );
448     if (ref($result) eq 'ARRAY') {
449         $result = $result->[0];
450     }
451     if ($result->{textcode} eq 'SUCCESS') {
452         # Delete the copy. Since delete_copy checks ownership
453         # before attempting to delete the copy, we don't bother
454         # checking who owns it.
455         $self->delete_copy($copy);
456         # We need the circulation user for the information below, so we retrieve it.
457         my $circ_user = $self->retrieve_user_by_id($circ->usr());
458         my $data = {
459             ItemId => NCIP::Item::Id->new(
460                 {
461                     AgencyId => $request->{$message}->{ItemId}->{AgencyId},
462                     ItemIdentifierType => $request->{$message}->{ItemId}->{ItemIdentifierType},
463                     ItemIdentifierValue => $request->{$message}->{ItemId}->{ItemIdentifierValue}
464                 }
465             ),
466             UserId => NCIP::User::Id->new(
467                 {
468                     UserIdentifierType => 'Barcode Id',
469                     UserIdentifierValue => $circ_user->card->barcode()
470                 }
471             )
472         };
473
474         # Look for UserElements requested and add it to the response:
475         my $elements = $request->{$message}->{UserElementType};
476         if ($elements) {
477             $elements = [$elements] unless (ref $elements eq 'ARRAY');
478             my $optionalfields = $self->handle_user_elements($circ_user, $elements);
479             $data->{UserOptionalFields} = $optionalfields;
480         }
481         $elements = $request->{$message}->{ItemElementType};
482         if ($elements) {
483             $elements = [$elements] unless (ref $elements eq 'ARRAY');
484             my $optionalfields = $self->handle_item_elements($copy, $elements);
485             $data->{ItemOptionalFields} = $optionalfields;
486         }
487
488         $response->data($data);
489
490         # At some point in the future, we should probably check if
491         # they requested optional user or item elements and return
492         # those. For the time being, we ignore those at the risk of
493         # being considered non-compliant.
494     } else {
495         $response->problem(_problem_from_event('Checkin Failed', $result));
496     }
497
498     return $response
499 }
500
501 =head2 renewitem
502
503     $response = $ils->renewitem($request);
504
505 Handle the RenewItem message.
506
507 =cut
508
509 sub renewitem {
510     my $self = shift;
511     my $request = shift;
512
513     # Check our session and login if necessary:
514     $self->login() unless ($self->checkauth());
515
516     # Common stuff:
517     my $message = $self->parse_request_type($request);
518     my $response = NCIP::Response->new({type => $message . 'Response'});
519     $response->header($self->make_header($request));
520
521     # We need the copy barcode from the message.
522     my ($item_barcode, $item_idfield) = $self->find_item_barcode($request);
523     if (ref($item_barcode) eq 'NCIP::Problem') {
524         $response->problem($item_barcode);
525         return $response;
526     }
527
528     # Retrieve the copy details.
529     my $details = $self->retrieve_copy_details_by_barcode($item_barcode);
530     unless ($details) {
531         # Return an Unknown Item problem unless we find the copy.
532         $response->problem(
533             NCIP::Problem->new(
534                 {
535                     ProblemType => 'Unknown Item',
536                     ProblemDetail => "Item with barcode $item_barcode is not known.",
537                     ProblemElement => $item_idfield,
538                     ProblemValue => $item_barcode
539                 }
540             )
541         );
542         return $response;
543     }
544
545     # User is required for RenewItem.
546     my ($user_barcode, $user_idfield) = $self->find_user_barcode($request);
547     if (ref($user_barcode) eq 'NCIP::Problem') {
548         $response->problem($user_barcode);
549         return $response;
550     }
551     my $user = $self->retrieve_user_by_barcode($user_barcode, $user_idfield);
552     if (ref($user) eq 'NCIP::Problem') {
553         $response->problem($user);
554         return $response;
555     }
556
557     # Isolate the copy.
558     my $copy = $details->{copy};
559
560     # Look for a circulation and examine its information:
561     my $circ = $details->{circ};
562
563     # Check the circ details to see if the copy is checked out and, if
564     # the patron was provided, that it is checked out to the patron in
565     # question. We also verify the copy ownership and circulation
566     # location.
567     my $problem = $self->check_circ_details($details, $user);
568     if ($problem) {
569         # We need to fill in some information, however.
570         if (!$problem->ProblemValue() && !$problem->ProblemElement()) {
571             $problem->ProblemValue($user_barcode);
572             $problem->ProblemElement($user_idfield);
573         } elsif (!$problem->ProblemElement()) {
574             $problem->ProblemElement($item_idfield);
575         }
576         $response->problem($problem);
577         return $response;
578     }
579
580     # Check if user is blocked from renewals:
581     $problem = $self->check_user_for_problems($user, 'RENEW');
582     if ($problem) {
583         # Replace the ProblemElement and ProblemValue fields.
584         $problem->ProblemElement($user_idfield);
585         $problem->ProblemValue($user_barcode);
586         $response->problem($problem);
587         return $response;
588     }
589
590     # Check if the duration rule allows renewals. It should have been
591     # fleshed during the copy details retrieve.
592     my $rule = $circ->duration_rule();
593     unless (ref($rule)) {
594         $rule = $U->simplereq(
595             'open-ils.pcrud',
596             'open-ils.pcrud.retrieve.crcd',
597             $self->{session}->{authtoken},
598             $rule
599         )->gather(1);
600     }
601     if ($rule->max_renewals() < 1) {
602         $response->problem(
603             NCIP::Problem->new(
604                 {
605                     ProblemType => 'Item Not Renewable',
606                     ProblemDetail => 'Item may not be renewed.',
607                     ProblemElement => $item_idfield,
608                     ProblemValue => $item_barcode
609                 }
610             )
611         );
612         return $response;
613     }
614
615     # Check if there are renewals remaining on the latest circ:
616     if ($circ->renewal_remaining() < 1) {
617         $response->problem(
618             NCIP::Problem->new(
619                 {
620                     ProblemType => 'Maximum Renewals Exceeded',
621                     ProblemDetail => 'Renewal cannot proceed because the User has already renewed the Item the maximum number of times permitted.',
622                     ProblemElement => $item_idfield,
623                     ProblemValue => $item_barcode
624                 }
625             )
626         );
627         return $response;
628     }
629
630     # Now, we attempt the renewal. If it fails, we simply say that the
631     # user is not allowed to renew this item, without getting into
632     # details.
633     my $params = {
634         copy_id => $copy->id(),
635         patron_id => $user->id(),
636         sip_renewal => 1
637     };
638     my $r = $U->simplereq(
639         'open-ils.circ',
640         'open-ils.circ.renew.override',
641         $self->{session}->{authtoken},
642         $params
643     )->gather(1);
644
645     # We only look at the first one, since more than one usually means
646     # failure.
647     if (ref($r) eq 'ARRAY') {
648         $r = $r->[0];
649     }
650     if ($r->{textcode} ne 'SUCCESS') {
651         $problem = _problem_from_event('Renewal Failed', $r);
652         $response->problem($problem);
653     } else {
654         my $data = {
655             ItemId => NCIP::Item::Id->new(
656                 {
657                     AgencyId => $request->{$message}->{ItemId}->{AgencyId},
658                     ItemIdentifierType => $request->{$message}->{ItemId}->{ItemIdentifierType},
659                     ItemIdentifierValue => $request->{$message}->{ItemId}->{ItemIdentifierValue}
660                 }
661             ),
662             UserId => NCIP::User::Id->new(
663                 {
664                     UserIdentifierType => 'Barcode Id',
665                     UserIdentifierValue => $user->card->barcode()
666                 }
667             )
668         };
669         # We need to retrieve the copy details again to refresh our
670         # circ information to get the new due date.
671         $details = $self->retrieve_copy_details_by_barcode($item_barcode);
672         $circ = $details->{circ};
673         $data->{DateDue} = _fix_date($circ->due_date());
674
675         # Look for UserElements requested and add it to the response:
676         my $elements = $request->{$message}->{UserElementType};
677         if ($elements) {
678             $elements = [$elements] unless (ref $elements eq 'ARRAY');
679             my $optionalfields = $self->handle_user_elements($user, $elements);
680             $data->{UserOptionalFields} = $optionalfields;
681         }
682         $elements = $request->{$message}->{ItemElementType};
683         if ($elements) {
684             $elements = [$elements] unless (ref $elements eq 'ARRAY');
685             my $optionalfields = $self->handle_item_elements($details->{copy}, $elements);
686             $data->{ItemOptionalFields} = $optionalfields;
687         }
688
689         $response->data($data);
690     }
691
692     # At some point in the future, we should probably check if
693     # they requested optional user or item elements and return
694     # those. For the time being, we ignore those at the risk of
695     # being considered non-compliant.
696
697     return $response;
698 }
699
700 =head2 checkoutitem
701
702     $response = $ils->checkoutitem($request);
703
704 Handle the Checkoutitem message.
705
706 =cut
707
708 sub checkoutitem {
709     my $self = shift;
710     my $request = shift;
711
712     # Check our session and login if necessary:
713     $self->login() unless ($self->checkauth());
714
715     # Common stuff:
716     my $message = $self->parse_request_type($request);
717     my $response = NCIP::Response->new({type => $message . 'Response'});
718     $response->header($self->make_header($request));
719
720     # We need the copy barcode from the message.
721     my ($item_barcode, $item_idfield) = $self->find_item_barcode($request);
722     if (ref($item_barcode) eq 'NCIP::Problem') {
723         $response->problem($item_barcode);
724         return $response;
725     }
726
727     # Retrieve the copy details.
728     my $details = $self->retrieve_copy_details_by_barcode($item_barcode);
729     unless ($details) {
730         # Return an Unknown Item problem unless we find the copy.
731         $response->problem(
732             NCIP::Problem->new(
733                 {
734                     ProblemType => 'Unknown Item',
735                     ProblemDetail => "Item with barcode $item_barcode is not known.",
736                     ProblemElement => $item_idfield,
737                     ProblemValue => $item_barcode
738                 }
739             )
740         );
741         return $response;
742     }
743
744     # User is required for CheckOutItem.
745     my ($user_barcode, $user_idfield) = $self->find_user_barcode($request);
746     if (ref($user_barcode) eq 'NCIP::Problem') {
747         $response->problem($user_barcode);
748         return $response;
749     }
750     my $user = $self->retrieve_user_by_barcode($user_barcode, $user_idfield);
751     if (ref($user) eq 'NCIP::Problem') {
752         $response->problem($user);
753         return $response;
754     }
755
756     # Isolate the copy.
757     my $copy = $details->{copy};
758
759     # Check if the copy can circulate.
760     unless ($self->copy_can_circulate($copy)) {
761         $response->problem(
762             NCIP::Problem->new(
763                 {
764                     ProblemType => 'Item Does Not Circulate',
765                     ProblemDetail => "Item with barcode $item_barcode does not circulate.",
766                     ProblemElement => $item_idfield,
767                     ProblemValue => $item_barcode
768                 }
769             )
770         );
771         return $response;
772     }
773
774     # Look for a circulation and examine its information:
775     my $circ = $details->{circ};
776
777     # Check if the item is already checked out.
778     if ($circ && !$circ->checkin_time()) {
779         $response->problem(
780             NCIP::Problem->new(
781                 {
782                     ProblemType => 'Item Already Checked Out',
783                     ProblemDetail => "Item with barcode $item_barcode is already checked out.",
784                     ProblemElement => $item_idfield,
785                     ProblemValue => $item_barcode
786                 }
787             )
788         );
789         return $response;
790     }
791
792     # Check if user is blocked from circulation:
793     my $problem = $self->check_user_for_problems($user, 'CIRC');
794     if ($problem) {
795         # Replace the ProblemElement and ProblemValue fields.
796         $problem->ProblemElement($user_idfield);
797         $problem->ProblemValue($user_barcode);
798         $response->problem($problem);
799         return $response;
800     }
801
802     # Check for the copy being in transit and receive or abort it.
803     my $transit = $U->simplereq(
804         'open-ils.circ',
805         'open-ils.circ.open_copy_transit.retrieve',
806         $self->{session}->{authtoken},
807         $copy->id()
808     );
809     if (ref($transit) eq 'Fieldmapper::action::transit_copy') {
810         if ($transit->dest() == $self->{session}->{work_ou}->id()) {
811             my $r = $U->simplereq(
812                 'open-ils.circ',
813                 'open-ils.circ.copy_transit.receive',
814                 $self->{session}->{authtoken},
815                 {copyid => $copy->id()}
816             );
817         } elsif ($transit->source() == $self->{session}->{work_ou}->id()) {
818             my $r = $U->simplereq(
819                 'open-ils.circ',
820                 'open-ils.circ.transit.abort',
821                 $self->{session}->{authtoken},
822                 {copyid => $copy->id()}
823             );
824         }
825     }
826
827     # Now, we attempt the check out. If it fails, we simply say that
828     # the user is not allowed to check out this item, without getting
829     # into details.
830     my $params = {
831         copy_id => $copy->id(),
832         patron_id => $user->id(),
833     };
834     my $r = $U->simplereq(
835         'open-ils.circ',
836         'open-ils.circ.checkout.full.override',
837         $self->{session}->{authtoken},
838         $params
839     );
840
841     # We only look at the first one, since more than one usually means
842     # failure.
843     if (ref($r) eq 'ARRAY') {
844         $r = $r->[0];
845     }
846     if ($r->{textcode} ne 'SUCCESS') {
847         $problem = _problem_from_event('Check Out Failed', $r);
848         $response->problem($problem);
849     } else {
850         my $data = {
851             ItemId => NCIP::Item::Id->new(
852                 {
853                     AgencyId => $request->{$message}->{ItemId}->{AgencyId},
854                     ItemIdentifierType => $request->{$message}->{ItemId}->{ItemIdentifierType},
855                     ItemIdentifierValue => $request->{$message}->{ItemId}->{ItemIdentifierValue}
856                 }
857             ),
858             UserId => NCIP::User::Id->new(
859                 {
860                     UserIdentifierType => 'Barcode Id',
861                     UserIdentifierValue => $user->card->barcode()
862                 }
863             )
864         };
865         # We need to retrieve the copy details again to refresh our
866         # circ information to get the due date.
867         $details = $self->retrieve_copy_details_by_barcode($item_barcode);
868         $circ = $details->{circ};
869         $data->{DateDue} = _fix_date($circ->due_date());
870
871         # Look for UserElements requested and add it to the response:
872         my $elements = $request->{$message}->{UserElementType};
873         if ($elements) {
874             $elements = [$elements] unless (ref $elements eq 'ARRAY');
875             my $optionalfields = $self->handle_user_elements($user, $elements);
876             $data->{UserOptionalFields} = $optionalfields;
877         }
878         $elements = $request->{$message}->{ItemElementType};
879         if ($elements) {
880             $elements = [$elements] unless (ref $elements eq 'ARRAY');
881             my $optionalfields = $self->handle_item_elements($details->{copy}, $elements);
882             $data->{ItemOptionalFields} = $optionalfields;
883         }
884
885         $response->data($data);
886     }
887
888     # At some point in the future, we should probably check if
889     # they requested optional user or item elements and return
890     # those. For the time being, we ignore those at the risk of
891     # being considered non-compliant.
892
893     return $response;
894 }
895
896 =head2 requestitem
897
898     $response = $ils->requestitem($request);
899
900 Handle the NCIP RequestItem message.
901
902 =cut
903
904 sub requestitem {
905     my $self = shift;
906     my $request = shift;
907     # Check our session and login if necessary:
908     $self->login() unless ($self->checkauth());
909
910     # Common stuff:
911     my $message = $self->parse_request_type($request);
912     my $response = NCIP::Response->new({type => $message . 'Response'});
913     $response->header($self->make_header($request));
914
915     # Because we need to have a user to place a hold, because the user
916     # is likely to have problems, and because getting the item
917     # information for the hold is trickier than getting the user
918     # information, we'll do the user first and short circuit out of
919     # the function if there is a problem with the user.
920     my ($user_barcode, $user_idfield) = $self->find_user_barcode($request);
921     if (ref($user_barcode) eq 'NCIP::Problem') {
922         $response->problem($user_barcode);
923         return $response;
924     }
925     my $user = $self->retrieve_user_by_barcode($user_barcode, $user_idfield);
926     if (ref($user) eq 'NCIP::Problem') {
927         $response->problem($user);
928         return $response;
929     }
930     my $problem = $self->check_user_for_problems($user, 'HOLD');
931     if ($problem) {
932         $response->problem($problem);
933         return $response;
934     }
935
936     # Auto-Graphics send a single BibliographicRecordId to identify
937     # the "item" to place on hold.
938     my $bibid;
939     if ($request->{$message}->{BibliographicId}) {
940         my $idxml = $request->{$message}->{BibliographicId};
941         # The standard allows more than 1.  If that hapens, we only
942         # use the first.
943         $idxml = $idxml->[0] if (ref($idxml) eq 'ARRAY');
944         if ($idxml->{BibliographicRecordId}) {
945             $bibid = NCIP::Item::BibliographicRecordId->new(
946                 $idxml->{BibliographicRecordId}
947             );
948         }
949     }
950     unless ($bibid && $bibid->{BibliographicRecordIdentifier}) {
951         $problem = NCIP::Problem->new(
952             {
953                 ProblemType => 'Needed Data Missing',
954                 ProblemDetail => 'Need BibliographicRecordIdentifier to place request',
955                 ProblemElement => 'BibliographicRecordIdentifier',
956                 ProblemValue => 'NULL'
957             }
958         );
959         $response->problem($problem);
960         return $response;
961     }
962
963     # We need an actual bre.
964     my $bre = $self->retrieve_biblio_record_entry($bibid->{BibliographicRecordIdentifier});
965     if (!$bre || $U->is_true($bre->deleted())) {
966         $problem = NCIP::Problem->new(
967             {
968                 ProblemType => 'Unknown Item',
969                 ProblemDetail => 'Item ' . $bibid->{BibliographicRecordIdentifier} . ' is unknown',
970                 ProblemElement => 'BibliographicRecordIdentifier',
971                 ProblemValue => $bibid->{BibliographicRecordIdentifier}
972             }
973         );
974         $response->problem($problem);
975         return $response;
976     }
977
978     # Auto-Graphics expects us to limit the selection ou for the hold
979     # to a given library.  We look fo that in the AgencyId of the
980     # BibliographRecordId or in the ToAgencyId of the main message.
981     my $selection_ou = $self->find_location_failover($bibid->{AgencyId}, $request, $message);
982     unless ($selection_ou) {
983         $problem = NCIP::Problem->new(
984             {
985                 ProblemType => 'Unknown Agency',
986                 ProblemDetail => 'Agency is not known',
987                 ProblemElement => 'BibliographicRecordIdentifier',
988                 ProblemValue => $bibid->{AgencyId} || $request->{$message}->{InitiationHeader}->{ToAgencyId}->{AgencyId}
989             }
990         );
991         $response->problem($problem);
992         return $response;
993     }
994
995     # See if we were given a pickup location.
996     my $pickup_ou;
997     if ($request->{$message}->{PickupLocation}) {
998         my $loc = $request->{$message}->{PickupLocation};
999         $loc =~ s/^.*://;
1000         $pickup_ou = $self->retrieve_org_unit_by_shortname($loc);
1001     }
1002
1003     # Look for a NeedBeforeDate to set the expiration.
1004     my $expiration = $request->{$message}->{NeedBeforeDate};
1005
1006     # Place the hold:
1007     my $hold = $self->place_hold($bre, $user, $pickup_ou, $expiration, $selection_ou);
1008     if (ref($hold) eq 'NCIP::Problem') {
1009         $response->problem($hold);
1010     } else {
1011         # Add a hold note with the RequestIdentifierValue for later
1012         # lookup in CancelRequestItem.  We do not care if it fails.
1013         $self->create_hold_note($hold, 'NCIP Remote Request ID', $request->{$message}->{RequestId}->{RequestIdentifierValue});
1014         my $data = {
1015             RequestId => NCIP::RequestId->new(
1016                 $request->{$message}->{RequestId}
1017             ),
1018             ItemId => NCIP::Item::Id->new(
1019                 {
1020                     AgencyId => $selection_ou->shortname(),
1021                     ItemIdentifierValue => $bre->id(),
1022                     ItemIdentifierType => 'SYSNUMBER'
1023                 }
1024             ),
1025             UserId => NCIP::User::Id->new(
1026                 {
1027                     UserIdentifierValue => $user->card->barcode(),
1028                     UserIdentifierType => 'Barcode Id'
1029                 }
1030             ),
1031             RequestType => $request->{$message}->{RequestType},
1032             RequestScopeType => $request->{$message}->{RequestScopeType},
1033         };
1034
1035         # Look for UserElements requested and add it to the response:
1036         my $elements = $request->{$message}->{UserElementType};
1037         if ($elements) {
1038             $elements = [$elements] unless (ref $elements eq 'ARRAY');
1039             my $optionalfields = $self->handle_user_elements($user, $elements);
1040             $data->{UserOptionalFields} = $optionalfields;
1041         }
1042         $elements = $request->{$message}->{ItemElementType};
1043         if ($elements && $hold->current_copy()) {
1044             my $copy_details = $self->retrieve_copy_details_by_id($hold->current_copy());
1045             $elements = [$elements] unless (ref($elements) eq 'ARRAY');
1046             my $optionalfields = $self->handle_item_elements($copy_details->{copy}, $elements);
1047             $data->{ItemOptionalFields} = $optionalfields;
1048         }
1049
1050         $response->data($data);
1051     }
1052
1053     return $response;
1054 }
1055
1056 =head2 cancelrequestitem
1057
1058     $response = $ils->cancelrequestitem($request);
1059
1060 Handle the NCIP CancelRequestItem message.
1061
1062 =cut
1063
1064 sub cancelrequestitem {
1065     my $self = shift;
1066     my $request = shift;
1067     # Check our session and login if necessary:
1068     $self->login() unless ($self->checkauth());
1069
1070     # Common stuff:
1071     my $message = $self->parse_request_type($request);
1072     my $response = NCIP::Response->new({type => $message . 'Response'});
1073     $response->header($self->make_header($request));
1074
1075     # UserId is required by the standard, but we might not really need it.
1076     my ($user_barcode, $user_idfield) = $self->find_user_barcode($request);
1077     if (ref($user_barcode) eq 'NCIP::Problem') {
1078         $response->problem($user_barcode);
1079         return $response;
1080     }
1081     my $user = $self->retrieve_user_by_barcode($user_barcode, $user_idfield);
1082     if (ref($user) eq 'NCIP::Problem') {
1083         $response->problem($user);
1084         return $response;
1085     }
1086
1087     # First, let's see if we can find the hold via the RequestId's
1088     # RequestIdentifierValue.  If not, we fall back on the ItemId.
1089     my $hold = $self->find_hold_via_note('NCIP Remote Request ID', $request->{$message}->{RequestId}->{RequestIdentifierValue});
1090
1091     unless ($hold) {
1092         my $item_id = $request->{$message}->{ItemId};
1093         if ($item_id) {
1094             my $idvalue = $item_id->{ItemIdentifierValue};
1095             my $itemagy = $item_id->{AgencyId};
1096             my $selection_ou = $self->find_location_failover($itemagy, $request, $message);
1097             unless ($selection_ou) {
1098                 my $problem = NCIP::Problem->new(
1099                     {
1100                         ProblemType => 'Unknown Agency',
1101                         ProblemDetail => 'Agency is not known',
1102                         ProblemElement => 'AgencyId',
1103                         ProblemValue => $item_id->{AgencyId} || $request->{$message}->{InitiationHeader}->{ToAgencyId}->{AgencyId}
1104                     }
1105                 );
1106                 $response->problem($problem);
1107                 return $response;
1108             }
1109
1110             # We should support looking up holds by barcode, since we still
1111             # support placing them by barcode, but that is not how it is going
1112             # to work with Auto-Graphics, apparently.  I'll leave the
1113             # reimplementation of that for a future enhancement.
1114
1115             # See if we can find the hold:
1116             my $hold = $self->_hold_search($user, $idvalue, $selection_ou);
1117         }
1118     }
1119
1120     if ($hold) {
1121         # If there is a transit, abort it.  NOTE: We do this before
1122         # canceling to avoid negative consequences of retargeting and
1123         # in case the reset of the hold done by the transit abort ever
1124         # messes with cancel_time, etc.
1125         if ($hold->transit() && $self->{abort_transit_on_hold_cancel}) {
1126             $self->abort_transit($hold->transit());
1127         }
1128         my $result = $self->cancel_hold($hold);
1129         if (ref($result)) {
1130             $response->problem(_problem_from_event("Temporary Processing Failure", $result));
1131         } else {
1132             my $data = {
1133                 RequestId => NCIP::RequestId->new(
1134                     {
1135                         AgencyId => $request->{$message}->{RequestId}->{AgencyId},
1136                         RequestIdentifierType => $request->{$message}->{RequestId}->{RequestIdentifierType},
1137                         RequestIdentifierValue => $request->{$message}->{RequestId}->{RequestIdentifierValue}
1138                     }
1139                 ),
1140                 UserId => NCIP::User::Id->new(
1141                     {
1142                         UserIdentifierType => 'Barcode Id',
1143                         UserIdentifierValue => $user->card->barcode()
1144                     }
1145                 ),
1146                 ItemId => NCIP::Item::Id->new(
1147                     {
1148                         AgencyId => $request->{$message}->{ItemId}->{AgencyId},
1149                         ItemIdentifierType => $request->{$message}->{ItemId}->{ItemIdentifierType},
1150                         ItemIdentifierValue => $request->{$message}->{ItemId}->{ItemIdentifierValue}
1151                     }
1152                 )
1153             };
1154             # Look for UserElements requested and add it to the response:
1155             my $elements = $request->{$message}->{UserElementType};
1156             if ($elements) {
1157                 $elements = [$elements] unless (ref $elements eq 'ARRAY');
1158                 my $optionalfields = $self->handle_user_elements($user, $elements);
1159                 $data->{UserOptionalFields} = $optionalfields;
1160             }
1161             $elements = $request->{$message}->{ItemElementType};
1162             if ($elements && $hold->current_copy()) {
1163                 $elements = [$elements] unless (ref $elements eq 'ARRAY');
1164                 my $copy_details = $self->retrieve_copy_details_by_id($hold->current_copy());
1165                 if ($copy_details) {
1166                     my $optionalfields = $self->handle_item_elements($copy_details->{copy}, $elements);
1167                     $data->{ItemOptionalFields} = $optionalfields;
1168                 }
1169             }
1170             $response->data($data);
1171         }
1172     } else {
1173         $response->problem(
1174             NCIP::Problem->new(
1175                 {
1176                     ProblemType => 'Unknown Request',
1177                     ProblemDetail => 'No request found for the item and user',
1178                     ProblemElement => 'NULL',
1179                     ProblemValue => 'NULL'
1180                 }
1181             )
1182         )
1183     }
1184
1185     return $response;
1186 }
1187
1188 =head1 METHODS USEFUL to SUBCLASSES
1189
1190 =head2 handle_user_elements
1191     $useroptionalfield = $ils->handle_user_elements($user, $elements);
1192
1193 Returns NCIP::User::OptionalFields for the given user and arrayref of
1194 UserElement.
1195
1196 =cut
1197
1198 sub handle_user_elements {
1199     my $self = shift;
1200     my $user = shift;
1201     my $elements = shift;
1202     my $optionalfields = NCIP::User::OptionalFields->new();
1203
1204     # First, we'll look for name information.
1205     if (grep {$_ eq 'Name Information'} @$elements) {
1206         my $name = NCIP::StructuredPersonalUserName->new();
1207         $name->Surname($user->family_name());
1208         $name->GivenName($user->first_given_name());
1209         $name->Prefix($user->prefix());
1210         $name->Suffix($user->suffix());
1211         $optionalfields->NameInformation($name);
1212     }
1213
1214     # Next, check for user address information.
1215     if (grep {$_ eq 'User Address Information'} @$elements) {
1216         my $addresses = [];
1217
1218         # See if the user has any valid, physcial addresses.
1219         foreach my $addr (@{$user->addresses()}) {
1220             next if ($U->is_true($addr->pending()));
1221             my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>$addr->address_type()});
1222             my $structured = NCIP::StructuredAddress->new();
1223             $structured->Line1($addr->street1());
1224             $structured->Line2($addr->street2());
1225             $structured->Locality($addr->city());
1226             $structured->Region($addr->state());
1227             $structured->PostalCode($addr->post_code());
1228             $structured->Country($addr->country());
1229             $address->PhysicalAddress(
1230                 NCIP::PhysicalAddress->new(
1231                     {
1232                         StructuredAddress => $structured,
1233                         Type => 'Postal Address'
1234                     }
1235                 )
1236             );
1237             push @$addresses, $address;
1238         }
1239
1240         # Right now, we're only sharing email address if the user
1241         # has it.
1242         if ($user->email()) {
1243             my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>'Email Address'});
1244             $address->ElectronicAddress(
1245                 NCIP::ElectronicAddress->new({
1246                     Type=>'mailto',
1247                     Data=>$user->email()
1248                 })
1249                 );
1250             push @$addresses, $address;
1251         }
1252         # Auto-graphics asked for the phone numbers.
1253         if ($user->day_phone()) {
1254             my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>'Day Phone'});
1255             $address->ElectronicAddress(
1256                 NCIP::ElectronicAddress->new(
1257                     {
1258                         Type=>'Day Phone',
1259                         Data=>$user->day_phone()
1260                     }
1261                 )
1262             );
1263             push @$addresses, $address;
1264         }
1265         if ($user->evening_phone()) {
1266             my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>'Evening Phone'});
1267             $address->ElectronicAddress(
1268                 NCIP::ElectronicAddress->new(
1269                     {
1270                         Type=>'Evening Phone',
1271                         Data=>$user->evening_phone()
1272                     }
1273                 )
1274             );
1275             push @$addresses, $address;
1276         }
1277         if ($user->other_phone()) {
1278             my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>'Other Phone'});
1279             $address->ElectronicAddress(
1280                 NCIP::ElectronicAddress->new(
1281                     {
1282                         Type=>'Other Phone',
1283                         Data=>$user->other_phone()
1284                     }
1285                 )
1286             );
1287             push @$addresses, $address;
1288         }
1289
1290         $optionalfields->UserAddressInformation($addresses);
1291     }
1292
1293     # Check for User Privilege.
1294     if (grep {$_ eq 'User Privilege'} @$elements) {
1295         # Get the user's group:
1296         my $pgt = $U->simplereq(
1297             'open-ils.pcrud',
1298             'open-ils.pcrud.retrieve.pgt',
1299             $self->{session}->{authtoken},
1300             $user->profile()
1301         );
1302         if ($pgt) {
1303             my $privilege = NCIP::User::Privilege->new();
1304             $privilege->AgencyId($user->home_ou->shortname());
1305             $privilege->AgencyUserPrivilegeType($pgt->name());
1306             $privilege->ValidToDate(_fix_date($user->expire_date()));
1307             $privilege->ValidFromDate(_fix_date($user->create_date()));
1308
1309             my $status = 'Active';
1310             if (_expired($user)) {
1311                 $status = 'Expired';
1312             } elsif ($U->is_true($user->barred())) {
1313                 $status = 'Barred';
1314             } elsif (!$U->is_true($user->active())) {
1315                 $status = 'Inactive';
1316             }
1317             if ($status) {
1318                 $privilege->UserPrivilegeStatus(
1319                     NCIP::User::PrivilegeStatus->new({
1320                         UserPrivilegeStatusType => $status
1321                     })
1322                 );
1323             }
1324
1325             $optionalfields->UserPrivilege([$privilege]);
1326         }
1327     }
1328
1329     # Check for Block Or Trap.
1330     if (grep {$_ eq 'Block Or Trap'} @$elements) {
1331         my $blocks = [];
1332
1333         # First, let's check if the profile is blocked from ILL.
1334         if (grep {$_->id() == $user->profile()} @{$self->{blocked_profiles}}) {
1335             my $block = NCIP::User::BlockOrTrap->new();
1336             $block->AgencyId($user->home_ou->shortname());
1337             $block->BlockOrTrapType('Block Interlibrary Loan');
1338             push @$blocks, $block;
1339         }
1340
1341         # Next, we loop through the user's standing penalties
1342         # looking for blocks on CIRC, HOLD, and RENEW.
1343         my ($have_circ, $have_renew, $have_hold) = (0,0,0);
1344         foreach my $penalty (@{$user->standing_penalties()}) {
1345             next unless($penalty->standing_penalty->block_list());
1346             my @block_list = split(/\|/, $penalty->standing_penalty->block_list());
1347             my $ou = $U->simplereq(
1348                 'open-ils.pcrud',
1349                 'open-ils.pcrud.retrieve.aou',
1350                 $self->{session}->{authtoken},
1351                 $penalty->org_unit()
1352             );
1353
1354             # Block checkout.
1355             if (!$have_circ && grep {$_ eq 'CIRC'} @block_list) {
1356                 my $bot = NCIP::User::BlockOrTrap->new();
1357                 $bot->AgencyId($ou->shortname());
1358                 $bot->BlockOrTrapType('Block Checkout');
1359                 push @$blocks, $bot;
1360                 $have_circ = 1;
1361             }
1362
1363             # Block holds.
1364             if (!$have_hold && grep {$_ eq 'HOLD' || $_ eq 'FULFILL'} @block_list) {
1365                 my $bot = NCIP::User::BlockOrTrap->new();
1366                 $bot->AgencyId($ou->shortname());
1367                 $bot->BlockOrTrapType('Block Holds');
1368                 push @$blocks, $bot;
1369                 $have_hold = 1;
1370             }
1371
1372             # Block renewals.
1373             if (!$have_renew && grep {$_ eq 'RENEW'} @block_list) {
1374                 my $bot = NCIP::User::BlockOrTrap->new();
1375                 $bot->AgencyId($ou->shortname());
1376                 $bot->BlockOrTrapType('Block Renewals');
1377                 push @$blocks, $bot;
1378                 $have_renew = 1;
1379             }
1380
1381             # Stop after we report one of each, even if more
1382             # blocks remain.
1383             last if ($have_circ && $have_renew && $have_hold);
1384         }
1385
1386         $optionalfields->BlockOrTrap($blocks);
1387     }
1388
1389     return $optionalfields;
1390 }
1391
1392 =head2 handle_item_elements
1393
1394 =cut
1395
1396 sub handle_item_elements {
1397     my $self = shift;
1398     my $copy = shift;
1399     my $elements = shift;
1400     my $optionalfields = NCIP::Item::OptionalFields->new();
1401
1402     my $details; # In case we need for more than one.
1403
1404     if (grep {$_ eq 'Bibliographic Description'} @$elements) {
1405         my $description;
1406         # Check for a precat copy, 'cause it is simple.
1407         if ($copy->dummy_title()) {
1408             $description = NCIP::Item::BibliographicDescription->new();
1409             $description->Title($copy->dummy_title());
1410             $description->Author($copy->dummy_author());
1411             if ($copy->dummy_isbn()) {
1412                 $description->BibliographicItemId(
1413                     NCIP::Item::BibliographicItemId->new(
1414                         {
1415                             BibliographicItemIdentifier => $copy->dummy_isbn(),
1416                             BibliographicItemIdentifierCode => 'ISBN'
1417                         }
1418                     )
1419                 );
1420             }
1421         } else {
1422             $details = $self->retrieve_copy_details_by_barcode($copy->barcode()) unless($details);
1423             $description = NCIP::Item::BibliographicDescription->new();
1424             $description->Title($details->{mvr}->title());
1425             $description->Author($details->{mvr}->author());
1426             $description->BibliographicRecordId(
1427                 NCIP::Item::BibliographicRecordId->new(
1428                     {
1429                         BibliographicRecordIdentifier => $details->{mvr}->doc_id(),
1430                         BibliographicRecordIdentifierCode => 'SYSNUMBER'
1431                     }
1432                 )
1433             );
1434             if ($details->{mvr}->publisher()) {
1435                 $description->Publisher($details->{mvr}->publisher());
1436             }
1437             if ($details->{mvr}->pubdate()) {
1438                 $description->PublicationDate($details->{mvr}->pubdate());
1439             }
1440             if ($details->{mvr}->edition()) {
1441                 $description->Edition($details->{mvr}->edition());
1442             }
1443         }
1444         $optionalfields->BibliographicDescription($description) if ($description);
1445     }
1446
1447     if (grep {$_ eq 'Item Description'} @$elements) {
1448         $details = $self->retrieve_copy_details_by_barcode($copy->barcode()) unless($details);
1449         # Call Number is the only field we currently return. We also
1450         # do not attempt to retun a prefix and suffix. Someone else
1451         # can deal with that if they want it.
1452         if ($details->{volume}) {
1453             $optionalfields->ItemDescription(
1454                 NCIP::Item::Description->new(
1455                     {CallNumber => $details->{volume}->label()}
1456                 )
1457             );
1458         }
1459     }
1460
1461     if (grep {$_ eq 'Circulation Status'} @$elements) {
1462         my $status = $copy->status();
1463         $status = $self->retrieve_copy_status($status) unless (ref($status));
1464         $optionalfields->CirculationStatus($status->name()) if ($status);
1465     }
1466
1467     if (grep {$_ eq 'Date Due'} @$elements) {
1468         $details = $self->retrieve_copy_details_by_barcode($copy->barcode()) unless($details);
1469         if ($details->{circ}) {
1470             if (!$details->{circ}->checkin_time()) {
1471                 $optionalfields->DateDue(_fix_date($details->{circ}->due_date()));
1472             }
1473         }
1474     }
1475
1476     if (grep {$_ eq 'Item Use Restriction Type'} @$elements) {
1477         $optionalfields->ItemUseRestrictionType('None');
1478     }
1479
1480     if (grep {$_ eq 'Physical Condition'} @$elements) {
1481         $optionalfields->PhysicalCondition(
1482             NCIP::Item::PhysicalCondition->new(
1483                 {PhysicalConditionType => 'Unknown'}
1484             )
1485         );
1486     }
1487
1488     return $optionalfields;
1489 }
1490
1491 =head2 login
1492
1493     $ils->login();
1494
1495 Login to Evergreen via OpenSRF. It uses internal state from the
1496 configuration file to login.
1497
1498 =cut
1499
1500 # Login via OpenSRF to Evergreen.
1501 sub login {
1502     my $self = shift;
1503
1504     # Get the authentication seed.
1505     my $seed = $U->simplereq(
1506         'open-ils.auth',
1507         'open-ils.auth.authenticate.init',
1508         $self->{config}->{credentials}->{username}
1509     );
1510
1511     # Actually login.
1512     if ($seed) {
1513         my $response = $U->simplereq(
1514             'open-ils.auth',
1515             'open-ils.auth.authenticate.complete',
1516             {
1517                 username => $self->{config}->{credentials}->{username},
1518                 password => md5_hex(
1519                     $seed . md5_hex($self->{config}->{credentials}->{password})
1520                 ),
1521                 type => 'staff',
1522                 workstation => $self->{config}->{credentials}->{workstation}
1523             }
1524         );
1525         if ($response) {
1526             $self->{session}->{authtoken} = $response->{payload}->{authtoken};
1527             $self->{session}->{authtime} = $response->{payload}->{authtime};
1528
1529             # Set/reset the work_ou and user data in case something changed.
1530
1531             # Retrieve the work_ou as an object.
1532             $self->{session}->{work_ou} = $U->simplereq(
1533                 'open-ils.pcrud',
1534                 'open-ils.pcrud.search.aou',
1535                 $self->{session}->{authtoken},
1536                 {shortname => $self->{config}->{credentials}->{work_ou}}
1537             );
1538
1539             # We need the user information in order to do some things.
1540             $self->{session}->{user} = $U->check_user_session($self->{session}->{authtoken});
1541
1542         }
1543     }
1544 }
1545
1546 =head2 checkauth
1547
1548     $valid = $ils->checkauth();
1549
1550 Returns 1 if the object a 'valid' authtoken, 0 if not.
1551
1552 =cut
1553
1554 sub checkauth {
1555     my $self = shift;
1556
1557     # We use AppUtils to do the heavy lifting.
1558     if (defined($self->{session})) {
1559         if ($U->check_user_session($self->{session}->{authtoken})) {
1560             return 1;
1561         } else {
1562             return 0;
1563         }
1564     }
1565
1566     # If we reach here, we don't have a session, so we are definitely
1567     # not logged in.
1568     return 0;
1569 }
1570
1571 =head2 retrieve_user_by_barcode
1572
1573     $user = $ils->retrieve_user_by_barcode($user_barcode, $user_idfield);
1574
1575 Do a fleshed retrieve of a patron by barcode. Return the patron if
1576 found and valid. Return a NCIP::Problem of 'Unknown User' otherwise.
1577
1578 The id field argument is used for the ProblemElement field in the
1579 NCIP::Problem object.
1580
1581 An invalid patron is one where the barcode is not found in the
1582 database, the patron is deleted, or the barcode used to retrieve the
1583 patron is not active. The problem element is also returned if an error
1584 occurs during the retrieval.
1585
1586 =cut
1587
1588 sub retrieve_user_by_barcode {
1589     my ($self, $barcode, $idfield) = @_;
1590     my $result = $U->simplereq(
1591         'open-ils.actor',
1592         'open-ils.actor.user.fleshed.retrieve_by_barcode',
1593         $self->{session}->{authtoken},
1594         $barcode,
1595         1
1596     );
1597
1598     # Check for a failure, or a deleted, inactive, or expired user,
1599     # and if so, return empty userdata.
1600     if (!$result || $U->event_code($result) || $U->is_true($result->deleted())
1601             || !grep {$_->barcode() eq $barcode && $U->is_true($_->active())} @{$result->cards()}) {
1602
1603         my $problem = NCIP::Problem->new();
1604         $problem->ProblemType('Unknown User');
1605         $problem->ProblemDetail("User with barcode $barcode unknown");
1606         $problem->ProblemElement($idfield);
1607         $problem->ProblemValue($barcode);
1608         $result = $problem;
1609     }
1610
1611     return $result;
1612 }
1613
1614 =head2 retrieve_user_by_id
1615
1616     $user = $ils->retrieve_user_by_id($id);
1617
1618 Similar to C<retrieve_user_by_barcode> but takes the user's database
1619 id rather than barcode. This is useful when you have a circulation or
1620 hold and need to get information about the user's involved in the hold
1621 or circulaiton.
1622
1623 It returns a fleshed user on success or undef on failure.
1624
1625 =cut
1626
1627 sub retrieve_user_by_id {
1628     my ($self, $id) = @_;
1629
1630     # Do a fleshed retrieve of the patron, and flesh the fields that
1631     # we would normally use.
1632     my $result = $U->simplereq(
1633         'open-ils.actor',
1634         'open-ils.actor.user.fleshed.retrieve',
1635         $self->{session}->{authtoken},
1636         $id,
1637         [ 'card', 'cards', 'standing_penalties', 'addresses', 'home_ou', 'settings' ]
1638     );
1639     # Check for an error.
1640     undef($result) if ($result && $U->event_code($result));
1641
1642     return $result;
1643 }
1644
1645 =head2 check_user_for_problems
1646
1647     $problem = $ils>check_user_for_problems($user, 'HOLD, 'CIRC', 'RENEW');
1648
1649 This function checks if a user has a blocked profile or any from a
1650 list of provided blocks. If it does, then a NCIP::Problem object is
1651 returned, otherwise an undefined value is returned.
1652
1653 The list of blocks appears as additional arguments after the user. You
1654 can provide any value(s) that might appear in a standing penalty block
1655 lit in Evergreen. The example above checks for HOLD, CIRC, and
1656 RENEW. Any number of such values can be provided. If none are
1657 provided, the function only checks if the patron's profiles appears in
1658 the object's blocked profiles list.
1659
1660 It stops on the first matching block, if any.
1661
1662 =cut
1663
1664 sub check_user_for_problems {
1665     my $self = shift;
1666     my $user = shift;
1667     my @blocks = @_;
1668
1669     # Fill this in if we have a problem, otherwise just return it.
1670     my $problem;
1671
1672     # First, check the user's profile.
1673     if (grep {$_->id() == $user->profile()} @{$self->{blocked_profiles}}) {
1674         $problem = NCIP::Problem->new(
1675             {
1676                 ProblemType => 'User Blocked',
1677                 ProblemDetail => 'User blocked from inter-library loan',
1678                 ProblemElement => 'NULL',
1679                 ProblemValue => 'NULL'
1680             }
1681         );
1682     }
1683
1684     # Next, check if the patron has one of the indicated blocks.
1685     unless ($problem) {
1686         foreach my $penalty (@{$user->standing_penalties()}) {
1687             if ($penalty->standing_penalty->block_list()) {
1688                 my @pblocks = split(/\|/, $penalty->standing_penalty->block_list());
1689                 foreach my $block (@blocks) {
1690                     if (grep {$_ =~ /$block/} @pblocks) {
1691                         $problem = NCIP::Problem->new(
1692                             {
1693                                 ProblemType => 'User Blocked',
1694                                 ProblemDetail => 'User blocked from ' .
1695                                     ($block eq 'HOLD') ? 'holds' : (($block eq 'RENEW') ? 'renewals' :
1696                                                                         (($block eq 'CIRC') ? 'checkout' : lc($block))),
1697                                 ProblemElement => 'NULL',
1698                                 ProblemValue => 'NULL'
1699                             }
1700                         );
1701                         last;
1702                     }
1703                 }
1704                 last if ($problem);
1705             }
1706         }
1707     }
1708
1709     return $problem;
1710 }
1711
1712 =head2 check_circ_details
1713
1714     $problem = $ils->check_circ_details($details, $user);
1715
1716 Checks if we can checkin or renew a circulation. That is, the
1717 circulation is still open (i.e. the copy is still checked out), if we
1718 either own the copy or are the circulation location, and if the
1719 circulation is for the optional $user argument. The $details argument
1720 is required and comes from the retrieve_copy_details call. $user is
1721 optional.
1722
1723 Returns a problem if any of the above conditions fail. Returns undef
1724 if they pass and we can proceed with the checkin or renewal.
1725
1726 If the failure occurred on the copy-related checks, then the
1727 ProblemElement field will be undefined and needs to be filled in with
1728 the item id field name. If the check for the copy being checked out to
1729 the provided user fails, then both ProblemElement and ProblemValue
1730 fields will be empty and need to be filled in by the caller.
1731
1732 =cut
1733
1734 sub check_circ_details {
1735     my ($self, $details, $user) = @_;
1736
1737     my $copy = $details->{copy};
1738     my $circ = $details->{circ};
1739     my $transit = $details->{transit};
1740
1741     # Shortcut for the next check.
1742     my $ou_id = $self->{session}->{work_ou}->id();
1743
1744     # We need to have a circulation.  The copy needs to either have
1745     # been checked out at the NCIP user's working_ou or it needs to be
1746     # owned there.  If the circulation was subsequently checked in,
1747     # then we need an open transit to the NCIP user's working_ou.
1748     if (!$circ || ($circ->circ_lib() != $ou_id && $copy->circ_lib() != $ou_id)
1749             || ($circ->checkin_time() && (!$transit || $transit->dest() != $ou_id))) {
1750         # Item isn't checked out.
1751         return NCIP::Problem->new(
1752             {
1753                 ProblemType => 'Item Not Checked Out',
1754                 ProblemDetail => 'Item with barcode ' . $copy->barcode() . ' is not checked out.',
1755                 ProblemValue => $copy->barcode()
1756             }
1757         );
1758     } else {
1759         # Get data on the patron who has it checked out.
1760         my $circ_user = $self->retrieve_user_by_id($circ->usr());
1761         if ($user && $circ_user && $user->id() != $circ_user->id()) {
1762             # The ProblemElement and ProblemValue field need to be
1763             # filled in by the caller.
1764             return NCIP::Problem->new(
1765                 {
1766                     ProblemType => 'Item Not Checked Out To This User',
1767                     ProblemDetail => 'Item with barcode ' . $copy->barcode() . ' is not checked out to this user.',
1768                 }
1769             );
1770         }
1771     }
1772     # If we get here, we're good to go.
1773     return undef;
1774 }
1775
1776 =head2 retrieve_copy_details_by_barcode
1777
1778     $copy = $ils->retrieve_copy_details_by_barcode($copy_barcode);
1779
1780 Look up and retrieve some copy details by the copy barcode. This
1781 method returns either a hashref with the copy details or undefined if
1782 no copy exists with that barcode or if some error occurs.
1783
1784 The hashref has the fields copy, hold, transit, circ, volume, and mvr.
1785
1786 This method differs from C<retrieve_user_by_barcode> in that a copy
1787 cannot be invalid if it exists and it is not always an error if no
1788 copy exists. In some cases, when handling AcceptItem, we might prefer
1789 there to be no copy.
1790
1791 =cut
1792
1793 sub retrieve_copy_details_by_barcode {
1794     my $self = shift;
1795     my $barcode = shift;
1796
1797     my $copy = $U->simplereq(
1798         'open-ils.circ',
1799         'open-ils.circ.copy_details.retrieve.barcode',
1800         $self->{session}->{authtoken},
1801         $barcode
1802     );
1803
1804     # If $copy is an event, return undefined.
1805     if ($copy && $U->event_code($copy)) {
1806         undef($copy);
1807     }
1808
1809     return $copy;
1810 }
1811
1812 =head2 retrieve_copy_details_by_id
1813
1814     $copy = $ils->retrieve_copy_details_by_id($copy_id);
1815
1816 Retrieve copy_details by copy id. Same as the above, but with a copy
1817 id instead of barcode.
1818
1819 =cut
1820
1821 sub retrieve_copy_details_by_id {
1822     my $self = shift;
1823     my $copy_id = shift;
1824
1825     my $copy = $U->simplereq(
1826         'open-ils.circ',
1827         'open-ils.circ.copy_details.retrieve',
1828         $self->{session}->{authtoken},
1829         $copy_id
1830     );
1831
1832     # If $copy is an event, return undefined.
1833     if ($copy && $U->event_code($copy)) {
1834         undef($copy);
1835     }
1836
1837     return $copy;
1838 }
1839
1840 =head2 retrieve_copy_status
1841
1842     $status = $ils->retrieve_copy_status($id);
1843
1844 Retrive a copy status object by database ID.
1845
1846 =cut
1847
1848 sub retrieve_copy_status {
1849     my $self = shift;
1850     my $id = shift;
1851
1852     my $status = $U->simplereq(
1853         'open-ils.pcrud',
1854         'open-ils.pcrud.retrieve.ccs',
1855         $self->{session}->{authtoken},
1856         $id
1857     );
1858
1859     return $status;
1860 }
1861
1862 =head2 retrieve_org_unit_by_shortname
1863
1864     $org_unit = $ils->retrieve_org_unit_by_shortname($shortname);
1865
1866 Retrieves an org. unit from the database by shortname, and fleshes the
1867 ou_type field. Returns the org. unit as a Fieldmapper object or
1868 undefined.
1869
1870 =cut
1871
1872 sub retrieve_org_unit_by_shortname {
1873     my $self = shift;
1874     my $shortname = shift;
1875
1876     my $aou = $U->simplereq(
1877         'open-ils.actor',
1878         'open-ils.actor.org_unit.retrieve_by_shortname',
1879         $shortname
1880     );
1881
1882     # Check for failure from the above.
1883     if (ref($aou) eq 'HASH') {
1884         undef($aou);
1885     }
1886
1887     # We want to retrieve the type and manually "flesh" the object.
1888     if ($aou) {
1889         my $type = $U->simplereq(
1890             'open-ils.pcrud',
1891             'open-ils.pcrud.retrieve.aout',
1892             $self->{session}->{authtoken},
1893             $aou->ou_type()
1894         );
1895         $aou->ou_type($type) if ($type);
1896     }
1897
1898     return $aou;
1899 }
1900
1901 =head2 retrieve_copy_location
1902
1903     $location = $ils->retrieve_copy_location($location_id);
1904
1905 Retrieve a copy location based on id.
1906
1907 =cut
1908
1909 sub retrieve_copy_location {
1910     my $self = shift;
1911     my $id = shift;
1912
1913     my $location = $U->simplereq(
1914         'open-ils.pcrud',
1915         'open-ils.pcrud.retrieve.acpl',
1916         $self->{session}->{authtoken},
1917         $id
1918     );
1919
1920     return $location;
1921 }
1922
1923 =head2 retrieve_biblio_record_entry
1924
1925     $bre = $ils->retrieve_biblio_record_entry($bre_id);
1926
1927 Given a biblio.record_entry.id, this method retrieves a bre object.
1928
1929 =cut
1930
1931 sub retrieve_biblio_record_entry {
1932     my $self = shift;
1933     my $id = shift;
1934
1935     my $bre = $U->simplereq(
1936         'open-ils.pcrud',
1937         'open-ils.pcrud.retrieve.bre',
1938         $self->{session}->{authtoken},
1939         $id
1940     );
1941
1942     return $bre;
1943 }
1944
1945 =head2 create_precat_copy
1946
1947     $item_info->{
1948         barcode => '312340123456789',
1949         author => 'Public, John Q.',
1950         title => 'Magnum Opus',
1951         call_number => '005.82',
1952         publisher => 'Brick House',
1953         publication_date => '2014'
1954     };
1955
1956     $item = $ils->create_precat_copy($item_info);
1957
1958
1959 Create a "precat" copy to use for the incoming item using a hashref of
1960 item information. At a minimum, the barcode, author and title fields
1961 need to be filled in. The other fields are ignored if provided.
1962
1963 This method is called by the AcceptItem handler if the C<use_precats>
1964 configuration option is turned on.
1965
1966 =cut
1967
1968 sub create_precat_copy {
1969     my $self = shift;
1970     my $item_info = shift;
1971
1972     my $item = Fieldmapper::asset::copy->new();
1973     $item->barcode($item_info->{barcode});
1974     $item->call_number(OILS_PRECAT_CALL_NUMBER);
1975     $item->dummy_title($item_info->{title});
1976     $item->dummy_author($item_info->{author});
1977     $item->circ_lib($self->{session}->{work_ou}->id());
1978     $item->circulate('t');
1979     $item->holdable('t');
1980     $item->opac_visible('f');
1981     $item->deleted('f');
1982     $item->fine_level(OILS_PRECAT_COPY_FINE_LEVEL);
1983     $item->loan_duration(OILS_PRECAT_COPY_LOAN_DURATION);
1984     $item->location(1);
1985     $item->status(0);
1986     $item->editor($self->{session}->{user}->id());
1987     $item->creator($self->{session}->{user}->id());
1988     $item->isnew(1);
1989
1990     # Actually create it:
1991     my $xact;
1992     my $ses = OpenSRF::AppSession->create('open-ils.pcrud');
1993     $ses->connect();
1994     eval {
1995         $xact = $ses->request(
1996             'open-ils.pcrud.transaction.begin',
1997             $self->{session}->{authtoken}
1998         )->gather(1);
1999         $item = $ses->request(
2000             'open-ils.pcrud.create.acp',
2001             $self->{session}->{authtoken},
2002             $item
2003         )->gather(1);
2004         $xact = $ses->request(
2005             'open-ils.pcrud.transaction.commit',
2006             $self->{session}->{authtoken}
2007         )->gather(1);
2008     };
2009     if ($@) {
2010         undef($item);
2011         if ($xact) {
2012             eval {
2013                 $ses->request(
2014                     'open-ils.pcrud.transaction.rollback',
2015                     $self->{session}->{authtoken}
2016                 )->gather(1);
2017             };
2018         }
2019     }
2020     $ses->disconnect();
2021
2022     return $item;
2023 }
2024
2025 =head2 create_fuller_copy
2026
2027     $item_info->{
2028         barcode => '31234003456789',
2029         author => 'Public, John Q.',
2030         title => 'Magnum Opus',
2031         call_number => '005.82',
2032         publisher => 'Brick House',
2033         publication_date => '2014'
2034     };
2035
2036     $item = $ils->create_fuller_copy($item_info);
2037
2038 Creates a skeletal bibliographic record, call number, and copy for the
2039 incoming item using a hashref with item information in it. At a
2040 minimum, the barcode, author, title, and call_number fields must be
2041 filled in.
2042
2043 This method is used by the AcceptItem handler if the C<use_precats>
2044 configuration option is NOT set.
2045
2046 =cut
2047
2048 sub create_fuller_copy {
2049     my $self = shift;
2050     my $item_info = shift;
2051
2052     my $item;
2053
2054     # We do everything in one transaction, because it should be atomic.
2055     my $ses = OpenSRF::AppSession->create('open-ils.pcrud');
2056     $ses->connect();
2057     my $xact;
2058     eval {
2059         $xact = $ses->request(
2060             'open-ils.pcrud.transaction.begin',
2061             $self->{session}->{authtoken}
2062         )->gather(1);
2063     };
2064     if ($@) {
2065         undef($xact);
2066     }
2067
2068     # The rest depends on there being a transaction.
2069     if ($xact) {
2070
2071         # Create the MARC record.
2072         my $record = MARC::Record->new();
2073         $record->encoding('UTF-8');
2074         $record->leader('00881nam a2200193   4500');
2075         my $datespec = strftime("%Y%m%d%H%M%S.0", localtime);
2076         my @fields = ();
2077         push(@fields, MARC::Field->new('005', $datespec));
2078         push(@fields, MARC::Field->new('082', '0', '4', 'a' => $item_info->{call_number}));
2079         push(@fields, MARC::Field->new('245', '0', '0', 'a' => $item_info->{title}));
2080         # Publisher is a little trickier:
2081         if ($item_info->{publisher}) {
2082             my $pub = MARC::Field->new('260', ' ', ' ', 'a' => '[S.l.]', 'b' => $item_info->{publisher});
2083             $pub->add_subfields('c' => $item_info->{publication_date}) if ($item_info->{publication_date});
2084             push(@fields, $pub);
2085         }
2086         # We have no idea if the author is personal corporate or something else, so we use a 720.
2087         push(@fields, MARC::Field->new('720', ' ', ' ', 'a' => $item_info->{author}, '4' => 'aut'));
2088         $record->append_fields(@fields);
2089         my $marc = clean_marc($record);
2090
2091         # Create the bib object.
2092         my $bib = Fieldmapper::biblio::record_entry->new();
2093         $bib->creator($self->{session}->{user}->id());
2094         $bib->editor($self->{session}->{user}->id());
2095         $bib->source($self->{bib_source}->id());
2096         $bib->active('t');
2097         $bib->deleted('f');
2098         $bib->marc($marc);
2099         $bib->isnew(1);
2100
2101         eval {
2102             $bib = $ses->request(
2103                 'open-ils.pcrud.create.bre',
2104                 $self->{session}->{authtoken},
2105                 $bib
2106             )->gather(1);
2107         };
2108         if ($@) {
2109             undef($bib);
2110             eval {
2111                 $ses->request(
2112                     'open-ils.pcrud.transaction.rollback',
2113                     $self->{session}->{authtoken}
2114                 )->gather(1);
2115             };
2116         }
2117
2118         # Create the call number
2119         my $acn;
2120         if ($bib) {
2121             $acn = Fieldmapper::asset::call_number->new();
2122             $acn->creator($self->{session}->{user}->id());
2123             $acn->editor($self->{session}->{user}->id());
2124             $acn->label($item_info->{call_number});
2125             $acn->record($bib->id());
2126             $acn->owning_lib($self->{session}->{work_ou}->id());
2127             $acn->deleted('f');
2128             $acn->isnew(1);
2129
2130             eval {
2131                 $acn = $ses->request(
2132                     'open-ils.pcrud.create.acn',
2133                     $self->{session}->{authtoken},
2134                     $acn
2135                 )->gather(1);
2136             };
2137             if ($@) {
2138                 undef($acn);
2139                 eval {
2140                     $ses->request(
2141                         'open-ils.pcrud.transaction.rollback',
2142                         $self->{session}->{authtoken}
2143                     )->gather(1);
2144                 };
2145             }
2146         }
2147
2148         # create the copy
2149         if ($acn) {
2150             $item = Fieldmapper::asset::copy->new();
2151             $item->barcode($item_info->{barcode});
2152             $item->call_number($acn->id());
2153             $item->circ_lib($self->{session}->{work_ou}->id);
2154             $item->circulate('t');
2155             if ($self->{config}->{items}->{use_force_holds}) {
2156                 $item->holdable('f');
2157             } else {
2158                 $item->holdable('t');
2159             }
2160             $item->opac_visible('f');
2161             $item->deleted('f');
2162             $item->fine_level(OILS_PRECAT_COPY_FINE_LEVEL);
2163             $item->loan_duration(OILS_PRECAT_COPY_LOAN_DURATION);
2164             $item->location(1);
2165             $item->status(0);
2166             $item->editor($self->{session}->{user}->id);
2167             $item->creator($self->{session}->{user}->id);
2168             $item->isnew(1);
2169
2170             eval {
2171                 $item = $ses->request(
2172                     'open-ils.pcrud.create.acp',
2173                     $self->{session}->{authtoken},
2174                     $item
2175                 )->gather(1);
2176
2177                 # Cross our fingers and commit the work.
2178                 $xact = $ses->request(
2179                     'open-ils.pcrud.transaction.commit',
2180                     $self->{session}->{authtoken}
2181                 )->gather(1);
2182             };
2183             if ($@) {
2184                 undef($item);
2185                 eval {
2186                     $ses->request(
2187                         'open-ils.pcrud.transaction.rollback',
2188                         $self->{session}->{authtoken}
2189                     )->gather(1) if ($xact);
2190                 };
2191             }
2192         }
2193     }
2194
2195     # We need to disconnect our session.
2196     $ses->disconnect();
2197
2198     # Now, we handle our asset stat_cat entries.
2199     if ($item) {
2200         # It would be nice to do these in the above transaction, but
2201         # pcrud does not support the ascecm object, yet.
2202         foreach my $entry (@{$self->{stat_cat_entries}}) {
2203             my $map = Fieldmapper::asset::stat_cat_entry_copy_map->new();
2204             $map->isnew(1);
2205             $map->stat_cat($entry->stat_cat());
2206             $map->stat_cat_entry($entry->id());
2207             $map->owning_copy($item->id());
2208             # We don't really worry if it succeeds or not.
2209             $U->simplereq(
2210                 'open-ils.circ',
2211                 'open-ils.circ.stat_cat.asset.copy_map.create',
2212                 $self->{session}->{authtoken},
2213                 $map
2214             );
2215         }
2216     }
2217
2218     return $item;
2219 }
2220
2221 =head2 place_hold
2222
2223     $hold = $ils->place_hold($item, $user, $location, $expiration, $org_unit, $do_notification);
2224
2225 This function places a hold on $item for $user for pickup at
2226 $location. If location is not provided or undefined, the user's home
2227 library is used as a fallback.
2228
2229 The $expiration argument is optional and must be a properly formatted
2230 ISO date time. It will be used as the hold expire time, if
2231 provided. Otherwise the system default time will be used.
2232
2233 The $org_unit parameter is only consulted in the event of $item being
2234 a biblio::record_entry object.  In which case, it is expected to be
2235 undefined or an actor::org_unit object.  If it is present, then its id
2236 and ou_type depth (if the ou_type field is fleshed) will be used to
2237 control the selection ou and selection depth for the hold.  This
2238 essentially limits the hold to being filled by copies belonging to the
2239 specified org_unit or its children.
2240
2241 The $do_notification parameter is true or false for whether or not to
2242 add the patron's default notification options to the hold when placed.
2243
2244 $item can be a copy (asset::copy), volume (asset::call_number), or bib
2245 (biblio::record_entry). The appropriate hold type will be placed
2246 depending on the object.
2247
2248 On success, the method returns the object representing the hold. On
2249 failure, a NCIP::Problem object, describing the failure, is returned.
2250
2251 =cut
2252
2253 sub place_hold {
2254     my $self = shift;
2255     my $item = shift;
2256     my $user = shift;
2257     my $location = shift;
2258     my $expiration = shift;
2259     my $org_unit = shift;
2260     my $do_notification = shift;
2261
2262     # If $location is undefined, use the user's home_ou, which should
2263     # have been fleshed when the user was retrieved.
2264     $location = $user->home_ou() unless ($location);
2265
2266     # $params for the hold.
2267     my $params = { pickup_lib => $location->id(), patronid => $user->id() };
2268
2269     if (ref($item) eq 'Fieldmapper::asset::copy') {
2270         my $type = ($self->{config}->{items}->{use_force_holds}) ? 'F' : 'C';
2271         $params->{hold_type} = $type;
2272     } elsif (ref($item) eq 'Fieldmapper::asset::call_number') {
2273         $params->{hold_type} = 'V';
2274     } elsif (ref($item) eq 'Fieldmapper::biblio::record_entry') {
2275         $params->{hold_type} = 'T';
2276         if ($org_unit && ref($org_unit) eq 'Fieldmapper::actor::org_unit') {
2277             $params->{selection_ou} = $org_unit->id();
2278             $params->{depth} = $org_unit->ou_type->depth() if (ref($org_unit->ou_type()));
2279         }
2280     }
2281
2282     # Notification params.
2283     if ($do_notification) {
2284         my ($hold_notify) = grep {$_->name() eq 'opac.hold_notify'} @{$user->settings()};
2285         if ($hold_notify) {
2286             if ($hold_notify->value() =~ /email/) {
2287                 $params->{email_notify} = 1;
2288             }
2289             if ($hold_notify->value() =~ /phone/) {
2290                 my ($default_phone) = grep {$_->name() eq 'opac.default_phone'} @{$user->settings()};
2291                 if ($default_phone) {
2292                     $params->{phone_notify} = $default_phone->value();
2293                     $params->{phone_notify} =~ s/"//g;
2294                 } elsif ($user->day_phone()) {
2295                     $params->{phone_notify} = $user->day_phone();
2296                 }
2297             }
2298             if ($hold_notify->value() =~ /sms/) {
2299                 my ($sms_carrier) = grep {$_->name() eq 'opac.default_sms_carrier'} @{$user->settings()};
2300                 my ($sms_notify) = grep {$_->name() eq 'opac.default_sms_notify'} @{$user->settings()};
2301                 if ($sms_carrier && $sms_notify) {
2302                     $params->{sms_carrier} = $sms_carrier->value();
2303                     $params->{sms_notify} = $sms_notify->value();
2304                     $params->{sms_carrier} =~ s/"//g;
2305                     $params->{sms_notify} =~ s/"//g;
2306                 }
2307             }
2308         } else {
2309             if ($user->email()) {
2310                 $params->{email_notify} = 1;
2311             }
2312             if ($user->day_phone()) {
2313                 $params->{phone_notify} = $user->day_phone();
2314             }
2315         }
2316     }
2317
2318     my $response = $U->simplereq(
2319         'open-ils.circ',
2320         'open-ils.circ.holds.test_and_create.batch',
2321         $self->{session}->{authtoken},
2322         $params,
2323         [$item->id()]
2324     );
2325
2326     if (ref($response->{result})) {
2327         my $event = (ref($response->{result}) eq 'ARRAY') ? $response->{result}->[0] : $response->{result}->{last_event};
2328         if ($event->{textcode} eq 'HOLD_EXISTS') {
2329             return NCIP::Problem->new(
2330                 {
2331                     ProblemType => 'Duplicate Request',
2332                     ProblemDetail => 'A request for this item already exists for this patron.',
2333                     ProblemElement => 'NULL',
2334                     ProblemValue => 'NULL'
2335                 }
2336             );
2337         }
2338         if ($event->{textcode} eq 'ITEM_NOT_HOLDABLE') {
2339             return NCIP::Problem->new(
2340                 {
2341                     ProblemType => 'User Ineligible To Request This Item',
2342                     ProblemDetail => 'Agency rules prevent the Item from being requested by the User.',
2343                     ProblemElement => 'NULL',
2344                     ProblemValue => 'NULL'
2345                 }
2346             );
2347         }
2348         if ($event->{textcode} eq 'HIGH_LEVEL_HOLD_HAS_NO_COPIES') {
2349             return NCIP::Problem->new(
2350                 {
2351                     ProblemType => 'Unknown Item',
2352                     ProblemDetail => 'Agency does not have an Item to fill this request.',
2353                     ProblemElement => 'NULL',
2354                     ProblemValue => 'NULL'
2355                 }
2356             );
2357         }
2358         return _problem_from_event('User Ineligible To Request This Item', $event);
2359     }
2360
2361     # If we make it here, $response->{result} is a hold id.
2362     my $hold = $U->simplereq(
2363         'open-ils.pcrud',
2364         'open-ils.pcrud.retrieve.ahr',
2365         $self->{session}->{authtoken},
2366         $response->{result}
2367     );
2368     return $hold;
2369 }
2370
2371 =head2 cancel_hold
2372
2373     $result = $ils->cancel_hold($hold);
2374
2375 This method cancels the hold argument. It makes no checks on the hold,
2376 so if there are certain conditions that need to be fulfilled before
2377 the hold is canceled, then you must check them before calling this
2378 method.
2379
2380 It returns the result of the backend call to cancel the hold: 1 on
2381 succes or an ILS event on failure.
2382
2383 =cut
2384
2385 sub cancel_hold {
2386     my $self = shift;
2387     my $hold = shift;
2388
2389     my $r = $U->simplereq(
2390         'open-ils.circ',
2391         'open-ils.circ.hold.cancel',
2392         $self->{session}->{authtoken},
2393         $hold->id(),
2394         '5',
2395         'Canceled via NCIPServer'
2396     );
2397
2398     return $r;
2399 }
2400
2401 =head2 abort_transit
2402
2403     $result = $ils->abort_transit($transit);
2404
2405 This method aborts the passed in transit and returns true or false if
2406 it succeeded.  In general, we don't care about the return value here,
2407 but subclasses might.
2408
2409 =cut
2410
2411 sub abort_transit {
2412     my $self = shift;
2413     my $transit = shift;
2414     my $result = $U->simplereq(
2415         'open-ils.circ',
2416         'open-ils.circ.transit.abort',
2417         $self->{session}->{authtoken},
2418         {transitid => $transit->id()}
2419     );
2420     if (ref($result)) {
2421         return 0;
2422     }
2423     return 1;
2424 }
2425
2426 =head2 create_hold_note
2427
2428     $note = $ils->create_hold_note($hold, $title, $body);
2429
2430 This method creates a nold note with title of $title and body of $body
2431 on $hold.  It is used to store the RequestIdentifierValue from the
2432 RequestItem message so that we can later retrieve holds using that ID
2433 in order to cancel them.
2434
2435 It returns a note object on success and undef on failure.
2436
2437 =cut
2438
2439 sub create_hold_note {
2440     my $self = shift;
2441     my $hold = shift;
2442     my $title = shift;
2443     my $body = shift;
2444
2445     my $note = Fieldmapper::action::hold_request_note->new();
2446     $note->isnew(1);
2447     $note->hold($hold->id());
2448     $note->title($title);
2449     $note->body($body);
2450     $note->slip(0);
2451     $note->pub(0);
2452     $note->staff(0);
2453     my $result = $U->simplereq(
2454         'open-ils.circ',
2455         'open-ils.circ.hold_request.note.cud',
2456         $self->{session}->{authtoken},
2457         $note
2458     );
2459     if (not ref($result)) {
2460         $note->id($result);
2461         return $note;
2462     }
2463     return undef;
2464 }
2465
2466 =head2 find_hold_via_note
2467
2468     $hold = $ils->find_hold_via_note($title, $body);
2469
2470 Searches for a hold based on a note title and note body.  Returns the
2471 hold, and fleshes its transit (if any), if found, undef otherwise.
2472 The search is limited to unfulfilled, uncanceled hold where the
2473 request_lib equals the NCIPServer working org. unit.
2474
2475 =cut
2476
2477 sub find_hold_via_note {
2478     my $self = shift;
2479     my $title = shift;
2480     my $body = shift;
2481
2482     # Build the search clause up here, because it is a bit complex.
2483     my $search = {
2484         title => $title,
2485         body => $body,
2486         hold => {
2487             in => {
2488                 select => { ahr => ['id']},
2489                 from => 'ahr',
2490                 where => {cancel_time => undef, fulfillment_time => undef,
2491                           request_lib => $self->{session}->{work_ou}->id()}
2492             }
2493         }
2494     };
2495
2496     my $note = $U->simplereq(
2497         'open-ils.pcrud',
2498         'open-ils.pcrud.search.ahrn',
2499         $self->{session}->{authtoken},
2500         $search,
2501         {flesh => 2, flesh_fields => {ahrn => ['hold'], ahr => ['transit']}}
2502     );
2503     if (ref($note) eq 'Fieldmapper::action::hold_request_note') {
2504         return $note->hold();
2505     }
2506
2507     return undef;
2508 }
2509
2510 =head2 delete_copy
2511
2512     $ils->delete_copy($copy);
2513
2514 Deletes the copy, and if it is owned by our work_ou and not a precat,
2515 we also delete the volume and bib on which the copy depends.
2516
2517 =cut
2518
2519 sub delete_copy {
2520     my $self = shift;
2521     my $copy = shift;
2522
2523     # Shortcut for ownership checks below.
2524     my $ou_id = $self->{session}->{work_ou}->id();
2525
2526     # First, make sure the copy is not already deleted and we own it.
2527     return undef if ($U->is_true($copy->deleted()) || $copy->circ_lib() != $ou_id);
2528
2529     # Indicate we want to delete the copy.
2530     $copy->isdeleted(1);
2531     $copy->deleted('t');
2532
2533     # Delete the copy using a backend call that will delete the copy,
2534     # the call number, and bib when appropriate.
2535     my $result = $U->simplereq(
2536         'open-ils.cat',
2537         'open-ils.cat.asset.copy.fleshed.batch.update.override',
2538         $self->{session}->{authtoken},
2539         [$copy]
2540     );
2541
2542     # We are currently not checking for succes or failure of the
2543     # above. At some point, someone may want to.
2544
2545     return undef;
2546 }
2547
2548 =head2 copy_can_circulate
2549
2550     $can_circulate = $ils->copy_can_circulate($copy);
2551
2552 Check if the copy's location and the copy itself allow
2553 circulation. Return true if they do, and false if they do not.
2554
2555 =cut
2556
2557 sub copy_can_circulate {
2558     my $self = shift;
2559     my $copy = shift;
2560
2561     my $location = $copy->location();
2562     unless (ref($location)) {
2563         $location = $self->retrieve_copy_location($location);
2564     }
2565
2566     return ($U->is_true($copy->circulate()) && $U->is_true($location->circulate()));
2567 }
2568
2569 =head1 OVERRIDDEN PARENT METHODS
2570
2571 =head2 find_user_barcode
2572
2573 We dangerously override our parent's C<find_user_barcode> to return
2574 either the $barcode or a Problem object. In list context the barcode
2575 or problem will be the first argument and the id field, if any, will
2576 be the second. We also add a second, optional, argument to indicate a
2577 default value for the id field in the event of a failure to find
2578 anything at all. (Perl lets us get away with this.)
2579
2580 =cut
2581
2582 sub find_user_barcode {
2583     my $self = shift;
2584     my $request = shift;
2585     my $default = shift;
2586
2587     unless ($default) {
2588         my $message = $self->parse_request_type($request);
2589         if ($message eq 'LookupUser') {
2590             $default = 'AuthenticationInputData';
2591         } else {
2592             $default = 'UserIdentifierValue';
2593         }
2594     }
2595
2596     my ($value, $idfield) = $self->SUPER::find_user_barcode($request);
2597
2598     unless ($value) {
2599         $idfield = $default unless ($idfield);
2600         $value = NCIP::Problem->new();
2601         $value->ProblemType('Needed Data Missing');
2602         $value->ProblemDetail('Cannot find user barcode in message.');
2603         $value->ProblemElement($idfield);
2604         $value->ProblemValue('NULL');
2605     }
2606
2607     return (wantarray) ? ($value, $idfield) : $value;
2608 }
2609
2610 =head2 find_item_barcode
2611
2612 We do pretty much the same thing as with C<find_user_barcode> for
2613 C<find_item_barcode>.
2614
2615 =cut
2616
2617 sub find_item_barcode {
2618     my $self = shift;
2619     my $request = shift;
2620     my $default = shift || 'ItemIdentifierValue';
2621
2622     my ($value, $idfield) = $self->SUPER::find_item_barcode($request);
2623
2624     unless ($value) {
2625         $idfield = $default unless ($idfield);
2626         $value = NCIP::Problem->new();
2627         $value->ProblemType('Needed Data Missing');
2628         $value->ProblemDetail('Cannot find item barcode in message.');
2629         $value->ProblemElement($idfield);
2630         $value->ProblemValue('NULL');
2631     }
2632
2633     return (wantarray) ? ($value, $idfield) : $value;
2634 }
2635
2636 =head2 find_location_failover
2637
2638     $location = $ils->find_location_failover($location, $request, $message);
2639
2640 Attempts to retrieve an org_unit by shortname from the passed in
2641 $location.  If that fails, $request and $message are used to lookup
2642 the ToAgencyId/AgencyId field and that is used.  Returns an org_unit
2643 as retrieved by retrieve_org_unit_by_shortname if successful and undef
2644 on failure.
2645
2646 =cut
2647
2648 sub find_location_failover {
2649     my ($self, $location, $request, $message) = @_;
2650     if ($request && !$message) {
2651         $message = $self->parse_request_type($request);
2652     }
2653     my $org_unit;
2654     if ($location) {
2655         # Because Auto-Graphics. (This should be configured somehow.)
2656         $location =~ s/^[^-]+-//;
2657         $org_unit = $self->retrieve_org_unit_by_shortname($location);
2658     }
2659     if ($request && $message && !$org_unit) {
2660         $location = $request->{$message}->{InitiationHeader}->{ToAgencyId}->{AgencyId};
2661         if ($location) {
2662             # Because Auto-Graphics. (This should be configured somehow.)
2663             $location =~ s/^[^-]+-//;
2664             $org_unit = $self->retrieve_org_unit_by_shortname($location);
2665         }
2666     }
2667
2668     return $org_unit;
2669 }
2670
2671 # private subroutines not meant to be used directly by subclasses.
2672 # Most have to do with setup and/or state checking of implementation
2673 # components.
2674
2675 # Find, load, and parse our configuration file:
2676 sub _configure {
2677     my $self = shift;
2678
2679     # Find the configuration file via variables:
2680     my $file = OILS_NCIP_CONFIG_DEFAULT;
2681     $file = $ENV{OILS_NCIP_CONFIG} if ($ENV{OILS_NCIP_CONFIG});
2682
2683     $self->{config} = XMLin($file, NormaliseSpace => 2,
2684                             ForceArray => ['block_profile', 'stat_cat_entry']);
2685 }
2686
2687 # Bootstrap OpenSRF::System and load the IDL.
2688 sub _bootstrap {
2689     my $self = shift;
2690
2691     my $bootstrap_config = $self->{config}->{bootstrap};
2692     OpenSRF::System->bootstrap_client(config_file => $bootstrap_config);
2693
2694     my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
2695     Fieldmapper->import(IDL => $idl);
2696 }
2697
2698 # Login and then initialize some object data based on the
2699 # configuration.
2700 sub _init {
2701     my $self = shift;
2702
2703     # Login to Evergreen.
2704     $self->login();
2705
2706     # Load the barred groups as pgt objects into a blocked_profiles
2707     # list.
2708     $self->{blocked_profiles} = [];
2709     if (ref($self->{config}->{patrons}) eq 'HASH') {
2710         foreach (@{$self->{config}->{patrons}->{block_profile}}) {
2711             my $pgt;
2712             if (ref $_) {
2713                 $pgt = $U->simplereq(
2714                     'open-ils.pcrud',
2715                     'open-ils.pcrud.retrieve.pgt',
2716                     $self->{session}->{authtoken},
2717                     $_->{grp}
2718                 );
2719             } else {
2720                 $pgt = $U->simplereq(
2721                     'open-ils.pcrud',
2722                     'open-ils.pcrud.search.pgt',
2723                     $self->{session}->{authtoken},
2724                     {
2725                         name => $_}
2726                 );
2727             }
2728             push(@{$self->{blocked_profiles}}, $pgt) if ($pgt);
2729         }
2730     }
2731
2732     # Load the bib source if we're not using precats.
2733     unless ($self->{config}->{items}->{use_precats}) {
2734         # Retrieve the default
2735         $self->{bib_source} = $U->simplereq(
2736             'open-ils.pcrud',
2737             'open-ils.pcrud.retrieve.cbs',
2738             $self->{session}->{authtoken},
2739             BIB_SOURCE_DEFAULT);
2740         my $data = $self->{config}->{items}->{bib_source};
2741         if ($data) {
2742             $data = $data->[0] if (ref($data) eq 'ARRAY');
2743             my $result;
2744             if (ref $data) {
2745                 $result = $U->simplereq(
2746                     'open-ils.pcrud',
2747                     'open-ils.pcrud.retrieve.cbs',
2748                     $self->{session}->{authtoken},
2749                     $data->{cbs}
2750                 );
2751             } else {
2752                 $result = $U->simplereq(
2753                     'open-ils.pcrud',
2754                     'open-ils.pcrud.search.cbs',
2755                     $self->{session}->{authtoken},
2756                     {source => $data}
2757                 );
2758             }
2759             $self->{bib_source} = $result if ($result);
2760         }
2761     }
2762
2763     # Load the required asset.stat_cat_entries:
2764     $self->{stat_cat_entries} = [];
2765     # First, make a regex for our ou and ancestors:
2766     my $ancestors = join("|", @{$U->get_org_ancestors($self->{session}->{work_ou}->id())});
2767     my $re = qr/(?:$ancestors)/;
2768     # Get the uniq stat_cat ids from the configuration:
2769     my @cats = uniq map {$_->{stat_cat}} @{$self->{config}->{items}->{stat_cat_entry}};
2770     # Retrieve all of the fleshed stat_cats and entries for the above.
2771     my $stat_cats = $U->simplereq(
2772         'open-ils.circ',
2773         'open-ils.circ.stat_cat.asset.retrieve.batch',
2774         $self->{session}->{authtoken},
2775         @cats
2776     );
2777     foreach my $entry (@{$self->{config}->{items}->{stat_cat_entry}}) {
2778         # Must have the stat_cat attr and the name, so we must have a
2779         # reference.
2780         next unless(ref $entry);
2781         my ($stat) = grep {$_->id() == $entry->{stat_cat}} @$stat_cats;
2782         push(@{$self->{stat_cat_entries}}, grep {$_->owner() =~ $re && $_->value() eq $entry->{content}} @{$stat->entries()});
2783     }
2784
2785     # Check if we should abort transits on request cancellation.  We
2786     # put this in a different variable because someone may not have
2787     # updated their configuration since this feature was added and we
2788     # don't want runtime errors.
2789     $self->{abort_transit_on_hold_cancel} = 0;
2790     if ($self->{config}->{holds} && $self->{config}->{holds}->{abort_transit_on_cancel}) {
2791         $self->{abort_transit_on_hold_cancel} = 1;
2792     }
2793 }
2794
2795 # Search for holds using the user, idvalue and selection_ou.
2796 sub _hold_search {
2797     my $self = shift;
2798     my $user = shift;
2799     my $target = shift;
2800     my $selection_ou = shift;
2801
2802     my $hold;
2803
2804     # Retrieve all of the user's active holds, and then search them in Perl.
2805     my $holds_list = $U->simplereq(
2806         'open-ils.circ',
2807         'open-ils.circ.holds.retrieve',
2808         $self->{session}->{authtoken},
2809         $user->id(),
2810         0
2811     );
2812
2813     if ($holds_list && @$holds_list) {
2814         my @holds = grep {$_->target == $target && $_->selection_ou == $selection_ou->id()} @{$holds_list};
2815         # There should only be 1, at this point, if there are any.
2816         if (@holds) {
2817             $hold = $holds[0];
2818         }
2819     }
2820
2821     return $hold;
2822 }
2823
2824 # Standalone, "helper" functions.  These do not take an object or
2825 # class reference.
2826
2827 # Check if a user is past their expiration date.
2828 sub _expired {
2829     my $user = shift;
2830     my $expired = 0;
2831
2832     # Users might not expire.  If so, they have no expire_date.
2833     if ($user->expire_date()) {
2834         my $expires = DateTime::Format::ISO8601->parse_datetime(
2835             cleanse_ISO8601($user->expire_date())
2836         )->epoch();
2837         my $now = DateTime->now()->epoch();
2838         $expired = $now > $expires;
2839     }
2840
2841     return $expired;
2842 }
2843
2844 # Creates a NCIP Problem from an event. Takes a string for the problem
2845 # type, the event hashref (or a string to use for the detail), and
2846 # optional arguments for the ProblemElement and ProblemValue fields.
2847 sub _problem_from_event {
2848     my ($type, $evt, $element, $value) = @_;
2849
2850     my $detail;
2851
2852     # Check the event.
2853     if (ref($evt)) {
2854         my ($textcode, $desc);
2855
2856         # Get the textcode, if available. Otherwise, use the ilsevent
2857         # "id," if available.
2858         if ($evt->{textcode}) {
2859             $textcode = $evt->{textcode};
2860         } elsif ($evt->{ilsevent}) {
2861             $textcode = $evt->{ilsevent};
2862         }
2863
2864         # Get the description. We favor translated descriptions over
2865         # the English in ils_events.xml.
2866         if ($evt->{desc}) {
2867             $desc = $evt->{desc};
2868         }
2869
2870         # Check if $type was set. As an "undocumented" feature, you
2871         # can pass undef, and we'll use the textcode from the event.
2872         unless ($type) {
2873             if ($textcode) {
2874                 $type = $textcode;
2875             }
2876         }
2877
2878         # Set the detail from some combination of the above.
2879         if ($desc) {
2880             $detail = $desc;
2881         } elsif ($textcode eq 'PERM_FAILURE') {
2882             if ($evt->{ilsperm}) {
2883                 $detail = "Permission denied: " . $evt->{ilsperm};
2884                 $detail =~ s/\.override$//;
2885             }
2886         } elsif ($textcode) {
2887             $detail = "ILS returned $textcode error.";
2888         } else {
2889             $detail = 'Detail not available.';
2890         }
2891
2892     } else {
2893         $detail = $evt;
2894     }
2895
2896     return NCIP::Problem->new(
2897         {
2898             ProblemType => ($type) ? $type : 'Temporary Processing Failure',
2899             ProblemDetail => ($detail) ? $detail : 'Detail not available.',
2900             ProblemElement => ($element) ? $element : 'NULL',
2901             ProblemValue => ($value) ? $value : 'NULL'
2902         }
2903     );
2904 }
2905
2906 # "Fix" dates for output so they validate against the schema
2907 sub _fix_date {
2908     my $date = shift;
2909     my $out = DateTime::Format::ISO8601->parse_datetime(cleanse_ISO8601($date));
2910     $out->set_time_zone('UTC');
2911     return $out->iso8601();
2912 }
2913
2914 1;