"Fossies" - the Fresh Open Source Software Archive

Member "koha-19.11.15/C4/SIP/ILS.pm" (23 Feb 2021, 15956 Bytes) of package /linux/misc/koha-19.11.15.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "ILS.pm" see the Fossies "Dox" file reference documentation and the last Fossies "Diffs" side-by-side code changes report: 20.11.02_vs_20.11.03.

    1 #
    2 # ILS.pm: Koha ILS interface module
    3 #
    4 
    5 package C4::SIP::ILS;
    6 
    7 use warnings;
    8 use strict;
    9 use Sys::Syslog qw(syslog);
   10 use Data::Dumper;
   11 
   12 use C4::SIP::ILS::Item;
   13 use C4::SIP::ILS::Patron;
   14 use C4::SIP::ILS::Transaction;
   15 use C4::SIP::ILS::Transaction::Checkout;
   16 use C4::SIP::ILS::Transaction::Checkin;
   17 use C4::SIP::ILS::Transaction::FeePayment;
   18 use C4::SIP::ILS::Transaction::Hold;
   19 use C4::SIP::ILS::Transaction::Renew;
   20 use C4::SIP::ILS::Transaction::RenewAll;
   21 
   22 my $debug = 0;
   23 
   24 my %supports = (
   25     'magnetic media'        => 1,
   26     'security inhibit'      => 0,
   27     'offline operation'     => 0,
   28     "patron status request" => 1,
   29     "checkout"              => 1,
   30     "checkin"               => 1,
   31     "block patron"          => 1,
   32     "acs status"            => 1,
   33     "login"                 => 1,
   34     "patron information"    => 1,
   35     "end patron session"    => 1,
   36     "fee paid"              => 1,
   37     "item information"      => 1,
   38     "item status update"    => 0,
   39     "patron enable"         => 1,
   40     "hold"                  => 1,
   41     "renew"                 => 1,
   42     "renew all"             => 1,
   43 );
   44 
   45 sub new {
   46     my ($class, $institution) = @_;
   47     my $type = ref($class) || $class;
   48     my $self = {};
   49     $debug and warn "new ILS: INSTITUTION: " . Dumper($institution);
   50     syslog("LOG_DEBUG", "new ILS '%s'", $institution->{id});
   51     $self->{institution} = $institution;
   52     return bless $self, $type;
   53 }
   54 
   55 sub find_patron {
   56     my $self = shift;
   57     $debug and warn "ILS: finding patron";
   58     return C4::SIP::ILS::Patron->new(@_);
   59 }
   60 
   61 sub find_item {
   62     my $self = shift;
   63     $debug and warn "ILS: finding item";
   64     return C4::SIP::ILS::Item->new(@_);
   65 }
   66 
   67 sub institution {
   68     my $self = shift;
   69     return $self->{institution}->{id};  # consider making this return the whole institution
   70 }
   71 
   72 sub institution_id {
   73     my $self = shift;
   74     return $self->{institution}->{id};
   75 }
   76 
   77 sub supports {
   78     my ($self, $op) = @_;
   79     return (exists($supports{$op}) && $supports{$op});
   80 }
   81 
   82 sub check_inst_id {
   83     my ($self, $id, $whence) = @_;
   84     if ($id ne $self->{institution}->{id}) {
   85         syslog("LOG_WARNING", "%s: received institution '%s', expected '%s'", $whence, $id, $self->{institution}->{id});
   86         # Just an FYI check, we don't expect the user to change location from that in SIPconfig.xml
   87     }
   88 }
   89 
   90 sub to_bool {
   91     my $bool = shift;
   92     # If it's defined, and matches a true sort of string, or is
   93     # a non-zero number, then it's true.
   94     defined($bool) or return;                   # false
   95     ($bool =~ /true|y|yes/i) and return 1;      # true
   96     return ($bool =~ /^\d+$/ and $bool != 0);   # true for non-zero numbers, false otherwise
   97 }
   98 
   99 sub checkout_ok {
  100     my $self = shift;
  101     return (exists($self->{institution}->{policy}->{checkout})
  102         && to_bool($self->{institution}->{policy}->{checkout}));
  103 }
  104 sub checkin_ok {
  105     my $self = shift;
  106     return (exists($self->{institution}->{policy}->{checkin})
  107         && to_bool($self->{institution}->{policy}->{checkin}));
  108 }
  109 sub status_update_ok {
  110     my $self = shift;
  111     return (exists($self->{institution}->{policy}->{status_update})
  112         && to_bool($self->{institution}->{policy}->{status_update}));
  113 }
  114 sub offline_ok {
  115     my $self = shift;
  116     return (exists($self->{institution}->{policy}->{offline})
  117         && to_bool($self->{institution}->{policy}->{offline}));
  118 }
  119 
  120 #
  121 # Checkout(patron_id, item_id, sc_renew):
  122 #    patron_id & item_id are the identifiers send by the terminal
  123 #    sc_renew is the renewal policy configured on the terminal
  124 # returns a status opject that can be queried for the various bits
  125 # of information that the protocol (SIP or NCIP) needs to generate
  126 # the response.
  127 #
  128 sub checkout {
  129     my ( $self, $patron_id, $item_id, $sc_renew, $fee_ack ) = @_;
  130     my ( $patron, $item, $circ );
  131 
  132     $circ = C4::SIP::ILS::Transaction::Checkout->new();
  133 
  134     # BEGIN TRANSACTION
  135     $circ->patron( $patron = C4::SIP::ILS::Patron->new($patron_id) );
  136     $circ->item( $item     = C4::SIP::ILS::Item->new($item_id) );
  137     if ($fee_ack) {
  138         $circ->fee_ack($fee_ack);
  139     }
  140 
  141     if ( !$patron ) {
  142         $circ->screen_msg("Invalid Patron");
  143     }
  144     elsif ( !$patron->charge_ok ) {
  145         $circ->screen_msg("Patron Blocked");
  146     }
  147     elsif ( !$item ) {
  148         $circ->screen_msg("Invalid Item");
  149     }
  150     elsif ( $item->{borrowernumber}
  151         && !_ci_cardnumber_cmp( $item->{borrowernumber}, $patron_id ) )
  152     {
  153         $circ->screen_msg("Item checked out to another patron");
  154     }
  155     else {
  156         $circ->do_checkout();
  157         if ( $circ->ok ) {
  158             $debug and warn "circ is ok";
  159 
  160             # If the item is already associated with this patron, then
  161             # we're renewing it.
  162             $circ->renew_ok( $item->{borrowernumber}
  163                   && _ci_cardnumber_cmp( $item->{borrowernumber}, $patron_id ) );
  164 
  165             $item->{borrowernumber}   = $patron_id;
  166             $item->{due_date} = $circ->{due};
  167             push( @{ $patron->{items} }, $item_id );
  168             $circ->desensitize( !$item->magnetic_media );
  169 
  170             syslog(
  171                 "LOG_DEBUG", "ILS::Checkout: patron %s has checked out %s",
  172                 $patron_id, join( ', ', @{ $patron->{items} } )
  173             );
  174         }
  175         else {
  176             syslog( "LOG_ERR", "ILS::Checkout Issue failed" );
  177         }
  178     }
  179 
  180     # END TRANSACTION
  181 
  182     return $circ;
  183 }
  184 
  185 sub _ci_cardnumber_cmp {
  186     my ( $s1, $s2) = @_;
  187     # As the database is case insensitive we need to normalize two strings
  188     # before comparing them
  189     return ( uc($s1) eq uc($s2) );
  190 }
  191 
  192 # wrapper which allows above to be called for testing
  193 
  194 sub test_cardnumber_compare {
  195     my ($self, $str1, $str2) = @_;
  196     return _ci_cardnumber_cmp($str1, $str2);
  197 }
  198 
  199 sub checkin {
  200     my ( $self, $item_id, $trans_date, $return_date, $current_loc, $item_props, $cancel, $checked_in_ok, $cv_triggers_alert ) = @_;
  201     my ( $patron, $item, $circ );
  202 
  203     $circ = C4::SIP::ILS::Transaction::Checkin->new();
  204 
  205     # BEGIN TRANSACTION
  206     $circ->item( $item = C4::SIP::ILS::Item->new($item_id) );
  207 
  208     my $data;
  209     if ($item) {
  210         $data = $circ->do_checkin( $current_loc, $return_date, $cv_triggers_alert, $checked_in_ok );
  211     }
  212     else {
  213         $circ->alert(1);
  214         $circ->alert_type(99);
  215         $circ->ok( 0 );
  216         $circ->screen_msg('Invalid Item');
  217         return $circ;
  218     }
  219 
  220     if ( !$circ->ok && $circ->alert_type && $circ->alert_type == 98 ) { # data corruption
  221         $circ->screen_msg("Checkin failed: data problem");
  222         syslog( "LOG_WARNING", "Problem with issue_id in issues and old_issues; check the about page" );
  223     } elsif ( $data->{messages}->{withdrawn} && !$circ->ok && C4::Context->preference("BlockReturnOfWithdrawnItems") ) {
  224             $circ->screen_msg("Item withdrawn, return not allowed");
  225             syslog("LOG_DEBUG", "C4::SIP::ILS::Checkin - item withdrawn");
  226     } elsif ( $data->{messages}->{WasLost} && !$circ->ok && C4::Context->preference("BlockReturnOfLostItems") ) {
  227             $circ->screen_msg("Item lost, return not allowed");
  228             syslog("LOG_DEBUG", "C4::SIP::ILS::Checkin - item lost");
  229     } elsif ( !$item->{borrowernumber} ) {
  230         if ( $checked_in_ok ) { # Mark checkin ok although book not checked out
  231             $circ->ok( 1 );
  232             syslog("LOG_DEBUG", "C4::SIP::ILS::Checkin - using checked_in_ok");
  233         } else {
  234             $circ->screen_msg("Item not checked out");
  235             syslog("LOG_DEBUG", "C4::SIP::ILS::Checkin - item not checked out");
  236         }
  237     } elsif ( $circ->ok ) {
  238         $circ->patron( $patron = C4::SIP::ILS::Patron->new( $item->{borrowernumber} ) );
  239         delete $item->{borrowernumber};
  240         delete $item->{due_date};
  241         $patron->{items} = [ grep { $_ ne $item_id } @{ $patron->{items} } ];
  242     } else {
  243         # Checkin failed: Wrongbranch or withdrawn?
  244         # Bug 10748 with pref BlockReturnOfLostItems adds another case to come
  245         # here: returning a lost item when the pref is set.
  246         $circ->screen_msg("Checkin failed");
  247         syslog( "LOG_WARNING", "Checkin failed: probably for Wrongbranch or withdrawn" );
  248     }
  249 
  250     return $circ;
  251 }
  252 
  253 # If the ILS caches patron information, this lets it free
  254 # it up
  255 sub end_patron_session {
  256     my ($self, $patron_id) = @_;
  257 
  258     # success?, screen_msg, print_line
  259     return (1, 'Thank you !', '');
  260 }
  261 
  262 sub pay_fee {
  263     my ($self, $patron_id, $patron_pwd, $fee_amt, $fee_type, $pay_type, $fee_id, $trans_id, $currency, $is_writeoff, $disallow_overpayment ) = @_;
  264 
  265     my $trans = C4::SIP::ILS::Transaction::FeePayment->new();
  266 
  267     $trans->transaction_id($trans_id);
  268     my $patron;
  269     $trans->patron($patron = C4::SIP::ILS::Patron->new($patron_id));
  270     if (!$patron) {
  271         $trans->screen_msg('Invalid patron barcode.');
  272         return $trans;
  273     }
  274     my $ok = $trans->pay( $patron->{borrowernumber}, $fee_amt, $pay_type, $fee_id, $is_writeoff, $disallow_overpayment );
  275     $trans->ok($ok);
  276 
  277     return $trans;
  278 }
  279 
  280 sub add_hold {
  281     my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
  282     $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
  283     my ($patron, $item);
  284 
  285     my $trans = C4::SIP::ILS::Transaction::Hold->new();
  286 
  287     $patron = C4::SIP::ILS::Patron->new( $patron_id);
  288     if (!$patron
  289     || (defined($patron_pwd) && !$patron->check_password($patron_pwd))) {
  290         $trans->screen_msg("Invalid Patron.");
  291         return $trans;
  292     }
  293 
  294     unless ($item = C4::SIP::ILS::Item->new($item_id || $title_id)) {
  295         $trans->screen_msg("No such item.");
  296         return $trans;
  297     }
  298 
  299     if ( $patron->holds_blocked_by_excessive_fees() ) {
  300         $trans->screen_msg("Excessive fees blocking placement of hold.");
  301     }
  302 
  303    if ($item->fee and $fee_ack ne 'Y') {
  304         $trans->screen_msg = "Fee required to place hold.";
  305         return $trans;
  306     }
  307 
  308     my $hold = {
  309     item_id         => $item->id,
  310     patron_id       => $patron->id,
  311     expiration_date => $expiry_date,
  312     pickup_location => $pickup_location,
  313     hold_type       => $hold_type,
  314     };
  315 
  316     $trans->ok(1);
  317     $trans->patron($patron);
  318     $trans->item($item);
  319     $trans->pickup_location($pickup_location);
  320     $trans->do_hold;
  321 
  322     push(@{$item->hold_queue},     $hold);
  323     push(@{$patron->{hold_items}}, $hold);
  324 
  325     return $trans;
  326 }
  327 
  328 sub cancel_hold {
  329     my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_;
  330     my ($patron, $item, $hold);
  331 
  332     my $trans = C4::SIP::ILS::Transaction::Hold->new();
  333 
  334     $patron = C4::SIP::ILS::Patron->new( $patron_id );
  335     if (!$patron) {
  336         $trans->screen_msg("Invalid patron barcode.");
  337         return $trans;
  338     } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
  339         $trans->screen_msg('Invalid patron password.');
  340         return $trans;
  341     }
  342 
  343     unless ($item = C4::SIP::ILS::Item->new($item_id || $title_id)) {
  344         $trans->screen_msg("No such item.");
  345         return $trans;
  346     }
  347 
  348     $trans->patron($patron);
  349     $trans->item($item);
  350     $trans->drop_hold;
  351     unless ($trans->ok) {
  352         $trans->screen_msg("Error with transaction drop_hold: " . $trans->screen_msg);
  353         return $trans;
  354     }
  355     # Remove the hold from the patron's record first
  356     $trans->ok($patron->drop_hold($item_id));   # different than the transaction drop!
  357 
  358     unless ($trans->ok) {
  359         # We didn't find it on the patron record
  360         $trans->screen_msg("No such hold on patron record.");
  361         return $trans;
  362     }
  363 
  364     # Now, remove it from the item record.  If it was on the patron
  365     # record but not on the item record, we'll treat that as success.
  366     foreach my $i (0 .. scalar @{$item->hold_queue}) {
  367         $hold = $item->hold_queue->[$i];
  368         if ($item->barcode_is_borrowernumber($patron->id, $hold->{borrowernumber})) {
  369             # found it: delete it.
  370             splice @{$item->hold_queue}, $i, 1;
  371             last;       # ?? should we keep going, in case there are multiples
  372         }
  373     }
  374 
  375     $trans->screen_msg("Hold Cancelled.");
  376 
  377     return $trans;
  378 }
  379 
  380 
  381 # The patron and item id's can't be altered, but the
  382 # date, location, and type can.
  383 sub alter_hold {
  384     my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
  385     $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
  386     my ($patron, $item);
  387     my $hold;
  388     my $trans;
  389 
  390     $trans = C4::SIP::ILS::Transaction::Hold->new();
  391 
  392     # BEGIN TRANSACTION
  393     $patron = C4::SIP::ILS::Patron->new( $patron_id );
  394     unless ($patron) {
  395         $trans->screen_msg("Invalid patron barcode: '$patron_id'.");
  396         return $trans;
  397     }
  398 
  399     foreach my $i (0 .. scalar @{$patron->{hold_items}}) {
  400         $hold = $patron->{hold_items}[$i];
  401 
  402     if ($hold->{item_id} eq $item_id) {
  403         # Found it.  So fix it.
  404         $hold->{expiration_date} = $expiry_date     if $expiry_date;
  405         $hold->{pickup_location} = $pickup_location if $pickup_location;
  406         $hold->{hold_type}       = $hold_type       if $hold_type;
  407         $trans->change_hold();
  408         # $trans->ok(1);
  409         $trans->screen_msg("Hold updated.");
  410         $trans->patron($patron);
  411         $trans->item(C4::SIP::ILS::Item->new( $hold->{item_id}));
  412         last;
  413     }
  414     }
  415 
  416     # The same hold structure is linked into both the patron's
  417     # list of hold items and into the queue of outstanding holds
  418     # for the item, so we don't need to search the hold queue for
  419     # the item, since it's already been updated by the patron code.
  420 
  421     if (!$trans->ok) {
  422         $trans->screen_msg("No such outstanding hold.");
  423     }
  424 
  425     return $trans;
  426 }
  427 
  428 sub renew {
  429     my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
  430     $no_block, $nb_due_date, $third_party,
  431     $item_props, $fee_ack) = @_;
  432     my ($patron, $item);
  433     my $trans;
  434 
  435     $trans = C4::SIP::ILS::Transaction::Renew->new();
  436     $trans->patron($patron = C4::SIP::ILS::Patron->new( $patron_id ));
  437 
  438     if (!$patron) {
  439         $trans->screen_msg("Invalid patron barcode.");
  440         return $trans;
  441     } elsif (!$patron->renew_ok) {
  442         $trans->screen_msg("Renewals not allowed.");
  443         return $trans;
  444     }
  445 
  446     # Previously: renewing a title, rather than an item (sort of)
  447     # This is gross, but in a real ILS it would be better
  448 
  449     # if (defined($title_id)) {
  450     #   foreach my $i (@{$patron->{items}}) {
  451     #       $item = new ILS::Item $i;
  452     #       last if ($title_id eq $item->title_id);
  453     #       $item = undef;
  454     #   }
  455     # } else {
  456         my $j = 0;
  457         my $count = scalar @{$patron->{items}};
  458         foreach my $i (@{$patron->{items}}) {
  459             unless (defined $i->{barcode}) {    # FIXME: using data instead of objects may violate the abstraction layer
  460                 syslog("LOG_ERR", "No barcode for item %s of %s: $item_id", $j+1, $count);
  461                 next;
  462             }
  463             syslog("LOG_DEBUG", "checking item %s of %s: $item_id vs. %s", ++$j, $count, $i->{barcode});
  464             if ($i->{barcode} eq $item_id) {
  465                 # We have it checked out
  466                 $item = C4::SIP::ILS::Item->new( $item_id );
  467                 last;
  468             }
  469         }
  470     # }
  471 
  472     $trans->item($item);
  473 
  474     if (!defined($item)) {
  475         $trans->screen_msg("Item not checked out to " . $patron->name);     # not checked out to $patron_id
  476         $trans->ok(0);
  477     } else {
  478         $trans->do_renew();
  479         if ($trans->renewal_ok()) {
  480             $item->{due_date} = $trans->{due};
  481             $trans->desensitize(0);
  482         }
  483     }
  484 
  485     return $trans;
  486 }
  487 
  488 sub renew_all {
  489     my ($self, $patron_id, $patron_pwd, $fee_ack) = @_;
  490     my ($patron, $item_id);
  491     my $trans;
  492 
  493     $trans = C4::SIP::ILS::Transaction::RenewAll->new();
  494 
  495     $trans->patron($patron = C4::SIP::ILS::Patron->new( $patron_id ));
  496     if (defined $patron) {
  497         syslog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s", $patron->name, $patron->renew_ok);
  498     } else {
  499         syslog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'", $patron_id);
  500     }
  501 
  502     if (!defined($patron)) {
  503         $trans->screen_msg("Invalid patron barcode.");
  504         return $trans;
  505     } elsif (!$patron->renew_ok) {
  506         $trans->screen_msg("Renewals not allowed.");
  507         return $trans;
  508     } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
  509         $trans->screen_msg("Invalid patron password.");
  510         return $trans;
  511     }
  512 
  513     $trans->do_renew_all;
  514     $trans->ok(1);
  515     return $trans;
  516 }
  517 
  518 1;
  519 __END__
  520