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;