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