Attachment #103501 for bug #15253

View | Details | Raw Unified | Return to bug 15253
Collapse All | Expand All





use warnings;
use strict;
use C4::SIP::Sip qw(siplog);
use Data::Dumper;

use C4::SIP::ILS::Item;

    my $type = ref($class) || $class;
    my $self = {};
	$debug and warn "new ILS: INSTITUTION: " . Dumper($institution);
    siplog("LOG_DEBUG", "new ILS '%s'", $institution->{id});
    $self->{institution} = $institution;
    return bless $self, $type;
}

sub check_inst_id {
    my ($self, $id, $whence) = @_;
    if ($id ne $self->{institution}->{id}) {
        siplog("LOG_WARNING", "%s: received institution '%s', expected '%s'", $whence, $id, $self->{institution}->{id});
        # Just an FYI check, we don't expect the user to change location from that in SIPconfig.xml
    }
}

            push( @{ $patron->{items} }, { barcode => $item_id } );
            $circ->desensitize( !$item->magnetic_media );

            siplog(
                "LOG_DEBUG", "ILS::Checkout: patron %s has checked out %s",
                $patron_id, join( ', ', map{ $_->{barcode} } @{ $patron->{items} } )
            );
        }
        else {
            siplog( "LOG_ERR", "ILS::Checkout Issue failed" );
        }
    }



    if ( !$circ->ok && $circ->alert_type && $circ->alert_type == 98 ) { # data corruption
        $circ->screen_msg("Checkin failed: data problem");
        siplog( "LOG_WARNING", "Problem with issue_id in issues and old_issues; check the about page" );
    } elsif ( $data->{messages}->{withdrawn} && !$circ->ok ) {
            $circ->screen_msg("Item withdrawn, return not allowed");
            siplog("LOG_DEBUG", "C4::SIP::ILS::Checkin - item withdrawn");
    } elsif ( $data->{messages}->{WasLost} && !$circ->ok ) {
            $circ->screen_msg("Item lost, return not allowed");
            siplog("LOG_DEBUG", "C4::SIP::ILS::Checkin - item lost");
    } elsif ( !$item->{patron} ) {
        if ( $checked_in_ok ) { # Mark checkin ok although book not checked out
            $circ->ok( 1 );
            siplog("LOG_DEBUG", "C4::SIP::ILS::Checkin - using checked_in_ok");
        } else {
            $circ->screen_msg("Item not checked out");
            siplog("LOG_DEBUG", "C4::SIP::ILS::Checkin - item not checked out");
        }
    } elsif ( $circ->ok ) {
        $circ->patron( $patron = C4::SIP::ILS::Patron->new( $item->{patron} ) );

        # Bug 10748 with pref BlockReturnOfLostItems adds another case to come
        # here: returning a lost item when the pref is set.
        $circ->screen_msg("Checkin failed");
        siplog( "LOG_WARNING", "Checkin failed: probably for Wrongbranch or withdrawn" );
    }

    return $circ;

		my $count = scalar @{$patron->{items}};
		foreach my $i (@{$patron->{items}}) {
            unless (defined $i->{barcode}) {    # FIXME: using data instead of objects may violate the abstraction layer
                siplog("LOG_ERR", "No barcode for item %s of %s: $item_id", $j+1, $count);
                next;
            }
            siplog("LOG_DEBUG", "checking item %s of %s: $item_id vs. %s", ++$j, $count, $i->{barcode});
            if ($i->{barcode} eq $item_id) {
				# We have it checked out
				$item = C4::SIP::ILS::Item->new( $item_id );


    $trans->patron($patron = C4::SIP::ILS::Patron->new( $patron_id ));
    if (defined $patron) {
        siplog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s", $patron->name, $patron->renew_ok);
    } else {
        siplog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'", $patron_id);
    }

    if (!defined($patron)) {




use strict;
use warnings;

use C4::SIP::Sip qw(siplog);
use Carp;
use Template;


    my $type = ref($class) || $class;
    my $item = Koha::Items->find( { barcode => barcodedecode( $item_id ) } );
    unless ( $item ) {
        siplog("LOG_DEBUG", "new ILS::Item('%s'): not found", $item_id);
        warn "new ILS::Item($item_id) : No item '$item_id'.";
        return;
    }

    $self->{author} = $biblio->author;
    bless $self, $type;

    siplog( "LOG_DEBUG", "new ILS::Item('%s'): found with title '%s'",
        $item_id, $self->{title} // '' );

    return $self;


    my $holder = Koha::Patrons->find( $borrowernumber );
    unless ($holder) {
        siplog("LOG_ERR", "While checking hold, failed to retrieve the patron with borrowernumber '$borrowernumber'");
        return;
    }
    my $email = $holder->email || '';




use Exporter;
use Carp;

use C4::SIP::Sip qw(siplog);
use Data::Dumper;

use C4::SIP::Sip qw(add_field maybe_add);

      || Koha::Patrons->find( { userid => $patron_id } );
    $debug and warn "new Patron: " . Dumper($patron->unblessed) if $patron;
    unless ($patron) {
        siplog("LOG_DEBUG", "new ILS::Patron(%s): no such patron", $patron_id);
        return;
    }
    $kp = $patron->unblessed;


    $self = \%ilspatron;
    $debug and warn Dumper($self);
    siplog("LOG_DEBUG", "new ILS::Patron(%s): found patron '%s'", $patron_id,$self->{id});
    bless $self, $type;
    return $self;
}

            $tt->process( \$template, { patron => $patron }, \$output );
        };
        if ( $@ ){
            siplog("LOG_DEBUG", "Error processing template: $template");
            return "";
        }
        return $output;

    foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet') {
        $self->{$field} = 1;
    }
    siplog("LOG_DEBUG", "Patron(%s)->enable: charge: %s, renew:%s, recall:%s, hold:%s",
       $self->{id}, $self->{charge_ok}, $self->{renew_ok},
       $self->{recall_ok}, $self->{hold_ok});
    $self->{screen_msg} = "Enable feature not implemented."; # "All privileges restored.";   # TODO: not really affecting patron record




use strict;

use POSIX qw(strftime);
use C4::SIP::Sip qw(siplog);
use Data::Dumper;
use CGI qw ( -utf8 );



sub do_checkout {
	my $self = shift;
	siplog('LOG_DEBUG', "ILS::Transaction::Checkout performing checkout...");
	my $shelf          = $self->{item}->hold_shelf;
	my $barcode        = $self->{item}->id;
	my $patron_barcode = $self->{patron}->id;

                # We've been returned a case other than those above
                $self->screen_msg("Item cannot be issued: $confirmation");
                $noerror = 0;
                siplog('LOG_DEBUG', "Blocking checkout Reason:$confirmation");
                last;
            }
        }

Lines 6-12 package C4::SIP::ILS::Transaction::RenewAll; Link Here

