adding hold verification support per copy_location
[Evergreen.git] / Open-ILS / src / perlmods / 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
10 use OpenILS::SIP::Item;
11 use OpenILS::SIP::Patron;
12 use OpenILS::SIP::Transaction;
13 use OpenILS::SIP::Transaction::Checkout;
14 use OpenILS::SIP::Transaction::Checkin;
15 use OpenILS::SIP::Transaction::Renew;
16
17 use OpenSRF::System;
18 use OpenILS::Utils::Fieldmapper;
19 use OpenSRF::Utils::SettingsClient;
20 use OpenILS::Application::AppUtils;
21 use OpenSRF::Utils qw/:datetime/;
22 use DateTime::Format::ISO8601;
23 my $U = 'OpenILS::Application::AppUtils';
24
25 my $editor;
26 my $config;
27
28 use Digest::MD5 qw(md5_hex);
29
30 sub new {
31         my ($class, $institution, $login) = @_;
32         my $type = ref($class) || $class;
33         my $self = {};
34
35         $self->{login} = $login;
36
37         $config = $institution;
38         syslog("LOG_DEBUG", "OILS: new ILS '%s'", $institution->{id});
39         $self->{institution} = $institution;
40
41         my $bsconfig = $institution->{implementation_config}->{bootstrap};
42
43         syslog('LOG_DEBUG', "OILS: loading bootstrap config: $bsconfig");
44         
45         local $/ = "\n";
46         OpenSRF::System->bootstrap_client(config_file => $bsconfig);
47         syslog('LOG_DEBUG', "OILS: bootstrap loaded..");
48
49         $self->{osrf_config} = OpenSRF::Utils::SettingsClient->new;
50
51         Fieldmapper->import($self->{osrf_config}->config_value('IDL'));
52
53         bless( $self, $type );
54
55         return undef unless 
56                 $self->login( $login->{id}, $login->{password} );
57
58         return $self;
59 }
60
61 sub verify_session {
62         my $self = shift;
63         my $ses = $U->simplereq( 
64                 'open-ils.auth',
65                 'open-ils.auth.session.retrieve',  $self->{authtoken} );
66         return 1 unless $U->event_code($ses);
67         syslog('LOG_INFO', "OILS: Logging back after session timeout as user ".$self->{login}->{id});
68         return $self->login( $self->{login}->{id}, $self->{login}->{password} );
69 }
70
71 sub to_bool {
72         my $val = shift;
73         return ($val and $val =~ /true/io);
74 }
75
76 sub editor {
77         return $editor 
78                 if $editor and $editor->{session}
79                 and $editor->session->connected;
80         return $editor = make_editor();
81 }
82
83 sub reset_editor {
84         $editor = undef;
85         return editor();
86 }
87
88 sub config {
89         return $config;
90 }
91
92
93 # Creates the global editor object
94 sub make_editor {
95         require OpenILS::Utils::CStoreEditor;
96         my $e = OpenILS::Utils::CStoreEditor->new(xact => 1);
97         # gnarly cstore hack to re-gen autogen methods after IDL is loaded
98         if(!UNIVERSAL::can($e, 'search_actor_card')) {
99                 syslog("LOG_WARNING", "OILS: Reloading CStoreEditor...");
100                 delete $INC{'OpenILS/Utils/CStoreEditor.pm'};
101                 require OpenILS::Utils::CStoreEditor;
102                 $e = OpenILS::Utils::CStoreEditor->new(xact =>1);
103         }
104         return $e;
105 }
106
107 sub format_date {
108         my $class = shift;
109         my $date = shift;
110         my $type = shift || 'dob';
111
112         return "" unless $date;
113
114         $date = DateTime::Format::ISO8601->new->
115                 parse_datetime(OpenSRF::Utils::clense_ISO8601($date));
116         my @time = localtime($date->epoch);
117
118         my $year = $time[5]+1900;
119         my $mon = $time[4]+1;
120         my $day = $time[3];
121
122         $mon =~ s/^(\d)$/0$1/;
123         $day =~ s/^(\d)$/0$1/;
124         $date = "$year$mon$day";
125
126         $date = $year.'-'.$mon.'-'.$day .' 00:00:00' if $type eq 'due';
127         #$date = $year.'-'.$mon.'-'.$day if $type eq 'due';
128
129         syslog('LOG_DEBUG', "OILS: formatted date [type=$type]: $date");
130         return $date;
131 }
132
133
134
135 sub login {
136         my( $self, $username, $password ) = @_;
137         syslog('LOG_DEBUG', "OILS: Logging in with username $username");
138
139         my $seed = $U->simplereq( 
140                 'open-ils.auth',
141                 'open-ils.auth.authenticate.init', $username );
142
143         my $response = $U->simplereq(
144                 'open-ils.auth', 
145                 'open-ils.auth.authenticate.complete', 
146                 {       
147                         username => $username, 
148                         password => md5_hex($seed . md5_hex($password)), 
149                         type            => 'opac',
150                 }
151         );
152
153         if( my $code = $U->event_code($response) ) {
154                 my $txt = $response->{textcode};
155                 syslog('LOG_WARNING', "OILS: Login failed for $username.  $txt:$code");
156                 return undef;
157         }
158
159         my $key = $response->{payload}->{authtoken};
160         syslog('LOG_INFO', "OILS: Login succeeded for $username : authkey = $key");
161         return $self->{authtoken} = $key;
162 }
163
164
165 sub find_patron {
166         my $self = shift;
167         return OpenILS::SIP::Patron->new(@_);
168 }
169
170
171 sub find_item {
172         my $self = shift;
173         return OpenILS::SIP::Item->new(@_);
174 }
175
176
177 sub institution {
178     my $self = shift;
179     return $self->{institution}->{id};
180 }
181
182 sub supports {
183         my ($self, $op) = @_;
184         my ($i) = grep { $_->{name} eq $op }  
185                 @{$config->{implementation_config}->{supports}->{item}};
186         return to_bool($i->{value});
187 }
188
189 sub check_inst_id {
190         my ($self, $id, $whence) = @_;
191         if ($id ne $self->{institution}->{id}) {
192                 syslog("LOG_WARNING", 
193                         "OILS: %s: received institution '%s', expected '%s'",
194                         $whence, $id, $self->{institution}->{id});
195         }
196 }
197
198 sub checkout_ok {
199         return to_bool($config->{policy}->{checkout});
200 }
201
202 sub checkin_ok {
203         return to_bool($config->{policy}->{checkin});
204     return 0;
205 }
206
207 sub renew_ok {
208         return to_bool($config->{policy}->{renew});
209 }
210
211 sub status_update_ok {
212         return to_bool($config->{policy}->{status_update});
213 }
214
215 sub offline_ok {
216         return to_bool($config->{policy}->{offline});
217 }
218
219
220
221 ##
222 ## Checkout(patron_id, item_id, sc_renew):
223 ##    patron_id & item_id are the identifiers send by the terminal
224 ##    sc_renew is the renewal policy configured on the terminal
225 ## returns a status opject that can be queried for the various bits
226 ## of information that the protocol (SIP or NCIP) needs to generate
227 ## the response.
228 ##
229
230 sub checkout {
231         my ($self, $patron_id, $item_id, $sc_renew) = @_;
232
233         $self->verify_session;
234         
235         syslog('LOG_DEBUG', "OILS: OpenILS::Checkout attempt: patron=$patron_id, item=$item_id");
236         
237         my $xact                = OpenILS::SIP::Transaction::Checkout->new( authtoken => $self->{authtoken} );
238         my $patron      = $self->find_patron($patron_id);
239         my $item                = $self->find_item($item_id);
240         
241         $xact->patron($patron);
242         $xact->item($item);
243
244         if (!$patron) {
245                 $xact->screen_msg("Invalid Patron");
246                 return $xact;
247         }
248
249         if (!$patron->charge_ok) {
250                 $xact->screen_msg("Patron Blocked");
251                 return $xact;
252         }
253
254         if( !$item ) {
255                 $xact->screen_msg("Invalid Item");
256                 return $xact;
257         }
258
259         syslog('LOG_DEBUG', "OILS: OpenILS::Checkout data loaded OK, checking out...");
260         $xact->do_checkout();
261
262         if ($item->{patron} && ($item->{patron} ne $patron_id)) {
263                 # I can't deal with this right now
264                 # XXX check in then check out?
265                 $xact->screen_msg("Item checked out to another patron");
266                 $xact->ok(0);
267         } 
268
269         $xact->desensitize(!$item->magnetic);
270
271         if( $xact->ok ) {
272
273                 #editor()->commit;
274                 syslog("LOG_DEBUG", "OILS: OpenILS::Checkout: " .
275                         "patron %s checkout %s succeeded", $patron_id, $item_id);
276
277         } else {
278
279                 #editor()->xact_rollback;
280                 syslog("LOG_DEBUG", "OILS: OpenILS::Checkout: " .
281                         "patron %s checkout %s FAILED, rolling back xact...", $patron_id, $item_id);
282         }
283
284         return $xact;
285 }
286
287
288 sub checkin {
289         my ($self, $item_id, $trans_date, $return_date,
290         $current_loc, $item_props, $cancel) = @_;
291
292         $self->verify_session;
293
294         syslog('LOG_DEBUG', "OILS: OpenILS::Checkin on item=$item_id");
295         
296         my $patron;
297         my $xact                = OpenILS::SIP::Transaction::Checkin->new(authtoken => $self->{authtoken});
298         my $item                = $self->find_item($item_id);
299
300         $xact->item($item);
301
302         if(!$xact->item) {
303                 $xact->screen_msg("Invalid item barcode: $item_id");
304                 $xact->ok(0);
305                 return $xact;
306         }
307
308         $xact->do_checkin( $trans_date, $return_date, $current_loc, $item_props );
309         
310         if ($xact->ok) {
311
312                 $xact->patron($patron = $self->find_patron($item->{patron}));
313                 delete $item->{patron};
314                 delete $item->{due_date};
315                 syslog('LOG_INFO', "OILS: Checkin succeeded");
316                 #editor()->commit;
317
318         } else {
319
320                 #editor()->xact_rollback;
321                 syslog('LOG_WARNING', "OILS: Checkin failed");
322         }
323         # END TRANSACTION
324
325         return $xact;
326 }
327
328 ## If the ILS caches patron information, this lets it free it up
329 sub end_patron_session {
330     my ($self, $patron_id) = @_;
331     return (1, 'Thank you for using OpenILS!', '');
332 }
333
334
335 #sub pay_fee {
336 #    my ($self, $patron_id, $patron_pwd, $fee_amt, $fee_type,
337 #       $pay_type, $fee_id, $trans_id, $currency) = @_;
338 #    my $trans;
339 #    my $patron;
340 #
341 #    $trans = new ILS::Transaction::FeePayment;
342 #
343 #    $patron = new ILS::Patron $patron_id;
344 #
345 #    $trans->transaction_id($trans_id);
346 #    $trans->patron($patron);
347 #    $trans->ok(1);
348 #
349 #    return $trans;
350 #}
351 #
352 #sub add_hold {
353 #    my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
354 #       $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
355 #    my ($patron, $item);
356 #    my $hold;
357 #    my $trans;
358 #
359 #
360 #    $trans = new ILS::Transaction::Hold;
361 #
362 #    # BEGIN TRANSACTION
363 #    $patron = new ILS::Patron $patron_id;
364 #    if (!$patron
365 #       || (defined($patron_pwd) && !$patron->check_password($patron_pwd))) {
366 #       $trans->screen_msg("Invalid Patron.");
367 #
368 #       return $trans;
369 #    }
370 #
371 #    $item = new ILS::Item ($item_id || $title_id);
372 #    if (!$item) {
373 #       $trans->screen_msg("No such item.");
374 #
375 #       # END TRANSACTION (conditionally)
376 #       return $trans;
377 #    } elsif ($item->fee && ($fee_ack ne 'Y')) {
378 #       $trans->screen_msg = "Fee required to place hold.";
379 #
380 #       # END TRANSACTION (conditionally)
381 #       return $trans;
382 #    }
383 #
384 #    $hold = {
385 #       item_id         => $item->id,
386 #       patron_id       => $patron->id,
387 #       expiration_date => $expiry_date,
388 #       pickup_location => $pickup_location,
389 #       hold_type       => $hold_type,
390 #    };
391 #
392 #    $trans->ok(1);
393 #    $trans->patron($patron);
394 #    $trans->item($item);
395 #    $trans->pickup_location($pickup_location);
396 #
397 #    push(@{$item->hold_queue}, $hold);
398 #    push(@{$patron->{hold_items}}, $hold);
399 #
400 #
401 #    # END TRANSACTION
402 #    return $trans;
403 #}
404 #
405 #sub cancel_hold {
406 #    my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_;
407 #    my ($patron, $item, $hold);
408 #    my $trans;
409 #
410 #    $trans = new ILS::Transaction::Hold;
411 #
412 #    # BEGIN TRANSACTION
413 #    $patron = new ILS::Patron $patron_id;
414 #    if (!$patron) {
415 #       $trans->screen_msg("Invalid patron barcode.");
416 #
417 #       return $trans;
418 #    } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
419 #       $trans->screen_msg('Invalid patron password.');
420 #
421 #       return $trans;
422 #    }
423 #
424 #    $item = new ILS::Item ($item_id || $title_id);
425 #    if (!$item) {
426 #       $trans->screen_msg("No such item.");
427 #
428 #       # END TRANSACTION (conditionally)
429 #       return $trans;
430 #    }
431 #
432 #    # Remove the hold from the patron's record first
433 #    $trans->ok($patron->drop_hold($item_id));
434 #
435 #    if (!$trans->ok) {
436 #       # We didn't find it on the patron record
437 #       $trans->screen_msg("No such hold on patron record.");
438 #
439 #       # END TRANSACTION (conditionally)
440 #       return $trans;
441 #    }
442 #
443 #    # Now, remove it from the item record.  If it was on the patron
444 #    # record but not on the item record, we'll treat that as success.
445 #    foreach my $i (0 .. scalar @{$item->hold_queue}) {
446 #       $hold = $item->hold_queue->[$i];
447 #
448 #       if ($hold->{patron_id} eq $patron->id) {
449 #           # found it: delete it.
450 #           splice @{$item->hold_queue}, $i, 1;
451 #           last;
452 #       }
453 #    }
454 #
455 #    $trans->screen_msg("Hold Cancelled.");
456 #    $trans->patron($patron);
457 #    $trans->item($item);
458 #
459 #    return $trans;
460 #}
461 #
462 #
463 ## The patron and item id's can't be altered, but the
464 ## date, location, and type can.
465 #sub alter_hold {
466 #    my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
467 #       $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
468 #    my ($patron, $item);
469 #    my $hold;
470 #    my $trans;
471 #
472 #    $trans = new ILS::Transaction::Hold;
473 #
474 #    # BEGIN TRANSACTION
475 #    $patron = new ILS::Patron $patron_id;
476 #    if (!$patron) {
477 #       $trans->screen_msg("Invalid patron barcode.");
478 #
479 #       return $trans;
480 #    }
481 #
482 #    foreach my $i (0 .. scalar @{$patron->{hold_items}}) {
483 #       $hold = $patron->{hold_items}[$i];
484 #
485 #       if ($hold->{item_id} eq $item_id) {
486 #           # Found it.  So fix it.
487 #           $hold->{expiration_date} = $expiry_date if $expiry_date;
488 #           $hold->{pickup_location} = $pickup_location if $pickup_location;
489 #           $hold->{hold_type} = $hold_type if $hold_type;
490 #
491 #           $trans->ok(1);
492 #           $trans->screen_msg("Hold updated.");
493 #           $trans->patron($patron);
494 #           $trans->item(new ILS::Item $hold->{item_id});
495 #           last;
496 #       }
497 #    }
498 #
499 #    # The same hold structure is linked into both the patron's
500 #    # list of hold items and into the queue of outstanding holds
501 #    # for the item, so we don't need to search the hold queue for
502 #    # the item, since it's already been updated by the patron code.
503 #
504 #    if (!$trans->ok) {
505 #       $trans->screen_msg("No such outstanding hold.");
506 #    }
507 #
508 #    return $trans;
509 #}
510
511
512 sub renew {
513         my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
514                 $no_block, $nb_due_date, $third_party, $item_props, $fee_ack) = @_;
515
516         $self->verify_session;
517
518         my $trans = OpenILS::SIP::Transaction::Renew->new( authtoken => $self->{authtoken} );
519         $trans->patron($self->find_patron($patron_id));
520         $trans->item($self->find_item($item_id));
521
522         if(!$trans->patron) {
523                 $trans->screen_msg("Invalid patron barcode.");
524                 $trans->ok(0);
525                 return $trans;
526         }
527
528         if(!$trans->patron->renew_ok) {
529                 $trans->screen_msg("Renewals not allowed.");
530                 $trans->ok(0);
531                 return $trans;
532         }
533
534         if(!$trans->item) {
535                 if( $title_id ) {
536                         $trans->screen_msg("Item Id renewal not supported.");
537                 } else {
538                         $trans->screen_msg("Invalid item barcode.");
539                 }
540                 $trans->ok(0);
541                 return $trans;
542         }
543
544         if(!$trans->item->{patron} or 
545                         $trans->item->{patron} ne $patron_id) {
546                 $trans->screen_msg("Item not checked out to " . $trans->patron->name);
547                 $trans->ok(0);
548                 return $trans;
549         }
550
551         # Perform the renewal
552         $trans->do_renew();
553
554         $trans->desensitize(0); # It's already checked out
555         $trans->item->{due_date} = $nb_due_date if $no_block eq 'Y';
556         $trans->item->{sip_item_properties} = $item_props if $item_props;
557
558         return $trans;
559 }
560
561
562
563
564
565 #
566 #sub renew_all {
567 #    my ($self, $patron_id, $patron_pwd, $fee_ack) = @_;
568 #    my ($patron, $item_id);
569 #    my $trans;
570 #
571 #    $trans = new ILS::Transaction::RenewAll;
572 #
573 #    $trans->patron($patron = new ILS::Patron $patron_id);
574 #    if (defined $patron) {
575 #       syslog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s",
576 #              $patron->name, $patron->renew_ok);
577 #    } else {
578 #       syslog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'",
579 #              $patron_id);
580 #    }
581 #
582 #    if (!defined($patron)) {
583 #       $trans->screen_msg("Invalid patron barcode.");
584 #       return $trans;
585 #    } elsif (!$patron->renew_ok) {
586 #       $trans->screen_msg("Renewals not allowed.");
587 #       return $trans;
588 #    } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
589 #       $trans->screen_msg("Invalid patron password.");
590 #       return $trans;
591 #    }
592 #
593 #    foreach $item_id (@{$patron->{items}}) {
594 #       my $item = new ILS::Item $item_id;
595 #
596 #       if (!defined($item)) {
597 #           syslog("LOG_WARNING",
598 #                  "renew_all: Invalid item id associated with patron '%s'",
599 #                  $patron->id);
600 #           next;
601 #       }
602 #
603 #       if (@{$item->hold_queue}) {
604 #           # Can't renew if there are outstanding holds
605 #           push @{$trans->unrenewed}, $item_id;
606 #       } else {
607 #           $item->{due_date} = time + (14*24*60*60); # two weeks hence
608 #           push @{$trans->renewed}, $item_id;
609 #       }
610 #    }
611 #
612 #    $trans->ok(1);
613 #
614 #    return $trans;
615 #}
616
617 1;