Merge branch 'master' of git.evergreen-ils.org:Evergreen into template-toolkit-opac
[working/Evergreen.git] / Open-ILS / src / perlmods / lib / OpenILS / SIP.pm
1 #
2 # ILS.pm: Test ILS interface module
3 #
4
5 package OpenILS::SIP;
6 use warnings; use strict;
7
8 use Sys::Syslog qw(syslog);
9 use Time::HiRes q/time/;
10
11 use OpenILS::SIP::Item;
12 use OpenILS::SIP::Patron;
13 use OpenILS::SIP::Transaction;
14 use OpenILS::SIP::Transaction::Checkout;
15 use OpenILS::SIP::Transaction::Checkin;
16 use OpenILS::SIP::Transaction::Renew;
17
18 use OpenSRF::System;
19 use OpenILS::Utils::Fieldmapper;
20 use OpenSRF::Utils::SettingsClient;
21 use OpenILS::Application::AppUtils;
22 use OpenSRF::Utils qw/:datetime/;
23 use DateTime::Format::ISO8601;
24 use Encode;
25 use Unicode::Normalize;
26 my $U = 'OpenILS::Application::AppUtils';
27
28 my $editor;
29 my $config;
30 my $target_encoding;    # FIXME: this is configured at the institution level. 
31
32 use Digest::MD5 qw(md5_hex);
33
34 sub new {
35         my ($class, $institution, $login) = @_;
36         my $type = ref($class) || $class;
37         my $self = {};
38
39         $self->{login} = $login;
40
41         $config = $institution;
42         syslog("LOG_DEBUG", "OILS: new ILS '%s'", $institution->{id});
43         $self->{institution} = $institution;
44
45         my $bsconfig     = $institution->{implementation_config}->{bootstrap};
46         $target_encoding = $institution->{implementation_config}->{encoding} || 'ascii';
47
48         syslog('LOG_DEBUG', "OILS: loading bootstrap config: $bsconfig");
49         
50         local $/ = "\n";    # why?
51         OpenSRF::System->bootstrap_client(config_file => $bsconfig);
52         syslog('LOG_DEBUG', "OILS: bootstrap loaded..");
53
54         $self->{osrf_config} = OpenSRF::Utils::SettingsClient->new;
55
56         Fieldmapper->import($self->{osrf_config}->config_value('IDL'));
57
58         bless( $self, $type );
59
60         return undef unless 
61                 $self->login( $login->{id}, $login->{password} );
62
63         return $self;
64 }
65
66 sub fetch_session {
67     my $self = shift;
68
69         my $ses = $U->simplereq( 
70                 'open-ils.auth',
71                 'open-ils.auth.session.retrieve',  $self->{authtoken});
72
73     return undef if $U->event_code($ses); # auth timed out
74     return $self->{login_session} = $ses;
75 }
76
77 sub verify_session {
78         my $self = shift;
79
80     return 1 if $self->fetch_session;
81
82     syslog('LOG_INFO', "OILS: Logging back after session timeout as user ".$self->{login}->{id});
83     return $self->login( $self->{login}->{id}, $self->{login}->{password} );
84 }
85
86 sub editor {
87         return $editor = make_editor();
88 }
89
90 sub config {
91         return $config;
92 }
93
94 sub get_option_value {
95     my($self, $option) = @_;
96     my $ops = $config->{implementation_config}->{options}->{option};
97     $ops = [$ops] unless ref $ops eq 'ARRAY';
98     my @vals = grep { $_->{name} eq $option } @$ops;
99     return @vals ? $vals[0]->{value} : undef;
100 }
101
102
103 # Creates the global editor object
104 my $cstore_init = 1; # call init on first use
105 sub make_editor {
106     OpenILS::Utils::CStoreEditor::init() if $cstore_init;
107     $cstore_init = 0;
108         return OpenILS::Utils::CStoreEditor->new;
109 }
110
111 =head2 clean_text(scalar)
112
113 Evergreen uses the UTF8 encoding for everything from the database up. Perl
114 doesn't know this, however, so we have to convince it to treat our UTF8 strings
115 as UTF8 strings. This may enable OpenNCIP to correctly calculate the checksums
116 for UTF8 text for SIP clients that support such modern options.
117
118 The target encoding is set in the <encoding> element of the SIPServer.pm
119 configuration file.
120
121 =cut
122
123 sub clean_text {
124     my $text = shift || '';
125
126     # Convert our incoming UTF8 data into Perl's internal string format
127
128     # Also convert to Normalization Form D, as the ASCII, iso-8859-1,
129     # and latin-1 encodings (at least) require this to substitute
130     # characters rather than simply returning a string truncated
131     # after the first non-ASCII character
132     $text = NFD(decode_utf8($text));
133
134     if ($target_encoding eq 'ascii') {
135
136         # Try to maintain a reasonable version of the content by
137         # stripping diacritics from the text, given that the SIP client
138         # wants just plain ASCII. This is the base requirement according
139         # to the SIP2 specification.
140
141         # Stripping the combining characters converts ""béè♁ts"
142         # into "bee?ts" instead of "b???ts" - better, eh?
143         $text =~ s/\pM+//og;
144     }
145
146     # Characters that cannot be represented in the target encoding will
147     # generally be replaced with a question mark (?) character.
148     $text = encode($target_encoding, $text);
149
150     return $text;
151 }
152
153 my %org_sn_cache;
154 sub shortname_from_id {
155     my $id = shift or return;
156     return $id->shortname if ref $id;
157     return $org_sn_cache{$id} if $org_sn_cache{$id};
158     return $org_sn_cache{$id} = editor()->retrieve_actor_org_unit($id)->shortname;
159 }
160 sub patron_barcode_from_id {
161     my $id = shift or return;
162     return editor()->search_actor_card({ usr => $id, active => 't' })->[0]->barcode;
163 }
164
165 sub format_date {
166         my $class = shift;
167         my $date = shift;
168         my $type = shift || 'dob';
169
170         return "" unless $date;
171
172         $date = DateTime::Format::ISO8601->new->
173                 parse_datetime(OpenSRF::Utils::cleanse_ISO8601($date));
174         my @time = localtime($date->epoch);
175
176         my $year   = $time[5]+1900;
177         my $mon    = $time[4]+1;
178         my $day    = $time[3];
179         my $hour   = $time[2];
180         my $minute = $time[1];
181         my $second = $time[0];
182   
183         $date = sprintf("%04d%02d%02d", $year, $mon, $day);
184
185         # Due dates need hyphen separators and time of day as well
186         if ($type eq 'due') {
187                 $date = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year, $mon, $day, $hour, $minute, $second);
188         }
189
190         syslog('LOG_DEBUG', "OILS: formatted date [type=$type]: $date");
191         return $date;
192 }
193
194
195
196 sub login {
197         my( $self, $username, $password ) = @_;
198         syslog('LOG_DEBUG', "OILS: Logging in with username $username");
199
200         my $seed = $U->simplereq( 
201                 'open-ils.auth',
202                 'open-ils.auth.authenticate.init', $username );
203
204         my $response = $U->simplereq(
205                 'open-ils.auth', 
206                 'open-ils.auth.authenticate.complete', 
207                 {       
208                         username => $username, 
209                         password => md5_hex($seed . md5_hex($password)), 
210                         type     => 'opac',
211                 }
212         );
213
214         if( my $code = $U->event_code($response) ) {
215                 my $txt = $response->{textcode};
216                 syslog('LOG_WARNING', "OILS: Login failed for $username.  $txt:$code");
217                 return undef;
218         }
219
220         my $key = $response->{payload}->{authtoken};
221         syslog('LOG_INFO', "OILS: Login succeeded for $username : authkey = $key");
222
223     $self->fetch_session; # to cache the login
224
225         return $self->{authtoken} = $key;
226 }
227
228
229 sub find_patron {
230         my $self = shift;
231         return OpenILS::SIP::Patron->new(@_);
232 }
233
234
235 sub find_item {
236         my $self = shift;
237         return OpenILS::SIP::Item->new(@_);
238 }
239
240
241 sub institution {
242     my $self = shift;
243     return $self->{institution}->{id};  # consider making this return the whole institution
244 }
245
246 sub institution_id {
247     my $self = shift;
248     return $self->{institution}->{id};  # then use this for just the ID
249 }
250
251 sub supports {
252         my ($self, $op) = @_;
253         my ($i) = grep { $_->{name} eq $op }  
254                 @{$config->{implementation_config}->{supports}->{item}};
255         return to_bool($i->{value});
256 }
257
258 sub check_inst_id {
259     my ($self, $id, $whence) = @_;
260     if ($id ne $self->{institution}->{id}) {
261         syslog("LOG_WARNING", "OILS: %s: received institution '%s', expected '%s'", $whence, $id, $self->{institution}->{id});
262         # Just an FYI check, we don't expect the user to change location from that in SIPconfig.xml
263     }
264 }
265
266
267 sub to_bool {
268     my $bool = shift;
269     # If it's defined, and matches a true sort of string, or is
270     # a non-zero number, then it's true.
271     defined($bool) or return;                   # false
272     ($bool =~ /true|y|yes/i) and return 1;      # true
273     return ($bool =~ /^\d+$/ and $bool != 0);   # true for non-zero numbers, false otherwise
274 }
275
276 sub checkout_ok {
277         return to_bool($config->{policy}->{checkout});
278 }
279
280 sub checkin_ok {
281         return to_bool($config->{policy}->{checkin});
282 }
283
284 sub renew_ok {
285         return to_bool($config->{policy}->{renew});
286 }
287
288 sub status_update_ok {
289         return to_bool($config->{policy}->{status_update});
290 }
291
292 sub offline_ok {
293         return to_bool($config->{policy}->{offline});
294 }
295
296
297
298 ##
299 ## Checkout(patron_id, item_id, sc_renew):
300 ##    patron_id & item_id are the identifiers send by the terminal
301 ##    sc_renew is the renewal policy configured on the terminal
302 ## returns a status opject that can be queried for the various bits
303 ## of information that the protocol (SIP or NCIP) needs to generate
304 ## the response.
305 ##
306
307 sub checkout {
308         my ($self, $patron_id, $item_id, $sc_renew) = @_;
309         $sc_renew = 0;
310
311         $self->verify_session;
312
313         syslog('LOG_DEBUG', "OILS: OpenILS::Checkout attempt: patron=$patron_id, item=$item_id");
314
315     my $xact   = OpenILS::SIP::Transaction::Checkout->new( authtoken => $self->{authtoken} );
316     my $patron = $self->find_patron($patron_id);
317     my $item   = $self->find_item($item_id);
318
319         $xact->patron($patron);
320         $xact->item($item);
321
322         if (!$patron) {
323                 $xact->screen_msg("Invalid Patron Barcode '$patron_id'");
324                 return $xact;
325         }
326
327         if (!$patron->charge_ok) {
328                 $xact->screen_msg("Patron Blocked");
329                 return $xact;
330         }
331
332         if( !$item ) {
333                 $xact->screen_msg("Invalid Item Barcode: '$item_id'");
334                 return $xact;
335         }
336
337         syslog('LOG_DEBUG', "OILS: OpenILS::Checkout data loaded OK, checking out...");
338
339         if ($item->{patron} && ($item->{patron} eq $patron_id)) {
340                 syslog('LOG_INFO', "OILS: OpenILS::Checkout data loaded OK, doing renew...");
341                 $sc_renew = 1;
342         } elsif ($item->{patron} && ($item->{patron} ne $patron_id)) {
343                 # I can't deal with this right now
344                 # XXX check in then check out?
345                 $xact->screen_msg("Item checked out to another patron");
346                 $xact->ok(0);
347         } 
348
349         $xact->do_checkout($sc_renew);
350         $xact->desensitize(!$item->magnetic);
351
352         if( $xact->ok ) {
353                 #editor()->commit;
354                 syslog("LOG_DEBUG", "OILS: OpenILS::Checkout: " .
355                         "patron %s checkout %s succeeded", $patron_id, $item_id);
356         } else {
357                 #editor()->xact_rollback;
358                 syslog("LOG_DEBUG", "OILS: OpenILS::Checkout: " .
359                         "patron %s checkout %s FAILED, rolling back xact...", $patron_id, $item_id);
360         }
361
362         return $xact;
363 }
364
365
366 sub checkin {
367         my ($self, $item_id, $inst_id, $trans_date, $return_date,
368         $current_loc, $item_props, $cancel) = @_;
369
370     my $start_time = time();
371
372         $self->verify_session;
373
374         syslog('LOG_DEBUG', "OILS: OpenILS::Checkin of item=$item_id (to $inst_id)");
375         
376     my $xact = OpenILS::SIP::Transaction::Checkin->new(authtoken => $self->{authtoken});
377     my $item = OpenILS::SIP::Item->new($item_id);
378
379     unless ( $xact->item($item) ) {
380         $xact->ok(0);
381         # $circ->alert(1); $circ->alert_type(99);
382         $xact->screen_msg("Invalid Item Barcode: '$item_id'");
383         syslog('LOG_INFO', "OILS: Checkin failed.  " . $xact->screen_msg() );
384         return $xact;
385     }
386
387         $xact->do_checkin( $self, $inst_id, $trans_date, $return_date, $current_loc, $item_props );
388         
389         if ($xact->ok) {
390         $xact->patron($self->find_patron(usr => $xact->{circ_user_id}, slim_user => 1)) if $xact->{circ_user_id};
391         delete $item->{patron};
392         delete $item->{due_date};
393         syslog('LOG_INFO', "OILS: Checkin succeeded");
394     } else {
395         syslog('LOG_WARNING', "OILS: Checkin failed");
396     }
397
398     syslog('LOG_INFO', "OILS: SIP Checkin request took %0.3f seconds", (time() - $start_time));
399         return $xact;
400 }
401
402 ## If the ILS caches patron information, this lets it free it up.
403 ## Also, this could be used for centrally logging session duration.
404 ## We don't do anything with it.
405 sub end_patron_session {
406     my ($self, $patron_id) = @_;
407     return (1, 'Thank you!', '');
408 }
409
410
411 #sub pay_fee {
412 #    my ($self, $patron_id, $patron_pwd, $fee_amt, $fee_type,
413 #       $pay_type, $fee_id, $trans_id, $currency) = @_;
414 #    my $trans;
415 #    my $patron;
416 #
417 #    $trans = new ILS::Transaction::FeePayment;
418 #
419 #    $patron = new ILS::Patron $patron_id;
420 #
421 #    $trans->transaction_id($trans_id);
422 #    $trans->patron($patron);
423 #    $trans->ok(1);
424 #
425 #    return $trans;
426 #}
427 #
428 #sub add_hold {
429 #    my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
430 #       $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
431 #    my ($patron, $item);
432 #    my $hold;
433 #    my $trans;
434 #
435 #
436 #    $trans = new ILS::Transaction::Hold;
437 #
438 #    # BEGIN TRANSACTION
439 #    $patron = new ILS::Patron $patron_id;
440 #    if (!$patron
441 #       || (defined($patron_pwd) && !$patron->check_password($patron_pwd))) {
442 #       $trans->screen_msg("Invalid Patron.");
443 #
444 #       return $trans;
445 #    }
446 #
447 #    $item = new ILS::Item ($item_id || $title_id);
448 #    if (!$item) {
449 #       $trans->screen_msg("No such item.");
450 #
451 #       # END TRANSACTION (conditionally)
452 #       return $trans;
453 #    } elsif ($item->fee && ($fee_ack ne 'Y')) {
454 #       $trans->screen_msg = "Fee required to place hold.";
455 #
456 #       # END TRANSACTION (conditionally)
457 #       return $trans;
458 #    }
459 #
460 #    $hold = {
461 #       item_id         => $item->id,
462 #       patron_id       => $patron->id,
463 #       expiration_date => $expiry_date,
464 #       pickup_location => $pickup_location,
465 #       hold_type       => $hold_type,
466 #    };
467 #
468 #    $trans->ok(1);
469 #    $trans->patron($patron);
470 #    $trans->item($item);
471 #    $trans->pickup_location($pickup_location);
472 #
473 #    push(@{$item->hold_queue}, $hold);
474 #    push(@{$patron->{hold_items}}, $hold);
475 #
476 #
477 #    # END TRANSACTION
478 #    return $trans;
479 #}
480 #
481 #sub cancel_hold {
482 #    my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_;
483 #    my ($patron, $item, $hold);
484 #    my $trans;
485 #
486 #    $trans = new ILS::Transaction::Hold;
487 #
488 #    # BEGIN TRANSACTION
489 #    $patron = new ILS::Patron $patron_id;
490 #    if (!$patron) {
491 #       $trans->screen_msg("Invalid patron barcode.");
492 #
493 #       return $trans;
494 #    } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
495 #       $trans->screen_msg('Invalid patron password.');
496 #
497 #       return $trans;
498 #    }
499 #
500 #    $item = new ILS::Item ($item_id || $title_id);
501 #    if (!$item) {
502 #       $trans->screen_msg("No such item.");
503 #
504 #       # END TRANSACTION (conditionally)
505 #       return $trans;
506 #    }
507 #
508 #    # Remove the hold from the patron's record first
509 #    $trans->ok($patron->drop_hold($item_id));
510 #
511 #    if (!$trans->ok) {
512 #       # We didn't find it on the patron record
513 #       $trans->screen_msg("No such hold on patron record.");
514 #
515 #       # END TRANSACTION (conditionally)
516 #       return $trans;
517 #    }
518 #
519 #    # Now, remove it from the item record.  If it was on the patron
520 #    # record but not on the item record, we'll treat that as success.
521 #    foreach my $i (0 .. scalar @{$item->hold_queue}) {
522 #       $hold = $item->hold_queue->[$i];
523 #
524 #       if ($hold->{patron_id} eq $patron->id) {
525 #           # found it: delete it.
526 #           splice @{$item->hold_queue}, $i, 1;
527 #           last;
528 #       }
529 #    }
530 #
531 #    $trans->screen_msg("Hold Cancelled.");
532 #    $trans->patron($patron);
533 #    $trans->item($item);
534 #
535 #    return $trans;
536 #}
537 #
538 #
539 ## The patron and item id's can't be altered, but the
540 ## date, location, and type can.
541 #sub alter_hold {
542 #    my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
543 #       $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
544 #    my ($patron, $item);
545 #    my $hold;
546 #    my $trans;
547 #
548 #    $trans = new ILS::Transaction::Hold;
549 #
550 #    # BEGIN TRANSACTION
551 #    $patron = new ILS::Patron $patron_id;
552 #    if (!$patron) {
553 #       $trans->screen_msg("Invalid patron barcode.");
554 #
555 #       return $trans;
556 #    }
557 #
558 #    foreach my $i (0 .. scalar @{$patron->{hold_items}}) {
559 #       $hold = $patron->{hold_items}[$i];
560 #
561 #       if ($hold->{item_id} eq $item_id) {
562 #           # Found it.  So fix it.
563 #           $hold->{expiration_date} = $expiry_date if $expiry_date;
564 #           $hold->{pickup_location} = $pickup_location if $pickup_location;
565 #           $hold->{hold_type} = $hold_type if $hold_type;
566 #
567 #           $trans->ok(1);
568 #           $trans->screen_msg("Hold updated.");
569 #           $trans->patron($patron);
570 #           $trans->item(new ILS::Item $hold->{item_id});
571 #           last;
572 #       }
573 #    }
574 #
575 #    # The same hold structure is linked into both the patron's
576 #    # list of hold items and into the queue of outstanding holds
577 #    # for the item, so we don't need to search the hold queue for
578 #    # the item, since it's already been updated by the patron code.
579 #
580 #    if (!$trans->ok) {
581 #       $trans->screen_msg("No such outstanding hold.");
582 #    }
583 #
584 #    return $trans;
585 #}
586
587
588 sub renew {
589         my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
590                 $no_block, $nb_due_date, $third_party, $item_props, $fee_ack) = @_;
591
592         $self->verify_session;
593
594         my $trans = OpenILS::SIP::Transaction::Renew->new( authtoken => $self->{authtoken} );
595         $trans->patron($self->find_patron($patron_id));
596         $trans->item($self->find_item($item_id));
597
598         if(!$trans->patron) {
599                 $trans->screen_msg("Invalid patron barcode.");
600                 $trans->ok(0);
601                 return $trans;
602         }
603
604         if(!$trans->patron->renew_ok) {
605                 $trans->screen_msg("Renewals not allowed.");
606                 $trans->ok(0);
607                 return $trans;
608         }
609
610         if(!$trans->item) {
611                 if( $title_id ) {
612                         $trans->screen_msg("Title ID renewal not supported.  Use item barcode.");
613                 } else {
614                         $trans->screen_msg("Invalid item barcode.");
615                 }
616                 $trans->ok(0);
617                 return $trans;
618         }
619
620         if(!$trans->item->{patron} or 
621                         $trans->item->{patron} ne $patron_id) {
622                 $trans->screen_msg("Item not checked out to " . $trans->patron->name);
623                 $trans->ok(0);
624                 return $trans;
625         }
626
627         # Perform the renewal
628         $trans->do_renew();
629
630         $trans->desensitize(0); # It's already checked out
631         $trans->item->{due_date} = $nb_due_date if $no_block eq 'Y';
632         $trans->item->{sip_item_properties} = $item_props if $item_props;
633
634         return $trans;
635 }
636
637
638
639
640
641 #
642 #sub renew_all {
643 #    my ($self, $patron_id, $patron_pwd, $fee_ack) = @_;
644 #    my ($patron, $item_id);
645 #    my $trans;
646 #
647 #    $trans = new ILS::Transaction::RenewAll;
648 #
649 #    $trans->patron($patron = new ILS::Patron $patron_id);
650 #    if (defined $patron) {
651 #       syslog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s",
652 #              $patron->name, $patron->renew_ok);
653 #    } else {
654 #       syslog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'",
655 #              $patron_id);
656 #    }
657 #
658 #    if (!defined($patron)) {
659 #       $trans->screen_msg("Invalid patron barcode.");
660 #       return $trans;
661 #    } elsif (!$patron->renew_ok) {
662 #       $trans->screen_msg("Renewals not allowed.");
663 #       return $trans;
664 #    } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
665 #       $trans->screen_msg("Invalid patron password.");
666 #       return $trans;
667 #    }
668 #
669 #    foreach $item_id (@{$patron->{items}}) {
670 #       my $item = new ILS::Item $item_id;
671 #
672 #       if (!defined($item)) {
673 #           syslog("LOG_WARNING",
674 #                  "renew_all: Invalid item id associated with patron '%s'",
675 #                  $patron->id);
676 #           next;
677 #       }
678 #
679 #       if (@{$item->hold_queue}) {
680 #           # Can't renew if there are outstanding holds
681 #           push @{$trans->unrenewed}, $item_id;
682 #       } else {
683 #           $item->{due_date} = time + (14*24*60*60); # two weeks hence
684 #           push @{$trans->renewed}, $item_id;
685 #       }
686 #    }
687 #
688 #    $trans->ok(1);
689 #
690 #    return $trans;
691 #}
692
693 1;