(-)a/C4/SIP/ILS/Transaction/RenewAll.pm (-2 / +2 lines)
6	use strict;	6	use strict;
7	use warnings;	7	use warnings;
8		8
9	use C4::SIP::Sip qw(syslog);	9	use C4::SIP::Sip qw(siplog);
10		10
11	use C4::SIP::ILS::Item;	11	use C4::SIP::ILS::Item;
12		12
Lines 42-48 sub do_renew_all { Link Here
42	my $item_id = $itemx->{barcode};	42	my $item_id = $itemx->{barcode};
43	my $item = C4::SIP::ILS::Item->new($item_id);	43	my $item = C4::SIP::ILS::Item->new($item_id);
44	if ( !defined($item) ) {	44	if ( !defined($item) ) {
45	syslog(	45	siplog(
46	'LOG_WARNING',	46	'LOG_WARNING',
47	q\|renew_all: Invalid item id '%s' associated with patron '%s'\|,	47	q\|renew_all: Invalid item id '%s' associated with patron '%s'\|,
48	$item_id,	48	$item_id,

Lines 14-24 perl modules to run: Link Here

(-)a/C4/SIP/README (-7 / +1 lines)
14		14
15	LOGGING	15	LOGGING
16		16
17	SIPServer uses syslog() for status and debugging messages. All	17	SIPServer uses Koha::Logger for status and debugging messages.
18	syslog messages are logged using the syslog facility 'local6'.
19	If you need to change this, because something else on your system
20	is already using that facililty, just change the definition of
21	'LOG_SIP' at the top of the file SIPServer.pm
22		18
23	Make sure to update your syslog configuration to capture facility
24	'local6' and record it.




require UNIVERSAL::require;

use C4::Context;
use C4::SIP::Sip qw(siplog);
use C4::SIP::Sip::Constants qw(:all);
use C4::SIP::Sip::Configuration;
use C4::SIP::Sip::Checksum qw(checksum verify_cksum);

    $self->{service} = $config->find_service($sockaddr, $port, $proto);

    if (!defined($self->{service})) {
		siplog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto);
		die "process_request: Bad server connection";
    }

    $transport = $transports{$self->{service}->{transport}};

    if (!defined($transport)) {
		siplog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport});
		return;
    } else {
		&$transport($self);

    # In practice it should only iterate once but be prepared
    local $SIG{ALRM} = sub { die 'raw transport Timed Out!' };
    my $timeout = $self->get_timeout({ transport => 1 });
    siplog('LOG_DEBUG', "raw_transport: timeout is $timeout");
    alarm $timeout;
    while (!$self->{account}) {
        $input = read_request();
        if (!$input) {
            # EOF on the socket
            siplog("LOG_INFO", "raw_transport: shutting down: EOF during login");
            return;
        }
        $input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s)

    Log::Log4perl::MDC->put( "accountid", $self->{account}->{id} );
    Log::Log4perl::MDC->put( "peeraddr",  $self->{server}->{peeraddr} );

    siplog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",
        $self->{account}->{id},
        $self->{account}->{institution});
    if (! $self->{account}->{id}) {
        siplog("LOG_ERR","Login failed shutting down");
        return;
    }

    $self->sip_protocol_loop();
    siplog("LOG_INFO", "raw_transport: shutting down");
    return;
}

sub get_clean_string {
	my $string = shift;
	if (defined $string) {
		siplog("LOG_DEBUG", "get_clean_string  pre-clean(length %s): %s", length($string), $string);
		chomp($string);
		$string =~ s/^[^A-z0-9]+//;
		$string =~ s/[^A-z0-9]+$//;
		siplog("LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string);
	} else {
		siplog("LOG_INFO", "get_clean_string called on undefined");
	}
	return $string;
}

	my $in = <STDIN>;
	$in = get_clean_string($in);
	while (my $extra = <STDIN>){
		siplog("LOG_ERR", "get_clean_input got extra lines: %s", $extra);
	}
	return $in;
}

    my $input;
    my $config  = $self->{config};
    my $timeout = $self->get_timeout({ transport => 1 });
    siplog("LOG_DEBUG", "telnet_transport: timeout is $timeout");

    eval {
	local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; };

		$pwd = <STDIN>;
		alarm 0;

		siplog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd));
		$uid = get_clean_string ($uid);
		$pwd = get_clean_string ($pwd);
		siplog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd));

	    if (exists ($config->{accounts}->{$uid})
		&& ($pwd eq $config->{accounts}->{$uid}->{password})) {

                last;
            }
	    }
		siplog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||''));
		print("Invalid login$CRLF");
	}
    }; # End of eval

    if ($@) {
		siplog("LOG_ERR", "telnet_transport: Login timed out");
		die "Telnet Login Timed out";
    } elsif (!defined($account)) {
		siplog("LOG_ERR", "telnet_transport: Login Failed");
		die "Login Failure";
    } else {
		print "Login OK.  Initiating SIP$CRLF";
    }

    $self->{account} = $account;
    siplog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution});
    $self->sip_protocol_loop();
    siplog("LOG_INFO", "telnet_transport: shutting down");
    return;
}


    # In short, we'll take any valid message here.
    eval {
        local $SIG{ALRM} = sub {
            siplog( 'LOG_DEBUG', 'Inactive: timed out' );
            die "Timed Out!\n";
        };
        my $previous_alarm = alarm($timeout);

            alarm($timeout);

            unless ($inputbuf) {
                siplog( "LOG_ERR", "sip_protocol_loop: empty input skipped" );
                print("96$CR");
                next;
            }

            my $status = C4::SIP::Sip::MsgType::handle( $inputbuf, $self, q{} );
            if ( !$status ) {
                siplog(
                    "LOG_ERR",
                    "sip_protocol_loop: failed to handle %s",
                    substr( $inputbuf, 0, 2 )

    # treat as one line to include the extra linebreaks we are trying to remove!
      }
      else {
          siplog( 'LOG_DEBUG', 'EOF returned on read' );
          return;
      }
      my $len = length $buffer;
      if ( $len != $raw_length ) {
          my $trim = $raw_length - $len;
          siplog( 'LOG_DEBUG', "read_request trimmed $trim character(s) " );
      }

      siplog( 'LOG_INFO', "INPUT MSG: '$buffer'" );
      return $buffer;
}


        my $policy = $server->{policy} // {};
        my $rv = sprintf( "%03d", $policy->{timeout} // 0 );
        if( length($rv) != 3 ) {
            siplog( "LOG_ERR", "Policy timeout has wrong size: '%s'", $rv );
            return '000';
        }
        return $rv;




our @EXPORT_OK = qw(y_or_n timestamp add_field maybe_add add_count
    denied sipbool boolspace write_msg
    $error_detection $protocol_version $field_delimiter
    $last_response siplog);

our %EXPORT_TAGS = (
    all => [qw(y_or_n timestamp add_field maybe_add
        add_count denied sipbool boolspace write_msg
        $error_detection $protocol_version
        $field_delimiter $last_response siplog)]);

our $error_detection = 0;
our $protocol_version = 1;

    my ($i, $ent);

    if (!defined($value)) {
	siplog("LOG_DEBUG", "add_field: Undefined value being added to '%s'",
	       $field_id);
		$value = '';
    }


    $count = sprintf("%04d", $count);
    if (length($count) != 4) {
		siplog("LOG_WARNING", "handle_patron_info: %s wrong size: '%s'",
	       $label, $count);
		$count = ' ' x 4;
    }

    } else {
        STDOUT->autoflush(1);
        print $msg, $terminator;
        siplog("LOG_INFO", "OUTPUT MSG: '$msg'");
    }

    $last_response = $msg;
}

sub siplog {
    my ( $level, $mask, @args ) = @_;

    my $method =

Lines 10-16 use strict; Link Here

(-)a/C4/SIP/Sip/Configuration.pm (-2 / +2 lines)
10	use warnings;	10	use warnings;
11	use XML::Simple qw(:strict);	11	use XML::Simple qw(:strict);
12		12
13	use C4::SIP::Sip qw(syslog);	13	use C4::SIP::Sip qw(siplog);
14		14
15	my $parser = new XML::Simple(	15	my $parser = new XML::Simple(
16	KeyAttr => {	16	KeyAttr => {
Lines 65-71 sub find_service { Link Here
65	my $portstr;	65	my $portstr;
66	foreach my $addr ( '', '*:', "$sockaddr:", "[$sockaddr]:" ) {	66	foreach my $addr ( '', '*:', "$sockaddr:", "[$sockaddr]:" ) {
67	$portstr = sprintf( "%s%s/%s", $addr, $port, lc $proto );	67	$portstr = sprintf( "%s%s/%s", $addr, $port, lc $proto );
68	syslog( "LOG_DEBUG",	68	siplog( "LOG_DEBUG",
69	"Configuration::find_service: Trying $portstr" );	69	"Configuration::find_service: Trying $portstr" );
70	last if ( exists( ( $self->{listeners} )->{$portstr} ) );	70	last if ( exists( ( $self->{listeners} )->{$portstr} ) );
71	}	71	}




        # it's using the 2.00 login process, so it must support 2.00.
        $protocol_version = 2;
    }
    siplog( "LOG_DEBUG", "Sip::MsgType::new('%s', '%s...', '%s'): seq.no '%s', protocol %s", $class, substr( $msg, 0, 10 ), $msgtag, $seqno, $protocol_version );

    # warn "SIP PROTOCOL: $protocol_version";
    if ( !exists( $handlers{$msgtag} ) ) {
        siplog( "LOG_WARNING", "new Sip::MsgType: Skipping message of unknown type '%s' in '%s'", $msgtag, $msg );
        return;
    } elsif ( !exists( $handlers{$msgtag}->{protocol}->{$protocol_version} ) ) {
        siplog( "LOG_WARNING", "new Sip::MsgType: Skipping message '%s' unsupported by protocol rev. '%d'", $msgtag, $protocol_version );
        return;
    }


        $self->{fields}->{$field} = undef;
    }

    siplog( "LOG_DEBUG", "Sip::MsgType::_initialize('%s', '%s', '%s', '%s', ...)", $self->{name}, $msg, $proto->{template}, $proto->{template_len} );

    $self->{fixed_fields} = [ unpack( $proto->{template}, $msg ) ];    # see http://perldoc.perl.org/5.8.8/functions/unpack.html


        $fn = substr( $field, 0, 2 );

        if ( !exists( $self->{fields}->{$fn} ) ) {
            siplog( "LOG_WARNING", "Unsupported field '%s' in %s message '%s'", $fn, $self->{name}, $msg );
        } elsif ( defined( $self->{fields}->{$fn} ) ) {
            siplog( "LOG_WARNING", "Duplicate field '%s' (previous value '%s') in %s message '%s'", $fn, $self->{fields}->{$fn}, $self->{name}, $msg );
        } else {
            $self->{fields}->{$fn} = substr( $field, 2 );
        }

        $error_detection = 1;

        if ( !verify_cksum($msg) ) {
            siplog( "LOG_WARNING", "Checksum failed on message '%s'", $msg );

            # REQUEST_SC_RESEND with error detection
            $last_response = REQUEST_SC_RESEND_CKSUM;


        # We received a non-ED message when ED is supposed to be active.
        # Warn about this problem, then process the message anyway.
        siplog( "LOG_WARNING", "Received message without error detection: '%s'", $msg );
        $error_detection = 0;
        $self = C4::SIP::Sip::MsgType->new( $msg, 0 );
    } else {

        return substr( $msg, 0, 2 );
    }
    unless ( $self->{handler} ) {
        siplog( "LOG_WARNING", "No handler defined for '%s'", $msg );
        $last_response = REQUEST_SC_RESEND;
        print("$last_response\r");
        return REQUEST_ACS_RESEND;


        # Off-line transactions need to be recorded, but there's
        # not a lot we can do about it
        siplog( "LOG_WARNING", "received no-block checkout from terminal '%s'", $account->{id} );

        $status = $ils->checkout_no_block( $patron_id, $item_id, $sc_renewal_policy, $trans_date, $nb_due_date );
    } else {

    if ( $no_block eq 'Y' ) {

        # Off-line transactions, ick.
        siplog( "LOG_WARNING", "received no-block checkin from terminal '%s'", $account->{id} );
        $status = $ils->checkin_no_block( $item_id, $trans_date, $return_date, $item_props, $cancel );
    } else {
        $status = $ils->checkin( $item_id, $trans_date, $return_date, $my_branch, $item_props, $cancel, $account->{checked_in_ok}, $account->{cv_triggers_alert} );

    } elsif ( $sc_protocol_version =~ /^2\./ ) {
        $new_proto = 2;
    } else {
        siplog( "LOG_WARNING", "Unrecognized protocol revision '%s', falling back to '1'", $sc_protocol_version );
        $new_proto = 1;
    }

    if ( $new_proto != $protocol_version ) {
        siplog( "LOG_INFO", "Setting protocol level to $new_proto" );
        $protocol_version = $new_proto;
    }

    if ( $status == SC_STATUS_PAPER ) {
        siplog( "LOG_WARNING", "Self-Check unit '%s@%s' out of paper", $self->{account}->{id}, $self->{account}->{institution} );
    } elsif ( $status == SC_STATUS_SHUTDOWN ) {
        siplog( "LOG_WARNING", "Self-Check unit '%s@%s' shutting down", $self->{account}->{id}, $self->{account}->{institution} );
    }

    $self->{account}->{print_width} = $print_width;

    my $pwd    = shift;
    my $status = 1;                 # Assume it all works
    if ( !exists( $server->{config}->{accounts}->{$uid} ) ) {
        siplog( "LOG_WARNING", "MsgType::login_core: Unknown login '$uid'" );
        $status = 0;
    } elsif ( $server->{config}->{accounts}->{$uid}->{password} ne $pwd ) {
        siplog( "LOG_WARNING", "MsgType::login_core: Invalid password for login '$uid'" );
        $status = 0;
    } else {



        my $auth_status = api_auth( $uid, $pwd, $inst );
        if ( !$auth_status or $auth_status !~ /^ok$/i ) {
            siplog( "LOG_WARNING", "api_auth failed for SIP terminal '%s' of '%s': %s", $uid, $inst, ( $auth_status || 'unknown' ) );
            $status = 0;
        } else {
            siplog( "LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst );

            #
            # initialize connection to ILS
            #
            my $module = $server->{config}->{institutions}->{$inst}->{implementation};
            siplog( "LOG_DEBUG", 'login_core: ' . Dumper($module) );

            # Suspect this is always ILS but so we don't break any eccentic install (for now)
            if ( $module eq 'ILS' ) {

            }
            $module->use;
            if ($@) {
                siplog( "LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed", $server->{service}, $module, $inst );
                die("Failed to load ILS implementation '$module' for $inst");
            }

            # like   ILS->new(), I think.
            $server->{ils} = $module->new( $server->{institution}, $server->{account} );
            if ( !$server->{ils} ) {
                siplog( "LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst );
                die("Unable to connect to ILS '$inst'");
            }
        }

    $pwd = $fields->{ (FID_LOGIN_PWD) };    # Terminal PWD, not patron PWD.

    if ( $uid_algorithm || $pwd_algorithm ) {
        siplog( "LOG_ERR", "LOGIN: Unsupported non-zero encryption method(s): uid = $uid_algorithm, pwd = $pwd_algorithm" );
        $status = 0;
    } else {
        $status = login_core( $server, $uid, $pwd );

        return '';    # No detailed information required
    }

    siplog( "LOG_DEBUG", "Summary_info: index == '%d', field '%s'", $summary_type, $summary_map[$summary_type]->{fid} );

    my $func     = $summary_map[$summary_type]->{func};
    my $fid      = $summary_map[$summary_type]->{fid};
    my $itemlist = &$func( $patron, $start, $end, $server );

    siplog( "LOG_DEBUG", "summary_info: list = (%s)", join( ", ", map{ $_->{barcode} } @{$itemlist} ) );
    foreach my $i ( @{$itemlist} ) {
        $resp .= add_field( $fid, $i->{barcode}, $server );
    }

    $item_props = $fields->{ (FID_ITEM_PROPS) };

    if ( !defined($item_id) ) {
        siplog( "LOG_WARNING", "handle_item_status: received message without Item ID field" );
    } else {
        $item = $ils->find_item($item_id);
    }

    $patron_id  = $fields->{ (FID_PATRON_ID) };
    $patron_pwd = $fields->{ (FID_PATRON_PWD) };

    siplog( "LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'", $patron_id, $patron_pwd );

    $patron = $ils->find_patron($patron_id);


    } elsif ( $hold_mode eq '*' ) {
        $status = $ils->alter_hold( $patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_locn, $hold_type, $fee_ack );
    } else {
        siplog( "LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'", $hold_mode, $server->{account}->{id} );
        $status = $ils->Transaction::Hold;    # new?
        $status->screen_msg("System error. Please contact library staff.");
    }

    $ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_renew" );

    if ( $no_block eq 'Y' ) {
        siplog( "LOG_WARNING", "handle_renew: received 'no block' renewal from terminal '%s'", $server->{account}->{id} );
    }

    $patron_id  = $fields->{ (FID_PATRON_ID) };

    $retries            = sprintf( "%03d", $policy->{retries} );

    if ( length($retries) != 3 ) {
        siplog( "LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", $retries );
        $retries = '000';
    }


    } elsif ( $protocol_version == 2 ) {
        $msg .= '2.00';
    } else {
        siplog( "LOG_ERR", 'Bad setting for $protocol_version, "%s" in send_acs_status', $protocol_version );
        $msg .= '1.00';
    }


            }
        }
        if ( length($supported_msgs) < 16 ) {
            siplog( "LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs );
        }
        $msg .= add_field( FID_SUPPORTED_MSGS, $supported_msgs, $server );
    }

    if (   defined( $account->{print_width} )
        && defined($print_line)
        && $account->{print_width} < length($print_line) ) {
        siplog( "LOG_WARNING", "send_acs_status: print line '%s' too long.  Truncating", $print_line );
        $print_line = substr( $print_line, 0, $account->{print_width} );
    }


    my $patron = shift;
    my $patron_status;

    siplog( "LOG_DEBUG", "patron_status_string: %s charge_ok: %s", $patron->id, $patron->charge_ok );
    $patron_status = sprintf(
        '%s%s%s%s%s%s%s%s%s%s%s%s%s%s',
        denied( $patron->charge_ok ),
- 

Return to bug 15253

Lines 12-18 use Scalar::Util qw(blessed); Link Here

(-)a/C4/SIP/SIPServer.pm (-27 / +27 lines)
12	require UNIVERSAL::require;	12	require UNIVERSAL::require;
13		13
14	use C4::Context;	14	use C4::Context;
15	use C4::SIP::Sip qw(syslog);	15	use C4::SIP::Sip qw(siplog);
16	use C4::SIP::Sip::Constants qw(:all);	16	use C4::SIP::Sip::Constants qw(:all);
17	use C4::SIP::Sip::Configuration;	17	use C4::SIP::Sip::Configuration;
18	use C4::SIP::Sip::Checksum qw(checksum verify_cksum);	18	use C4::SIP::Sip::Checksum qw(checksum verify_cksum);
Lines 125-138 sub process_request { Link Here
125	$self->{service} = $config->find_service($sockaddr, $port, $proto);	125	$self->{service} = $config->find_service($sockaddr, $port, $proto);
126		126
127	if (!defined($self->{service})) {	127	if (!defined($self->{service})) {
128	syslog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto);	128	siplog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto);
129	die "process_request: Bad server connection";	129	die "process_request: Bad server connection";
130	}	130	}
131		131
132	$transport = $transports{$self->{service}->{transport}};	132	$transport = $transports{$self->{service}->{transport}};
133		133
134	if (!defined($transport)) {	134	if (!defined($transport)) {
135	syslog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport});	135	siplog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport});
136	return;	136	return;
137	} else {	137	} else {
138	&$transport($self);	138	&$transport($self);
Lines 158-170 sub raw_transport { Link Here
158	# In practice it should only iterate once but be prepared	158	# In practice it should only iterate once but be prepared
159	local $SIG{ALRM} = sub { die 'raw transport Timed Out!' };	159	local $SIG{ALRM} = sub { die 'raw transport Timed Out!' };
160	my $timeout = $self->get_timeout({ transport => 1 });	160	my $timeout = $self->get_timeout({ transport => 1 });
161	syslog('LOG_DEBUG', "raw_transport: timeout is $timeout");	161	siplog('LOG_DEBUG', "raw_transport: timeout is $timeout");
162	alarm $timeout;	162	alarm $timeout;
163	while (!$self->{account}) {	163	while (!$self->{account}) {
164	$input = read_request();	164	$input = read_request();
165	if (!$input) {	165	if (!$input) {
166	# EOF on the socket	166	# EOF on the socket
167	syslog("LOG_INFO", "raw_transport: shutting down: EOF during login");	167	siplog("LOG_INFO", "raw_transport: shutting down: EOF during login");
168	return;	168	return;
169	}	169	}
170	$input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s)	170	$input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s)
Lines 187-215 sub raw_transport { Link Here
187	Log::Log4perl::MDC->put( "accountid", $self->{account}->{id} );	187	Log::Log4perl::MDC->put( "accountid", $self->{account}->{id} );
188	Log::Log4perl::MDC->put( "peeraddr", $self->{server}->{peeraddr} );	188	Log::Log4perl::MDC->put( "peeraddr", $self->{server}->{peeraddr} );
189		189
190	syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",	190	siplog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",
191	$self->{account}->{id},	191	$self->{account}->{id},
192	$self->{account}->{institution});	192	$self->{account}->{institution});
193	if (! $self->{account}->{id}) {	193	if (! $self->{account}->{id}) {
194	syslog("LOG_ERR","Login failed shutting down");	194	siplog("LOG_ERR","Login failed shutting down");
195	return;	195	return;
196	}	196	}
197		197
198	$self->sip_protocol_loop();	198	$self->sip_protocol_loop();
199	syslog("LOG_INFO", "raw_transport: shutting down");	199	siplog("LOG_INFO", "raw_transport: shutting down");
200	return;	200	return;
201	}	201	}
202		202
203	sub get_clean_string {	203	sub get_clean_string {
204	my $string = shift;	204	my $string = shift;
205	if (defined $string) {	205	if (defined $string) {
206	syslog("LOG_DEBUG", "get_clean_string pre-clean(length %s): %s", length($string), $string);	206	siplog("LOG_DEBUG", "get_clean_string pre-clean(length %s): %s", length($string), $string);
207	chomp($string);	207	chomp($string);
208	$string =~ s/^[^A-z0-9]+//;	208	$string =~ s/^[^A-z0-9]+//;
209	$string =~ s/[^A-z0-9]+$//;	209	$string =~ s/[^A-z0-9]+$//;
210	syslog("LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string);	210	siplog("LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string);
211	} else {	211	} else {
212	syslog("LOG_INFO", "get_clean_string called on undefined");	212	siplog("LOG_INFO", "get_clean_string called on undefined");
213	}	213	}
214	return $string;	214	return $string;
215	}	215	}
Lines 219-225 sub get_clean_input { Link Here
219	my $in = <STDIN>;	219	my $in = <STDIN>;
220	$in = get_clean_string($in);	220	$in = get_clean_string($in);
221	while (my $extra = <STDIN>){	221	while (my $extra = <STDIN>){
222	syslog("LOG_ERR", "get_clean_input got extra lines: %s", $extra);	222	siplog("LOG_ERR", "get_clean_input got extra lines: %s", $extra);
223	}	223	}
224	return $in;	224	return $in;
225	}	225	}
Lines 232-238 sub telnet_transport { Link Here
232	my $input;	232	my $input;
233	my $config = $self->{config};	233	my $config = $self->{config};
234	my $timeout = $self->get_timeout({ transport => 1 });	234	my $timeout = $self->get_timeout({ transport => 1 });
235	syslog("LOG_DEBUG", "telnet_transport: timeout is $timeout");	235	siplog("LOG_DEBUG", "telnet_transport: timeout is $timeout");
236		236
237	eval {	237	eval {
238	local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; };	238	local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; };
Lines 251-260 sub telnet_transport { Link Here
251	$pwd = <STDIN>;	251	$pwd = <STDIN>;
252	alarm 0;	252	alarm 0;
253		253
254	syslog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd));	254	siplog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd));
255	$uid = get_clean_string ($uid);	255	$uid = get_clean_string ($uid);
256	$pwd = get_clean_string ($pwd);	256	$pwd = get_clean_string ($pwd);
257	syslog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd));	257	siplog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd));
258		258
259	if (exists ($config->{accounts}->{$uid})	259	if (exists ($config->{accounts}->{$uid})
260	&& ($pwd eq $config->{accounts}->{$uid}->{password})) {	260	&& ($pwd eq $config->{accounts}->{$uid}->{password})) {
Lines 263-287 sub telnet_transport { Link Here
263	last;	263	last;
264	}	264	}
265	}	265	}
266	syslog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid\|\|''));	266	siplog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid\|\|''));
267	print("Invalid login$CRLF");	267	print("Invalid login$CRLF");
268	}	268	}
269	}; # End of eval	269	}; # End of eval
270		270
271	if ($@) {	271	if ($@) {
272	syslog("LOG_ERR", "telnet_transport: Login timed out");	272	siplog("LOG_ERR", "telnet_transport: Login timed out");
273	die "Telnet Login Timed out";	273	die "Telnet Login Timed out";
274	} elsif (!defined($account)) {	274	} elsif (!defined($account)) {
275	syslog("LOG_ERR", "telnet_transport: Login Failed");	275	siplog("LOG_ERR", "telnet_transport: Login Failed");
276	die "Login Failure";	276	die "Login Failure";
277	} else {	277	} else {
278	print "Login OK. Initiating SIP$CRLF";	278	print "Login OK. Initiating SIP$CRLF";
279	}	279	}
280		280
281	$self->{account} = $account;	281	$self->{account} = $account;
282	syslog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution});	282	siplog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution});
283	$self->sip_protocol_loop();	283	$self->sip_protocol_loop();
284	syslog("LOG_INFO", "telnet_transport: shutting down");	284	siplog("LOG_INFO", "telnet_transport: shutting down");
285	return;	285	return;
286	}	286	}
287		287
Lines 311-317 sub sip_protocol_loop { Link Here
311	# In short, we'll take any valid message here.	311	# In short, we'll take any valid message here.
312	eval {	312	eval {
313	local $SIG{ALRM} = sub {	313	local $SIG{ALRM} = sub {
314	syslog( 'LOG_DEBUG', 'Inactive: timed out' );	314	siplog( 'LOG_DEBUG', 'Inactive: timed out' );
315	die "Timed Out!\n";	315	die "Timed Out!\n";
316	};	316	};
317	my $previous_alarm = alarm($timeout);	317	my $previous_alarm = alarm($timeout);
Lines 323-336 sub sip_protocol_loop { Link Here
323	alarm($timeout);	323	alarm($timeout);
324		324
325	unless ($inputbuf) {	325	unless ($inputbuf) {
326	syslog( "LOG_ERR", "sip_protocol_loop: empty input skipped" );	326	siplog( "LOG_ERR", "sip_protocol_loop: empty input skipped" );
327	print("96$CR");	327	print("96$CR");
328	next;	328	next;
329	}	329	}
330		330
331	my $status = C4::SIP::Sip::MsgType::handle( $inputbuf, $self, q{} );	331	my $status = C4::SIP::Sip::MsgType::handle( $inputbuf, $self, q{} );
332	if ( !$status ) {	332	if ( !$status ) {
333	syslog(	333	siplog(
334	"LOG_ERR",	334	"LOG_ERR",
335	"sip_protocol_loop: failed to handle %s",	335	"sip_protocol_loop: failed to handle %s",
336	substr( $inputbuf, 0, 2 )	336	substr( $inputbuf, 0, 2 )
Lines 369-384 sub read_request { Link Here
369	# treat as one line to include the extra linebreaks we are trying to remove!	369	# treat as one line to include the extra linebreaks we are trying to remove!
370	}	370	}
371	else {	371	else {
372	syslog( 'LOG_DEBUG', 'EOF returned on read' );	372	siplog( 'LOG_DEBUG', 'EOF returned on read' );
373	return;	373	return;
374	}	374	}
375	my $len = length $buffer;	375	my $len = length $buffer;
376	if ( $len != $raw_length ) {	376	if ( $len != $raw_length ) {
377	my $trim = $raw_length - $len;	377	my $trim = $raw_length - $len;
378	syslog( 'LOG_DEBUG', "read_request trimmed $trim character(s) " );	378	siplog( 'LOG_DEBUG', "read_request trimmed $trim character(s) " );
379	}	379	}
380		380
381	syslog( 'LOG_INFO', "INPUT MSG: '$buffer'" );	381	siplog( 'LOG_INFO', "INPUT MSG: '$buffer'" );
382	return $buffer;	382	return $buffer;
383	}	383	}
384		384
Lines 414-420 sub get_timeout { Link Here
414	my $policy = $server->{policy} // {};	414	my $policy = $server->{policy} // {};
415	my $rv = sprintf( "%03d", $policy->{timeout} // 0 );	415	my $rv = sprintf( "%03d", $policy->{timeout} // 0 );
416	if( length($rv) != 3 ) {	416	if( length($rv) != 3 ) {
417	syslog( "LOG_ERR", "Policy timeout has wrong size: '%s'", $rv );	417	siplog( "LOG_ERR", "Policy timeout has wrong size: '%s'", $rv );
418	return '000';	418	return '000';
419	}	419	}
420	return $rv;	420	return $rv;

Lines 22-34 use base qw(Exporter); Link Here

(-)a/C4/SIP/Sip.pm (-6 / +6 lines)
22	our @EXPORT_OK = qw(y_or_n timestamp add_field maybe_add add_count	22	our @EXPORT_OK = qw(y_or_n timestamp add_field maybe_add add_count
23	denied sipbool boolspace write_msg	23	denied sipbool boolspace write_msg
24	$error_detection $protocol_version $field_delimiter	24	$error_detection $protocol_version $field_delimiter
25	$last_response syslog);	25	$last_response siplog);
26		26
27	our %EXPORT_TAGS = (	27	our %EXPORT_TAGS = (
28	all => [qw(y_or_n timestamp add_field maybe_add	28	all => [qw(y_or_n timestamp add_field maybe_add
29	add_count denied sipbool boolspace write_msg	29	add_count denied sipbool boolspace write_msg
30	$error_detection $protocol_version	30	$error_detection $protocol_version
31	$field_delimiter $last_response syslog)]);	31	$field_delimiter $last_response siplog)]);
32		32
33	our $error_detection = 0;	33	our $error_detection = 0;
34	our $protocol_version = 1;	34	our $protocol_version = 1;
Lines 68-74 sub add_field { Link Here
68	my ($i, $ent);	68	my ($i, $ent);
69		69
70	if (!defined($value)) {	70	if (!defined($value)) {
71	syslog("LOG_DEBUG", "add_field: Undefined value being added to '%s'",	71	siplog("LOG_DEBUG", "add_field: Undefined value being added to '%s'",
72	$field_id);	72	$field_id);
73	$value = '';	73	$value = '';
74	}	74	}
Lines 127-133 sub add_count { Link Here
127		127
128	$count = sprintf("%04d", $count);	128	$count = sprintf("%04d", $count);
129	if (length($count) != 4) {	129	if (length($count) != 4) {
130	syslog("LOG_WARNING", "handle_patron_info: %s wrong size: '%s'",	130	siplog("LOG_WARNING", "handle_patron_info: %s wrong size: '%s'",
131	$label, $count);	131	$label, $count);
132	$count = ' ' x 4;	132	$count = ' ' x 4;
133	}	133	}
Lines 198-210 sub write_msg { Link Here
198	} else {	198	} else {
199	STDOUT->autoflush(1);	199	STDOUT->autoflush(1);
200	print $msg, $terminator;	200	print $msg, $terminator;
201	syslog("LOG_INFO", "OUTPUT MSG: '$msg'");	201	siplog("LOG_INFO", "OUTPUT MSG: '$msg'");
202	}	202	}
203		203
204	$last_response = $msg;	204	$last_response = $msg;
205	}	205	}
206		206
207	sub syslog {	207	sub siplog {
208	my ( $level, $mask, @args ) = @_;	208	my ( $level, $mask, @args ) = @_;
209		209
210	my $method =	210	my $method =

Lines 6-12 package C4::SIP::ILS; Link Here

(-)a/C4/SIP/ILS.pm (-15 / +15 lines)
6		6
7	use warnings;	7	use warnings;
8	use strict;	8	use strict;
9	use C4::SIP::Sip qw(syslog);	9	use C4::SIP::Sip qw(siplog);
10	use Data::Dumper;	10	use Data::Dumper;
11		11
12	use C4::SIP::ILS::Item;	12	use C4::SIP::ILS::Item;
Lines 47-53 sub new { Link Here
47	my $type = ref($class) \|\| $class;	47	my $type = ref($class) \|\| $class;
48	my $self = {};	48	my $self = {};
49	$debug and warn "new ILS: INSTITUTION: " . Dumper($institution);	49	$debug and warn "new ILS: INSTITUTION: " . Dumper($institution);
50	syslog("LOG_DEBUG", "new ILS '%s'", $institution->{id});	50	siplog("LOG_DEBUG", "new ILS '%s'", $institution->{id});
51	$self->{institution} = $institution;	51	$self->{institution} = $institution;
52	return bless $self, $type;	52	return bless $self, $type;
53	}	53	}
Lines 82-88 sub supports { Link Here
82	sub check_inst_id {	82	sub check_inst_id {
83	my ($self, $id, $whence) = @_;	83	my ($self, $id, $whence) = @_;
84	if ($id ne $self->{institution}->{id}) {	84	if ($id ne $self->{institution}->{id}) {
85	syslog("LOG_WARNING", "%s: received institution '%s', expected '%s'", $whence, $id, $self->{institution}->{id});	85	siplog("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	86	# Just an FYI check, we don't expect the user to change location from that in SIPconfig.xml
87	}	87	}
88	}	88	}
Lines 167-179 sub checkout { Link Here
167	push( @{ $patron->{items} }, { barcode => $item_id } );	167	push( @{ $patron->{items} }, { barcode => $item_id } );
168	$circ->desensitize( !$item->magnetic_media );	168	$circ->desensitize( !$item->magnetic_media );
169		169
170	syslog(	170	siplog(
171	"LOG_DEBUG", "ILS::Checkout: patron %s has checked out %s",	171	"LOG_DEBUG", "ILS::Checkout: patron %s has checked out %s",
172	$patron_id, join( ', ', map{ $_->{barcode} } @{ $patron->{items} } )	172	$patron_id, join( ', ', map{ $_->{barcode} } @{ $patron->{items} } )
173	);	173	);
174	}	174	}
175	else {	175	else {
176	syslog( "LOG_ERR", "ILS::Checkout Issue failed" );	176	siplog( "LOG_ERR", "ILS::Checkout Issue failed" );
177	}	177	}
178	}	178	}
179		179
Lines 219-238 sub checkin { Link Here
219		219
220	if ( !$circ->ok && $circ->alert_type && $circ->alert_type == 98 ) { # data corruption	220	if ( !$circ->ok && $circ->alert_type && $circ->alert_type == 98 ) { # data corruption
221	$circ->screen_msg("Checkin failed: data problem");	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" );	222	siplog( "LOG_WARNING", "Problem with issue_id in issues and old_issues; check the about page" );
223	} elsif ( $data->{messages}->{withdrawn} && !$circ->ok ) {	223	} elsif ( $data->{messages}->{withdrawn} && !$circ->ok ) {
224	$circ->screen_msg("Item withdrawn, return not allowed");	224	$circ->screen_msg("Item withdrawn, return not allowed");
225	syslog("LOG_DEBUG", "C4::SIP::ILS::Checkin - item withdrawn");	225	siplog("LOG_DEBUG", "C4::SIP::ILS::Checkin - item withdrawn");
226	} elsif ( $data->{messages}->{WasLost} && !$circ->ok ) {	226	} elsif ( $data->{messages}->{WasLost} && !$circ->ok ) {
227	$circ->screen_msg("Item lost, return not allowed");	227	$circ->screen_msg("Item lost, return not allowed");
228	syslog("LOG_DEBUG", "C4::SIP::ILS::Checkin - item lost");	228	siplog("LOG_DEBUG", "C4::SIP::ILS::Checkin - item lost");
229	} elsif ( !$item->{patron} ) {	229	} elsif ( !$item->{patron} ) {
230	if ( $checked_in_ok ) { # Mark checkin ok although book not checked out	230	if ( $checked_in_ok ) { # Mark checkin ok although book not checked out
231	$circ->ok( 1 );	231	$circ->ok( 1 );
232	syslog("LOG_DEBUG", "C4::SIP::ILS::Checkin - using checked_in_ok");	232	siplog("LOG_DEBUG", "C4::SIP::ILS::Checkin - using checked_in_ok");
233	} else {	233	} else {
234	$circ->screen_msg("Item not checked out");	234	$circ->screen_msg("Item not checked out");
235	syslog("LOG_DEBUG", "C4::SIP::ILS::Checkin - item not checked out");	235	siplog("LOG_DEBUG", "C4::SIP::ILS::Checkin - item not checked out");
236	}	236	}
237	} elsif ( $circ->ok ) {	237	} elsif ( $circ->ok ) {
238	$circ->patron( $patron = C4::SIP::ILS::Patron->new( $item->{patron} ) );	238	$circ->patron( $patron = C4::SIP::ILS::Patron->new( $item->{patron} ) );
Lines 244-250 sub checkin { Link Here
244	# Bug 10748 with pref BlockReturnOfLostItems adds another case to come	244	# Bug 10748 with pref BlockReturnOfLostItems adds another case to come
245	# here: returning a lost item when the pref is set.	245	# here: returning a lost item when the pref is set.
246	$circ->screen_msg("Checkin failed");	246	$circ->screen_msg("Checkin failed");
247	syslog( "LOG_WARNING", "Checkin failed: probably for Wrongbranch or withdrawn" );	247	siplog( "LOG_WARNING", "Checkin failed: probably for Wrongbranch or withdrawn" );
248	}	248	}
249		249
250	return $circ;	250	return $circ;
Lines 461-470 sub renew { Link Here
461	my $count = scalar @{$patron->{items}};	461	my $count = scalar @{$patron->{items}};
462	foreach my $i (@{$patron->{items}}) {	462	foreach my $i (@{$patron->{items}}) {
463	unless (defined $i->{barcode}) { # FIXME: using data instead of objects may violate the abstraction layer	463	unless (defined $i->{barcode}) { # FIXME: using data instead of objects may violate the abstraction layer
464	syslog("LOG_ERR", "No barcode for item %s of %s: $item_id", $j+1, $count);	464	siplog("LOG_ERR", "No barcode for item %s of %s: $item_id", $j+1, $count);
465	next;	465	next;
466	}	466	}
467	syslog("LOG_DEBUG", "checking item %s of %s: $item_id vs. %s", ++$j, $count, $i->{barcode});	467	siplog("LOG_DEBUG", "checking item %s of %s: $item_id vs. %s", ++$j, $count, $i->{barcode});
468	if ($i->{barcode} eq $item_id) {	468	if ($i->{barcode} eq $item_id) {
469	# We have it checked out	469	# We have it checked out
470	$item = C4::SIP::ILS::Item->new( $item_id );	470	$item = C4::SIP::ILS::Item->new( $item_id );
Lines 498-506 sub renew_all { Link Here
498		498
499	$trans->patron($patron = C4::SIP::ILS::Patron->new( $patron_id ));	499	$trans->patron($patron = C4::SIP::ILS::Patron->new( $patron_id ));
500	if (defined $patron) {	500	if (defined $patron) {
501	syslog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s", $patron->name, $patron->renew_ok);	501	siplog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s", $patron->name, $patron->renew_ok);
502	} else {	502	} else {
503	syslog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'", $patron_id);	503	siplog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'", $patron_id);
504	}	504	}
505		505
506	if (!defined($patron)) {	506	if (!defined($patron)) {

Lines 9-15 package C4::SIP::ILS::Item; Link Here

(-)a/C4/SIP/ILS/Item.pm (-4 / +4 lines)
9	use strict;	9	use strict;
10	use warnings;	10	use warnings;
11		11
12	use C4::SIP::Sip qw(syslog);	12	use C4::SIP::Sip qw(siplog);
13	use Carp;	13	use Carp;
14	use Template;	14	use Template;
15		15
Lines 77-83 sub new { Link Here
77	my $type = ref($class) \|\| $class;	77	my $type = ref($class) \|\| $class;
78	my $item = Koha::Items->find( { barcode => barcodedecode( $item_id ) } );	78	my $item = Koha::Items->find( { barcode => barcodedecode( $item_id ) } );
79	unless ( $item ) {	79	unless ( $item ) {
80	syslog("LOG_DEBUG", "new ILS::Item('%s'): not found", $item_id);	80	siplog("LOG_DEBUG", "new ILS::Item('%s'): not found", $item_id);
81	warn "new ILS::Item($item_id) : No item '$item_id'.";	81	warn "new ILS::Item($item_id) : No item '$item_id'.";
82	return;	82	return;
83	}	83	}
Lines 107-113 sub new { Link Here
107	$self->{author} = $biblio->author;	107	$self->{author} = $biblio->author;
108	bless $self, $type;	108	bless $self, $type;
109		109
110	syslog( "LOG_DEBUG", "new ILS::Item('%s'): found with title '%s'",	110	siplog( "LOG_DEBUG", "new ILS::Item('%s'): found with title '%s'",
111	$item_id, $self->{title} // '' );	111	$item_id, $self->{title} // '' );
112		112
113	return $self;	113	return $self;
Lines 181-187 sub hold_patron_name { Link Here
181		181
182	my $holder = Koha::Patrons->find( $borrowernumber );	182	my $holder = Koha::Patrons->find( $borrowernumber );
183	unless ($holder) {	183	unless ($holder) {
184	syslog("LOG_ERR", "While checking hold, failed to retrieve the patron with borrowernumber '$borrowernumber'");	184	siplog("LOG_ERR", "While checking hold, failed to retrieve the patron with borrowernumber '$borrowernumber'");
185	return;	185	return;
186	}	186	}
187	my $email = $holder->email \|\| '';	187	my $email = $holder->email \|\| '';

Lines 12-18 use warnings; Link Here

(-)a/C4/SIP/ILS/Patron.pm (-5 / +5 lines)
12	use Exporter;	12	use Exporter;
13	use Carp;	13	use Carp;
14		14
15	use C4::SIP::Sip qw(syslog);	15	use C4::SIP::Sip qw(siplog);
16	use Data::Dumper;	16	use Data::Dumper;
17		17
18	use C4::SIP::Sip qw(add_field maybe_add);	18	use C4::SIP::Sip qw(add_field maybe_add);
Lines 42-48 sub new { Link Here
42	\|\| Koha::Patrons->find( { userid => $patron_id } );	42	\|\| Koha::Patrons->find( { userid => $patron_id } );
43	$debug and warn "new Patron: " . Dumper($patron->unblessed) if $patron;	43	$debug and warn "new Patron: " . Dumper($patron->unblessed) if $patron;
44	unless ($patron) {	44	unless ($patron) {
45	syslog("LOG_DEBUG", "new ILS::Patron(%s): no such patron", $patron_id);	45	siplog("LOG_DEBUG", "new ILS::Patron(%s): no such patron", $patron_id);
46	return;	46	return;
47	}	47	}
48	$kp = $patron->unblessed;	48	$kp = $patron->unblessed;
Lines 149-155 sub new { Link Here
149		149
150	$self = \%ilspatron;	150	$self = \%ilspatron;
151	$debug and warn Dumper($self);	151	$debug and warn Dumper($self);
152	syslog("LOG_DEBUG", "new ILS::Patron(%s): found patron '%s'", $patron_id,$self->{id});	152	siplog("LOG_DEBUG", "new ILS::Patron(%s): found patron '%s'", $patron_id,$self->{id});
153	bless $self, $type;	153	bless $self, $type;
154	return $self;	154	return $self;
155	}	155	}
Lines 239-245 sub format { Link Here
239	$tt->process( \$template, { patron => $patron }, \$output );	239	$tt->process( \$template, { patron => $patron }, \$output );
240	};	240	};
241	if ( $@ ){	241	if ( $@ ){
242	syslog("LOG_DEBUG", "Error processing template: $template");	242	siplog("LOG_DEBUG", "Error processing template: $template");
243	return "";	243	return "";
244	}	244	}
245	return $output;	245	return $output;
Lines 414-420 sub enable { Link Here
414	foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet') {	414	foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet') {
415	$self->{$field} = 1;	415	$self->{$field} = 1;
416	}	416	}
417	syslog("LOG_DEBUG", "Patron(%s)->enable: charge: %s, renew:%s, recall:%s, hold:%s",	417	siplog("LOG_DEBUG", "Patron(%s)->enable: charge: %s, renew:%s, recall:%s, hold:%s",
418	$self->{id}, $self->{charge_ok}, $self->{renew_ok},	418	$self->{id}, $self->{charge_ok}, $self->{renew_ok},
419	$self->{recall_ok}, $self->{hold_ok});	419	$self->{recall_ok}, $self->{hold_ok});
420	$self->{screen_msg} = "Enable feature not implemented."; # "All privileges restored."; # TODO: not really affecting patron record	420	$self->{screen_msg} = "Enable feature not implemented."; # "All privileges restored."; # TODO: not really affecting patron record

Lines 8-14 use warnings; Link Here

(-)a/C4/SIP/ILS/Transaction/Checkout.pm (-3 / +3 lines)
8	use strict;	8	use strict;
9		9
10	use POSIX qw(strftime);	10	use POSIX qw(strftime);
11	use C4::SIP::Sip qw(syslog);	11	use C4::SIP::Sip qw(siplog);
12	use Data::Dumper;	12	use Data::Dumper;
13	use CGI qw ( -utf8 );	13	use CGI qw ( -utf8 );
14		14
Lines 47-53 sub new { Link Here
47		47
48	sub do_checkout {	48	sub do_checkout {
49	my $self = shift;	49	my $self = shift;
50	syslog('LOG_DEBUG', "ILS::Transaction::Checkout performing checkout...");	50	siplog('LOG_DEBUG', "ILS::Transaction::Checkout performing checkout...");
51	my $shelf = $self->{item}->hold_shelf;	51	my $shelf = $self->{item}->hold_shelf;
52	my $barcode = $self->{item}->id;	52	my $barcode = $self->{item}->id;
53	my $patron_barcode = $self->{patron}->id;	53	my $patron_barcode = $self->{patron}->id;
Lines 103-109 sub do_checkout { Link Here
103	# We've been returned a case other than those above	103	# We've been returned a case other than those above
104	$self->screen_msg("Item cannot be issued: $confirmation");	104	$self->screen_msg("Item cannot be issued: $confirmation");
105	$noerror = 0;	105	$noerror = 0;
106	syslog('LOG_DEBUG', "Blocking checkout Reason:$confirmation");	106	siplog('LOG_DEBUG', "Blocking checkout Reason:$confirmation");
107	last;	107	last;
108	}	108	}
109	}	109	}

Lines 266-279 sub new { Link Here

(-)a/C4/SIP/Sip/MsgType.pm (-35 / +34 lines)
266	# it's using the 2.00 login process, so it must support 2.00.	266	# it's using the 2.00 login process, so it must support 2.00.
267	$protocol_version = 2;	267	$protocol_version = 2;
268	}	268	}
269	syslog( "LOG_DEBUG", "Sip::MsgType::new('%s', '%s...', '%s'): seq.no '%s', protocol %s", $class, substr( $msg, 0, 10 ), $msgtag, $seqno, $protocol_version );	269	siplog( "LOG_DEBUG", "Sip::MsgType::new('%s', '%s...', '%s'): seq.no '%s', protocol %s", $class, substr( $msg, 0, 10 ), $msgtag, $seqno, $protocol_version );
270		270
271	# warn "SIP PROTOCOL: $protocol_version";	271	# warn "SIP PROTOCOL: $protocol_version";
272	if ( !exists( $handlers{$msgtag} ) ) {	272	if ( !exists( $handlers{$msgtag} ) ) {
273	syslog( "LOG_WARNING", "new Sip::MsgType: Skipping message of unknown type '%s' in '%s'", $msgtag, $msg );	273	siplog( "LOG_WARNING", "new Sip::MsgType: Skipping message of unknown type '%s' in '%s'", $msgtag, $msg );
274	return;	274	return;
275	} elsif ( !exists( $handlers{$msgtag}->{protocol}->{$protocol_version} ) ) {	275	} elsif ( !exists( $handlers{$msgtag}->{protocol}->{$protocol_version} ) ) {
276	syslog( "LOG_WARNING", "new Sip::MsgType: Skipping message '%s' unsupported by protocol rev. '%d'", $msgtag, $protocol_version );	276	siplog( "LOG_WARNING", "new Sip::MsgType: Skipping message '%s' unsupported by protocol rev. '%d'", $msgtag, $protocol_version );
277	return;	277	return;
278	}	278	}
279		279
Lines 305-311 sub _initialize { Link Here
305	$self->{fields}->{$field} = undef;	305	$self->{fields}->{$field} = undef;
306	}	306	}
307		307
308	syslog( "LOG_DEBUG", "Sip::MsgType::_initialize('%s', '%s', '%s', '%s', ...)", $self->{name}, $msg, $proto->{template}, $proto->{template_len} );	308	siplog( "LOG_DEBUG", "Sip::MsgType::_initialize('%s', '%s', '%s', '%s', ...)", $self->{name}, $msg, $proto->{template}, $proto->{template_len} );
309		309
310	$self->{fixed_fields} = [ unpack( $proto->{template}, $msg ) ]; # see http://perldoc.perl.org/5.8.8/functions/unpack.html	310	$self->{fixed_fields} = [ unpack( $proto->{template}, $msg ) ]; # see http://perldoc.perl.org/5.8.8/functions/unpack.html
311		311
Lines 315-323 sub _initialize { Link Here
315	$fn = substr( $field, 0, 2 );	315	$fn = substr( $field, 0, 2 );
316		316
317	if ( !exists( $self->{fields}->{$fn} ) ) {	317	if ( !exists( $self->{fields}->{$fn} ) ) {
318	syslog( "LOG_WARNING", "Unsupported field '%s' in %s message '%s'", $fn, $self->{name}, $msg );	318	siplog( "LOG_WARNING", "Unsupported field '%s' in %s message '%s'", $fn, $self->{name}, $msg );
319	} elsif ( defined( $self->{fields}->{$fn} ) ) {	319	} elsif ( defined( $self->{fields}->{$fn} ) ) {
320	syslog( "LOG_WARNING", "Duplicate field '%s' (previous value '%s') in %s message '%s'", $fn, $self->{fields}->{$fn}, $self->{name}, $msg );	320	siplog( "LOG_WARNING", "Duplicate field '%s' (previous value '%s') in %s message '%s'", $fn, $self->{fields}->{$fn}, $self->{name}, $msg );
321	} else {	321	} else {
322	$self->{fields}->{$fn} = substr( $field, 2 );	322	$self->{fields}->{$fn} = substr( $field, 2 );
323	}	323	}
Lines 366-372 sub handle { Link Here
366	$error_detection = 1;	366	$error_detection = 1;
367		367
368	if ( !verify_cksum($msg) ) {	368	if ( !verify_cksum($msg) ) {
369	syslog( "LOG_WARNING", "Checksum failed on message '%s'", $msg );	369	siplog( "LOG_WARNING", "Checksum failed on message '%s'", $msg );
370		370
371	# REQUEST_SC_RESEND with error detection	371	# REQUEST_SC_RESEND with error detection
372	$last_response = REQUEST_SC_RESEND_CKSUM;	372	$last_response = REQUEST_SC_RESEND_CKSUM;
Lines 382-388 sub handle { Link Here
382		382
383	# We received a non-ED message when ED is supposed to be active.	383	# We received a non-ED message when ED is supposed to be active.
384	# Warn about this problem, then process the message anyway.	384	# Warn about this problem, then process the message anyway.
385	syslog( "LOG_WARNING", "Received message without error detection: '%s'", $msg );	385	siplog( "LOG_WARNING", "Received message without error detection: '%s'", $msg );
386	$error_detection = 0;	386	$error_detection = 0;
387	$self = C4::SIP::Sip::MsgType->new( $msg, 0 );	387	$self = C4::SIP::Sip::MsgType->new( $msg, 0 );
388	} else {	388	} else {
Lines 395-401 sub handle { Link Here
395	return substr( $msg, 0, 2 );	395	return substr( $msg, 0, 2 );
396	}	396	}
397	unless ( $self->{handler} ) {	397	unless ( $self->{handler} ) {
398	syslog( "LOG_WARNING", "No handler defined for '%s'", $msg );	398	siplog( "LOG_WARNING", "No handler defined for '%s'", $msg );
399	$last_response = REQUEST_SC_RESEND;	399	$last_response = REQUEST_SC_RESEND;
400	print("$last_response\r");	400	print("$last_response\r");
401	return REQUEST_ACS_RESEND;	401	return REQUEST_ACS_RESEND;
Lines 526-532 sub handle_checkout { Link Here
526		526
527	# Off-line transactions need to be recorded, but there's	527	# Off-line transactions need to be recorded, but there's
528	# not a lot we can do about it	528	# not a lot we can do about it
529	syslog( "LOG_WARNING", "received no-block checkout from terminal '%s'", $account->{id} );	529	siplog( "LOG_WARNING", "received no-block checkout from terminal '%s'", $account->{id} );
530		530
531	$status = $ils->checkout_no_block( $patron_id, $item_id, $sc_renewal_policy, $trans_date, $nb_due_date );	531	$status = $ils->checkout_no_block( $patron_id, $item_id, $sc_renewal_policy, $trans_date, $nb_due_date );
532	} else {	532	} else {
Lines 653-659 sub handle_checkin { Link Here
653	if ( $no_block eq 'Y' ) {	653	if ( $no_block eq 'Y' ) {
654		654
655	# Off-line transactions, ick.	655	# Off-line transactions, ick.
656	syslog( "LOG_WARNING", "received no-block checkin from terminal '%s'", $account->{id} );	656	siplog( "LOG_WARNING", "received no-block checkin from terminal '%s'", $account->{id} );
657	$status = $ils->checkin_no_block( $item_id, $trans_date, $return_date, $item_props, $cancel );	657	$status = $ils->checkin_no_block( $item_id, $trans_date, $return_date, $item_props, $cancel );
658	} else {	658	} else {
659	$status = $ils->checkin( $item_id, $trans_date, $return_date, $my_branch, $item_props, $cancel, $account->{checked_in_ok}, $account->{cv_triggers_alert} );	659	$status = $ils->checkin( $item_id, $trans_date, $return_date, $my_branch, $item_props, $cancel, $account->{checked_in_ok}, $account->{cv_triggers_alert} );
Lines 772-790 sub handle_sc_status { Link Here
772	} elsif ( $sc_protocol_version =~ /^2\./ ) {	772	} elsif ( $sc_protocol_version =~ /^2\./ ) {
773	$new_proto = 2;	773	$new_proto = 2;
774	} else {	774	} else {
775	syslog( "LOG_WARNING", "Unrecognized protocol revision '%s', falling back to '1'", $sc_protocol_version );	775	siplog( "LOG_WARNING", "Unrecognized protocol revision '%s', falling back to '1'", $sc_protocol_version );
776	$new_proto = 1;	776	$new_proto = 1;
777	}	777	}
778		778
779	if ( $new_proto != $protocol_version ) {	779	if ( $new_proto != $protocol_version ) {
780	syslog( "LOG_INFO", "Setting protocol level to $new_proto" );	780	siplog( "LOG_INFO", "Setting protocol level to $new_proto" );
781	$protocol_version = $new_proto;	781	$protocol_version = $new_proto;
782	}	782	}
783		783
784	if ( $status == SC_STATUS_PAPER ) {	784	if ( $status == SC_STATUS_PAPER ) {
785	syslog( "LOG_WARNING", "Self-Check unit '%s@%s' out of paper", $self->{account}->{id}, $self->{account}->{institution} );	785	siplog( "LOG_WARNING", "Self-Check unit '%s@%s' out of paper", $self->{account}->{id}, $self->{account}->{institution} );
786	} elsif ( $status == SC_STATUS_SHUTDOWN ) {	786	} elsif ( $status == SC_STATUS_SHUTDOWN ) {
787	syslog( "LOG_WARNING", "Self-Check unit '%s@%s' shutting down", $self->{account}->{id}, $self->{account}->{institution} );	787	siplog( "LOG_WARNING", "Self-Check unit '%s@%s' shutting down", $self->{account}->{id}, $self->{account}->{institution} );
788	}	788	}
789		789
790	$self->{account}->{print_width} = $print_width;	790	$self->{account}->{print_width} = $print_width;
Lines 824-833 sub login_core { Link Here
824	my $pwd = shift;	824	my $pwd = shift;
825	my $status = 1; # Assume it all works	825	my $status = 1; # Assume it all works
826	if ( !exists( $server->{config}->{accounts}->{$uid} ) ) {	826	if ( !exists( $server->{config}->{accounts}->{$uid} ) ) {
827	syslog( "LOG_WARNING", "MsgType::login_core: Unknown login '$uid'" );	827	siplog( "LOG_WARNING", "MsgType::login_core: Unknown login '$uid'" );
828	$status = 0;	828	$status = 0;
829	} elsif ( $server->{config}->{accounts}->{$uid}->{password} ne $pwd ) {	829	} elsif ( $server->{config}->{accounts}->{$uid}->{password} ne $pwd ) {
830	syslog( "LOG_WARNING", "MsgType::login_core: Invalid password for login '$uid'" );	830	siplog( "LOG_WARNING", "MsgType::login_core: Invalid password for login '$uid'" );
831	$status = 0;	831	$status = 0;
832	} else {	832	} else {
833		833
Lines 841-856 sub login_core { Link Here
841		841
842	my $auth_status = api_auth( $uid, $pwd, $inst );	842	my $auth_status = api_auth( $uid, $pwd, $inst );
843	if ( !$auth_status or $auth_status !~ /^ok$/i ) {	843	if ( !$auth_status or $auth_status !~ /^ok$/i ) {
844	syslog( "LOG_WARNING", "api_auth failed for SIP terminal '%s' of '%s': %s", $uid, $inst, ( $auth_status \|\| 'unknown' ) );	844	siplog( "LOG_WARNING", "api_auth failed for SIP terminal '%s' of '%s': %s", $uid, $inst, ( $auth_status \|\| 'unknown' ) );
845	$status = 0;	845	$status = 0;
846	} else {	846	} else {
847	syslog( "LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst );	847	siplog( "LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst );
848		848
849	#	849	#
850	# initialize connection to ILS	850	# initialize connection to ILS
851	#	851	#
852	my $module = $server->{config}->{institutions}->{$inst}->{implementation};	852	my $module = $server->{config}->{institutions}->{$inst}->{implementation};
853	syslog( "LOG_DEBUG", 'login_core: ' . Dumper($module) );	853	siplog( "LOG_DEBUG", 'login_core: ' . Dumper($module) );
854		854
855	# Suspect this is always ILS but so we don't break any eccentic install (for now)	855	# Suspect this is always ILS but so we don't break any eccentic install (for now)
856	if ( $module eq 'ILS' ) {	856	if ( $module eq 'ILS' ) {
Lines 858-871 sub login_core { Link Here
858	}	858	}
859	$module->use;	859	$module->use;
860	if ($@) {	860	if ($@) {
861	syslog( "LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed", $server->{service}, $module, $inst );	861	siplog( "LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed", $server->{service}, $module, $inst );
862	die("Failed to load ILS implementation '$module' for $inst");	862	die("Failed to load ILS implementation '$module' for $inst");
863	}	863	}
864		864
865	# like ILS->new(), I think.	865	# like ILS->new(), I think.
866	$server->{ils} = $module->new( $server->{institution}, $server->{account} );	866	$server->{ils} = $module->new( $server->{institution}, $server->{account} );
867	if ( !$server->{ils} ) {	867	if ( !$server->{ils} ) {
868	syslog( "LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst );	868	siplog( "LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst );
869	die("Unable to connect to ILS '$inst'");	869	die("Unable to connect to ILS '$inst'");
870	}	870	}
871	}	871	}
Lines 888-894 sub handle_login { Link Here
888	$pwd = $fields->{ (FID_LOGIN_PWD) }; # Terminal PWD, not patron PWD.	888	$pwd = $fields->{ (FID_LOGIN_PWD) }; # Terminal PWD, not patron PWD.
889		889
890	if ( $uid_algorithm \|\| $pwd_algorithm ) {	890	if ( $uid_algorithm \|\| $pwd_algorithm ) {
891	syslog( "LOG_ERR", "LOGIN: Unsupported non-zero encryption method(s): uid = $uid_algorithm, pwd = $pwd_algorithm" );	891	siplog( "LOG_ERR", "LOGIN: Unsupported non-zero encryption method(s): uid = $uid_algorithm, pwd = $pwd_algorithm" );
892	$status = 0;	892	$status = 0;
893	} else {	893	} else {
894	$status = login_core( $server, $uid, $pwd );	894	$status = login_core( $server, $uid, $pwd );
Lines 927-939 sub summary_info { Link Here
927	return ''; # No detailed information required	927	return ''; # No detailed information required
928	}	928	}
929		929
930	syslog( "LOG_DEBUG", "Summary_info: index == '%d', field '%s'", $summary_type, $summary_map[$summary_type]->{fid} );	930	siplog( "LOG_DEBUG", "Summary_info: index == '%d', field '%s'", $summary_type, $summary_map[$summary_type]->{fid} );
931		931
932	my $func = $summary_map[$summary_type]->{func};	932	my $func = $summary_map[$summary_type]->{func};
933	my $fid = $summary_map[$summary_type]->{fid};	933	my $fid = $summary_map[$summary_type]->{fid};
934	my $itemlist = &$func( $patron, $start, $end, $server );	934	my $itemlist = &$func( $patron, $start, $end, $server );
935		935
936	syslog( "LOG_DEBUG", "summary_info: list = (%s)", join( ", ", map{ $_->{barcode} } @{$itemlist} ) );	936	siplog( "LOG_DEBUG", "summary_info: list = (%s)", join( ", ", map{ $_->{barcode} } @{$itemlist} ) );
937	foreach my $i ( @{$itemlist} ) {	937	foreach my $i ( @{$itemlist} ) {
938	$resp .= add_field( $fid, $i->{barcode}, $server );	938	$resp .= add_field( $fid, $i->{barcode}, $server );
939	}	939	}
Lines 1256-1262 sub handle_item_status_update { Link Here
1256	$item_props = $fields->{ (FID_ITEM_PROPS) };	1256	$item_props = $fields->{ (FID_ITEM_PROPS) };
1257		1257
1258	if ( !defined($item_id) ) {	1258	if ( !defined($item_id) ) {
1259	syslog( "LOG_WARNING", "handle_item_status: received message without Item ID field" );	1259	siplog( "LOG_WARNING", "handle_item_status: received message without Item ID field" );
1260	} else {	1260	} else {
1261	$item = $ils->find_item($item_id);	1261	$item = $ils->find_item($item_id);
1262	}	1262	}
Lines 1301-1307 sub handle_patron_enable { Link Here
1301	$patron_id = $fields->{ (FID_PATRON_ID) };	1301	$patron_id = $fields->{ (FID_PATRON_ID) };
1302	$patron_pwd = $fields->{ (FID_PATRON_PWD) };	1302	$patron_pwd = $fields->{ (FID_PATRON_PWD) };
1303		1303
1304	syslog( "LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'", $patron_id, $patron_pwd );	1304	siplog( "LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'", $patron_id, $patron_pwd );
1305		1305
1306	$patron = $ils->find_patron($patron_id);	1306	$patron = $ils->find_patron($patron_id);
1307		1307
Lines 1371-1377 sub handle_hold { Link Here
1371	} elsif ( $hold_mode eq '*' ) {	1371	} elsif ( $hold_mode eq '*' ) {
1372	$status = $ils->alter_hold( $patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_locn, $hold_type, $fee_ack );	1372	$status = $ils->alter_hold( $patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_locn, $hold_type, $fee_ack );
1373	} else {	1373	} else {
1374	syslog( "LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'", $hold_mode, $server->{account}->{id} );	1374	siplog( "LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'", $hold_mode, $server->{account}->{id} );
1375	$status = $ils->Transaction::Hold; # new?	1375	$status = $ils->Transaction::Hold; # new?
1376	$status->screen_msg("System error. Please contact library staff.");	1376	$status->screen_msg("System error. Please contact library staff.");
1377	}	1377	}
Lines 1419-1425 sub handle_renew { Link Here
1419	$ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_renew" );	1419	$ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_renew" );
1420		1420
1421	if ( $no_block eq 'Y' ) {	1421	if ( $no_block eq 'Y' ) {
1422	syslog( "LOG_WARNING", "handle_renew: received 'no block' renewal from terminal '%s'", $server->{account}->{id} );	1422	siplog( "LOG_WARNING", "handle_renew: received 'no block' renewal from terminal '%s'", $server->{account}->{id} );
1423	}	1423	}
1424		1424
1425	$patron_id = $fields->{ (FID_PATRON_ID) };	1425	$patron_id = $fields->{ (FID_PATRON_ID) };
Lines 1586-1592 sub send_acs_status { Link Here
1586	$retries = sprintf( "%03d", $policy->{retries} );	1586	$retries = sprintf( "%03d", $policy->{retries} );
1587		1587
1588	if ( length($retries) != 3 ) {	1588	if ( length($retries) != 3 ) {
1589	syslog( "LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", $retries );	1589	siplog( "LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", $retries );
1590	$retries = '000';	1590	$retries = '000';
1591	}	1591	}
1592		1592
Lines 1599-1605 sub send_acs_status { Link Here
1599	} elsif ( $protocol_version == 2 ) {	1599	} elsif ( $protocol_version == 2 ) {
1600	$msg .= '2.00';	1600	$msg .= '2.00';
1601	} else {	1601	} else {
1602	syslog( "LOG_ERR", 'Bad setting for $protocol_version, "%s" in send_acs_status', $protocol_version );	1602	siplog( "LOG_ERR", 'Bad setting for $protocol_version, "%s" in send_acs_status', $protocol_version );
1603	$msg .= '1.00';	1603	$msg .= '1.00';
1604	}	1604	}
1605		1605
Lines 1619-1625 sub send_acs_status { Link Here
1619	}	1619	}
1620	}	1620	}
1621	if ( length($supported_msgs) < 16 ) {	1621	if ( length($supported_msgs) < 16 ) {
1622	syslog( "LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs );	1622	siplog( "LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs );
1623	}	1623	}
1624	$msg .= add_field( FID_SUPPORTED_MSGS, $supported_msgs, $server );	1624	$msg .= add_field( FID_SUPPORTED_MSGS, $supported_msgs, $server );
1625	}	1625	}
Lines 1629-1635 sub send_acs_status { Link Here
1629	if ( defined( $account->{print_width} )	1629	if ( defined( $account->{print_width} )
1630	&& defined($print_line)	1630	&& defined($print_line)
1631	&& $account->{print_width} < length($print_line) ) {	1631	&& $account->{print_width} < length($print_line) ) {
1632	syslog( "LOG_WARNING", "send_acs_status: print line '%s' too long. Truncating", $print_line );	1632	siplog( "LOG_WARNING", "send_acs_status: print line '%s' too long. Truncating", $print_line );
1633	$print_line = substr( $print_line, 0, $account->{print_width} );	1633	$print_line = substr( $print_line, 0, $account->{print_width} );
1634	}	1634	}
1635		1635
Lines 1649-1655 sub patron_status_string { Link Here
1649	my $patron = shift;	1649	my $patron = shift;
1650	my $patron_status;	1650	my $patron_status;
1651		1651
1652	syslog( "LOG_DEBUG", "patron_status_string: %s charge_ok: %s", $patron->id, $patron->charge_ok );	1652	siplog( "LOG_DEBUG", "patron_status_string: %s charge_ok: %s", $patron->id, $patron->charge_ok );
1653	$patron_status = sprintf(	1653	$patron_status = sprintf(
1654	'%s%s%s%s%s%s%s%s%s%s%s%s%s%s',	1654	'%s%s%s%s%s%s%s%s%s%s%s%s%s%s',
1655	denied( $patron->charge_ok ),	1655	denied( $patron->charge_ok ),
1656	-