Attachment #103458 for bug #15253

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





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

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

    my $type = ref($class) || $class;
    my $self = {};
	$debug and warn "new ILS: INSTITUTION: " . Dumper($institution);
    log("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}) {
        log("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 );

            log(
                "LOG_DEBUG", "ILS::Checkout: patron %s has checked out %s",
                $patron_id, join( ', ', map{ $_->{barcode} } @{ $patron->{items} } )
            );
        }
        else {
            log( "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");
        log( "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");
            log("LOG_DEBUG", "C4::SIP::ILS::Checkin - item withdrawn");
    } elsif ( $data->{messages}->{WasLost} && !$circ->ok ) {
            $circ->screen_msg("Item lost, return not allowed");
            log("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 );
            log("LOG_DEBUG", "C4::SIP::ILS::Checkin - using checked_in_ok");
        } else {
            $circ->screen_msg("Item not checked out");
            log("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");
        log( "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
                log("LOG_ERR", "No barcode for item %s of %s: $item_id", $j+1, $count);
                next;
            }
            log("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) {
        log("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s", $patron->name, $patron->renew_ok);
    } else {
        log("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'", $patron_id);
    }

    if (!defined($patron)) {




use strict;
use warnings;

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


    my $type = ref($class) || $class;
    my $item = Koha::Items->find( { barcode => barcodedecode( $item_id ) } );
    unless ( $item ) {
        log("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;

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

    return $self;


    my $holder = Koha::Patrons->find( $borrowernumber );
    unless ($holder) {
        log("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(log);
use Data::Dumper;

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

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


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

    foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet') {
        $self->{$field} = 1;
    }
    log("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(log);
use Data::Dumper;
use CGI qw ( -utf8 );



sub do_checkout {
	my $self = shift;
	log('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;
                log('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(log);
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	log(
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 (-8 / +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
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(log);
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})) {
		log("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)) {
		log("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 });
    log('LOG_DEBUG', "raw_transport: timeout is $timeout");
    alarm $timeout;
    while (!$self->{account}) {
        $input = read_request();
        if (!$input) {
            # EOF on the socket
            log("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} );

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

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

sub get_clean_string {
	my $string = shift;
	if (defined $string) {
		log("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]+$//;
		log("LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string);
	} else {
		log("LOG_INFO", "get_clean_string called on undefined");
	}
	return $string;
}

	my $in = <STDIN>;
	$in = get_clean_string($in);
	while (my $extra = <STDIN>){
		log("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 });
    log("LOG_DEBUG", "telnet_transport: timeout is $timeout");

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

		$pwd = <STDIN>;
		alarm 0;

		log("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);
		log("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;
            }
	    }
		log("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||''));
		print("Invalid login$CRLF");
	}
    }; # End of eval

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

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


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

            alarm($timeout);

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

            my $status = C4::SIP::Sip::MsgType::handle( $inputbuf, $self, q{} );
            if ( !$status ) {
                log(
                    "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 {
          log( 'LOG_DEBUG', 'EOF returned on read' );
          return;
      }
      my $len = length $buffer;
      if ( $len != $raw_length ) {
          my $trim = $raw_length - $len;
          log( 'LOG_DEBUG', "read_request trimmed $trim character(s) " );
      }

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


        my $policy = $server->{policy} // {};
        my $rv = sprintf( "%03d", $policy->{timeout} // 0 );
        if( length($rv) != 3 ) {
            log( "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 log);

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 log)]);

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

    my ($i, $ent);

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


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

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

    $last_response = $msg;
}

sub log {
    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(log);
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	log( "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;
    }
    log( "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} ) ) {
        log( "LOG_WARNING", "new Sip::MsgType: Skipping message of unknown type '%s' in '%s'", $msgtag, $msg );
        return;
    } elsif ( !exists( $handlers{$msgtag}->{protocol}->{$protocol_version} ) ) {
        log( "LOG_WARNING", "new Sip::MsgType: Skipping message '%s' unsupported by protocol rev. '%d'", $msgtag, $protocol_version );
        return;
    }


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

    log( "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} ) ) {
            log( "LOG_WARNING", "Unsupported field '%s' in %s message '%s'", $fn, $self->{name}, $msg );
        } elsif ( defined( $self->{fields}->{$fn} ) ) {
            log( "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) ) {
            log( "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.
        log( "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} ) {
        log( "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
        log( "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.
        log( "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 {
        log( "LOG_WARNING", "Unrecognized protocol revision '%s', falling back to '1'", $sc_protocol_version );
        $new_proto = 1;
    }

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

    if ( $status == SC_STATUS_PAPER ) {
        log( "LOG_WARNING", "Self-Check unit '%s@%s' out of paper", $self->{account}->{id}, $self->{account}->{institution} );
    } elsif ( $status == SC_STATUS_SHUTDOWN ) {
        log( "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} ) ) {
        log( "LOG_WARNING", "MsgType::login_core: Unknown login '$uid'" );
        $status = 0;
    } elsif ( $server->{config}->{accounts}->{$uid}->{password} ne $pwd ) {
        log( "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 ) {
            log( "LOG_WARNING", "api_auth failed for SIP terminal '%s' of '%s': %s", $uid, $inst, ( $auth_status || 'unknown' ) );
            $status = 0;
        } else {
            log( "LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst );

            #
            # initialize connection to ILS
            #
            my $module = $server->{config}->{institutions}->{$inst}->{implementation};
            log( "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 ($@) {
                log( "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} ) {
                log( "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 ) {
        log( "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
    }

    log( "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 );

    log( "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) ) {
        log( "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) };

    log( "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 {
        log( "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' ) {
        log( "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 ) {
        log( "LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", $retries );
        $retries = '000';
    }


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


            }
        }
        if ( length($supported_msgs) < 16 ) {
            log( "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) ) {
        log( "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;

    log( "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(log);
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	log("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	log("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	log('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	log("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	log("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	log("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	log("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	log("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	log("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	log("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	log("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	log("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	log("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	log("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	log("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	log("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	log("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	log("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	log("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	log( '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	log( "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	log(
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	log( '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	log( 'LOG_DEBUG', "read_request trimmed $trim character(s) " );
379	}	379	}
380		380
381	syslog( 'LOG_INFO', "INPUT MSG: '$buffer'" );	381	log( '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	log( "LOG_ERR", "Policy timeout has wrong size: '%s'", $rv );
418	return '000';	418	return '000';
419	}	419	}
420	return $rv;	420	return $rv;

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(log);
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	log("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	log("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	log(
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	log( "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	log( "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	log("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	log("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	log("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	log("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	log( "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	log("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	log("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	log("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	log("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(log);
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	log("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	log( "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	log("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 (-4 / +4 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(log);
16	use Data::Dumper;	16	use Data::Dumper;
17		17
18	use C4::SIP::Sip qw(add_field);	18	use C4::SIP::Sip qw(add_field);
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	log("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	log("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 404-410 sub enable { Link Here
404	foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet') {	404	foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet') {
405	$self->{$field} = 1;	405	$self->{$field} = 1;
406	}	406	}
407	syslog("LOG_DEBUG", "Patron(%s)->enable: charge: %s, renew:%s, recall:%s, hold:%s",	407	log("LOG_DEBUG", "Patron(%s)->enable: charge: %s, renew:%s, recall:%s, hold:%s",
408	$self->{id}, $self->{charge_ok}, $self->{renew_ok},	408	$self->{id}, $self->{charge_ok}, $self->{renew_ok},
409	$self->{recall_ok}, $self->{hold_ok});	409	$self->{recall_ok}, $self->{hold_ok});
410	$self->{screen_msg} = "Enable feature not implemented."; # "All privileges restored."; # TODO: not really affecting patron record	410	$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(log);
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	log('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	log('LOG_DEBUG', "Blocking checkout Reason:$confirmation");
107	last;	107	last;
108	}	108	}
109	}	109	}

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 log);
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 log)]);
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	log("LOG_DEBUG", "add_field: Undefined value being added to '%s'",
72	$field_id);	72	$field_id);
73	$value = '';	73	$value = '';
74	}	74	}
Lines 128-134 sub add_count { Link Here
128		128
129	$count = sprintf("%04d", $count);	129	$count = sprintf("%04d", $count);
130	if (length($count) != 4) {	130	if (length($count) != 4) {
131	syslog("LOG_WARNING", "handle_patron_info: %s wrong size: '%s'",	131	log("LOG_WARNING", "handle_patron_info: %s wrong size: '%s'",
132	$label, $count);	132	$label, $count);
133	$count = ' ' x 4;	133	$count = ' ' x 4;
134	}	134	}
Lines 199-211 sub write_msg { Link Here
199	} else {	199	} else {
200	STDOUT->autoflush(1);	200	STDOUT->autoflush(1);
201	print $msg, $terminator;	201	print $msg, $terminator;
202	syslog("LOG_INFO", "OUTPUT MSG: '$msg'");	202	log("LOG_INFO", "OUTPUT MSG: '$msg'");
203	}	203	}
204		204
205	$last_response = $msg;	205	$last_response = $msg;
206	}	206	}
207		207
208	sub syslog {	208	sub log {
209	my ( $level, $mask, @args ) = @_;	209	my ( $level, $mask, @args ) = @_;
210		210
211	my $method =	211	my $method =

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	log( "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	log( "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	log( "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	log( "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	log( "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	log( "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	log( "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	log( "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	log( "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 520-526 sub handle_checkout { Link Here
520		520
521	# Off-line transactions need to be recorded, but there's	521	# Off-line transactions need to be recorded, but there's
522	# not a lot we can do about it	522	# not a lot we can do about it
523	syslog( "LOG_WARNING", "received no-block checkout from terminal '%s'", $account->{id} );	523	log( "LOG_WARNING", "received no-block checkout from terminal '%s'", $account->{id} );
524		524
525	$status = $ils->checkout_no_block( $patron_id, $item_id, $sc_renewal_policy, $trans_date, $nb_due_date );	525	$status = $ils->checkout_no_block( $patron_id, $item_id, $sc_renewal_policy, $trans_date, $nb_due_date );
526	} else {	526	} else {
Lines 647-653 sub handle_checkin { Link Here
647	if ( $no_block eq 'Y' ) {	647	if ( $no_block eq 'Y' ) {
648		648
649	# Off-line transactions, ick.	649	# Off-line transactions, ick.
650	syslog( "LOG_WARNING", "received no-block checkin from terminal '%s'", $account->{id} );	650	log( "LOG_WARNING", "received no-block checkin from terminal '%s'", $account->{id} );
651	$status = $ils->checkin_no_block( $item_id, $trans_date, $return_date, $item_props, $cancel );	651	$status = $ils->checkin_no_block( $item_id, $trans_date, $return_date, $item_props, $cancel );
652	} else {	652	} else {
653	$status = $ils->checkin( $item_id, $trans_date, $return_date, $my_branch, $item_props, $cancel, $account->{checked_in_ok}, $account->{cv_triggers_alert} );	653	$status = $ils->checkin( $item_id, $trans_date, $return_date, $my_branch, $item_props, $cancel, $account->{checked_in_ok}, $account->{cv_triggers_alert} );
Lines 766-784 sub handle_sc_status { Link Here
766	} elsif ( $sc_protocol_version =~ /^2\./ ) {	766	} elsif ( $sc_protocol_version =~ /^2\./ ) {
767	$new_proto = 2;	767	$new_proto = 2;
768	} else {	768	} else {
769	syslog( "LOG_WARNING", "Unrecognized protocol revision '%s', falling back to '1'", $sc_protocol_version );	769	log( "LOG_WARNING", "Unrecognized protocol revision '%s', falling back to '1'", $sc_protocol_version );
770	$new_proto = 1;	770	$new_proto = 1;
771	}	771	}
772		772
773	if ( $new_proto != $protocol_version ) {	773	if ( $new_proto != $protocol_version ) {
774	syslog( "LOG_INFO", "Setting protocol level to $new_proto" );	774	log( "LOG_INFO", "Setting protocol level to $new_proto" );
775	$protocol_version = $new_proto;	775	$protocol_version = $new_proto;
776	}	776	}
777		777
778	if ( $status == SC_STATUS_PAPER ) {	778	if ( $status == SC_STATUS_PAPER ) {
779	syslog( "LOG_WARNING", "Self-Check unit '%s@%s' out of paper", $self->{account}->{id}, $self->{account}->{institution} );	779	log( "LOG_WARNING", "Self-Check unit '%s@%s' out of paper", $self->{account}->{id}, $self->{account}->{institution} );
780	} elsif ( $status == SC_STATUS_SHUTDOWN ) {	780	} elsif ( $status == SC_STATUS_SHUTDOWN ) {
781	syslog( "LOG_WARNING", "Self-Check unit '%s@%s' shutting down", $self->{account}->{id}, $self->{account}->{institution} );	781	log( "LOG_WARNING", "Self-Check unit '%s@%s' shutting down", $self->{account}->{id}, $self->{account}->{institution} );
782	}	782	}
783		783
784	$self->{account}->{print_width} = $print_width;	784	$self->{account}->{print_width} = $print_width;
Lines 818-827 sub login_core { Link Here
818	my $pwd = shift;	818	my $pwd = shift;
819	my $status = 1; # Assume it all works	819	my $status = 1; # Assume it all works
820	if ( !exists( $server->{config}->{accounts}->{$uid} ) ) {	820	if ( !exists( $server->{config}->{accounts}->{$uid} ) ) {
821	syslog( "LOG_WARNING", "MsgType::login_core: Unknown login '$uid'" );	821	log( "LOG_WARNING", "MsgType::login_core: Unknown login '$uid'" );
822	$status = 0;	822	$status = 0;
823	} elsif ( $server->{config}->{accounts}->{$uid}->{password} ne $pwd ) {	823	} elsif ( $server->{config}->{accounts}->{$uid}->{password} ne $pwd ) {
824	syslog( "LOG_WARNING", "MsgType::login_core: Invalid password for login '$uid'" );	824	log( "LOG_WARNING", "MsgType::login_core: Invalid password for login '$uid'" );
825	$status = 0;	825	$status = 0;
826	} else {	826	} else {
827		827
Lines 835-850 sub login_core { Link Here
835		835
836	my $auth_status = api_auth( $uid, $pwd, $inst );	836	my $auth_status = api_auth( $uid, $pwd, $inst );
837	if ( !$auth_status or $auth_status !~ /^ok$/i ) {	837	if ( !$auth_status or $auth_status !~ /^ok$/i ) {
838	syslog( "LOG_WARNING", "api_auth failed for SIP terminal '%s' of '%s': %s", $uid, $inst, ( $auth_status \|\| 'unknown' ) );	838	log( "LOG_WARNING", "api_auth failed for SIP terminal '%s' of '%s': %s", $uid, $inst, ( $auth_status \|\| 'unknown' ) );
839	$status = 0;	839	$status = 0;
840	} else {	840	} else {
841	syslog( "LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst );	841	log( "LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst );
842		842
843	#	843	#
844	# initialize connection to ILS	844	# initialize connection to ILS
845	#	845	#
846	my $module = $server->{config}->{institutions}->{$inst}->{implementation};	846	my $module = $server->{config}->{institutions}->{$inst}->{implementation};
847	syslog( "LOG_DEBUG", 'login_core: ' . Dumper($module) );	847	log( "LOG_DEBUG", 'login_core: ' . Dumper($module) );
848		848
849	# Suspect this is always ILS but so we don't break any eccentic install (for now)	849	# Suspect this is always ILS but so we don't break any eccentic install (for now)
850	if ( $module eq 'ILS' ) {	850	if ( $module eq 'ILS' ) {
Lines 852-865 sub login_core { Link Here
852	}	852	}
853	$module->use;	853	$module->use;
854	if ($@) {	854	if ($@) {
855	syslog( "LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed", $server->{service}, $module, $inst );	855	log( "LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed", $server->{service}, $module, $inst );
856	die("Failed to load ILS implementation '$module' for $inst");	856	die("Failed to load ILS implementation '$module' for $inst");
857	}	857	}
858		858
859	# like ILS->new(), I think.	859	# like ILS->new(), I think.
860	$server->{ils} = $module->new( $server->{institution}, $server->{account} );	860	$server->{ils} = $module->new( $server->{institution}, $server->{account} );
861	if ( !$server->{ils} ) {	861	if ( !$server->{ils} ) {
862	syslog( "LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst );	862	log( "LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst );
863	die("Unable to connect to ILS '$inst'");	863	die("Unable to connect to ILS '$inst'");
864	}	864	}
865	}	865	}
Lines 882-888 sub handle_login { Link Here
882	$pwd = $fields->{ (FID_LOGIN_PWD) }; # Terminal PWD, not patron PWD.	882	$pwd = $fields->{ (FID_LOGIN_PWD) }; # Terminal PWD, not patron PWD.
883		883
884	if ( $uid_algorithm \|\| $pwd_algorithm ) {	884	if ( $uid_algorithm \|\| $pwd_algorithm ) {
885	syslog( "LOG_ERR", "LOGIN: Unsupported non-zero encryption method(s): uid = $uid_algorithm, pwd = $pwd_algorithm" );	885	log( "LOG_ERR", "LOGIN: Unsupported non-zero encryption method(s): uid = $uid_algorithm, pwd = $pwd_algorithm" );
886	$status = 0;	886	$status = 0;
887	} else {	887	} else {
888	$status = login_core( $server, $uid, $pwd );	888	$status = login_core( $server, $uid, $pwd );
Lines 921-933 sub summary_info { Link Here
921	return ''; # No detailed information required	921	return ''; # No detailed information required
922	}	922	}
923		923
924	syslog( "LOG_DEBUG", "Summary_info: index == '%d', field '%s'", $summary_type, $summary_map[$summary_type]->{fid} );	924	log( "LOG_DEBUG", "Summary_info: index == '%d', field '%s'", $summary_type, $summary_map[$summary_type]->{fid} );
925		925
926	my $func = $summary_map[$summary_type]->{func};	926	my $func = $summary_map[$summary_type]->{func};
927	my $fid = $summary_map[$summary_type]->{fid};	927	my $fid = $summary_map[$summary_type]->{fid};
928	my $itemlist = &$func( $patron, $start, $end, $server );	928	my $itemlist = &$func( $patron, $start, $end, $server );
929		929
930	syslog( "LOG_DEBUG", "summary_info: list = (%s)", join( ", ", map{ $_->{barcode} } @{$itemlist} ) );	930	log( "LOG_DEBUG", "summary_info: list = (%s)", join( ", ", map{ $_->{barcode} } @{$itemlist} ) );
931	foreach my $i ( @{$itemlist} ) {	931	foreach my $i ( @{$itemlist} ) {
932	$resp .= add_field( $fid, $i->{barcode}, $server );	932	$resp .= add_field( $fid, $i->{barcode}, $server );
933	}	933	}
Lines 1245-1251 sub handle_item_status_update { Link Here
1245	$item_props = $fields->{ (FID_ITEM_PROPS) };	1245	$item_props = $fields->{ (FID_ITEM_PROPS) };
1246		1246
1247	if ( !defined($item_id) ) {	1247	if ( !defined($item_id) ) {
1248	syslog( "LOG_WARNING", "handle_item_status: received message without Item ID field" );	1248	log( "LOG_WARNING", "handle_item_status: received message without Item ID field" );
1249	} else {	1249	} else {
1250	$item = $ils->find_item($item_id);	1250	$item = $ils->find_item($item_id);
1251	}	1251	}
Lines 1290-1296 sub handle_patron_enable { Link Here
1290	$patron_id = $fields->{ (FID_PATRON_ID) };	1290	$patron_id = $fields->{ (FID_PATRON_ID) };
1291	$patron_pwd = $fields->{ (FID_PATRON_PWD) };	1291	$patron_pwd = $fields->{ (FID_PATRON_PWD) };
1292		1292
1293	syslog( "LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'", $patron_id, $patron_pwd );	1293	log( "LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'", $patron_id, $patron_pwd );
1294		1294
1295	$patron = $ils->find_patron($patron_id);	1295	$patron = $ils->find_patron($patron_id);
1296		1296
Lines 1360-1366 sub handle_hold { Link Here
1360	} elsif ( $hold_mode eq '*' ) {	1360	} elsif ( $hold_mode eq '*' ) {
1361	$status = $ils->alter_hold( $patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_locn, $hold_type, $fee_ack );	1361	$status = $ils->alter_hold( $patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_locn, $hold_type, $fee_ack );
1362	} else {	1362	} else {
1363	syslog( "LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'", $hold_mode, $server->{account}->{id} );	1363	log( "LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'", $hold_mode, $server->{account}->{id} );
1364	$status = $ils->Transaction::Hold; # new?	1364	$status = $ils->Transaction::Hold; # new?
1365	$status->screen_msg("System error. Please contact library staff.");	1365	$status->screen_msg("System error. Please contact library staff.");
1366	}	1366	}
Lines 1408-1414 sub handle_renew { Link Here
1408	$ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_renew" );	1408	$ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_renew" );
1409		1409
1410	if ( $no_block eq 'Y' ) {	1410	if ( $no_block eq 'Y' ) {
1411	syslog( "LOG_WARNING", "handle_renew: received 'no block' renewal from terminal '%s'", $server->{account}->{id} );	1411	log( "LOG_WARNING", "handle_renew: received 'no block' renewal from terminal '%s'", $server->{account}->{id} );
1412	}	1412	}
1413		1413
1414	$patron_id = $fields->{ (FID_PATRON_ID) };	1414	$patron_id = $fields->{ (FID_PATRON_ID) };
Lines 1575-1581 sub send_acs_status { Link Here
1575	$retries = sprintf( "%03d", $policy->{retries} );	1575	$retries = sprintf( "%03d", $policy->{retries} );
1576		1576
1577	if ( length($retries) != 3 ) {	1577	if ( length($retries) != 3 ) {
1578	syslog( "LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", $retries );	1578	log( "LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", $retries );
1579	$retries = '000';	1579	$retries = '000';
1580	}	1580	}
1581		1581
Lines 1588-1594 sub send_acs_status { Link Here
1588	} elsif ( $protocol_version == 2 ) {	1588	} elsif ( $protocol_version == 2 ) {
1589	$msg .= '2.00';	1589	$msg .= '2.00';
1590	} else {	1590	} else {
1591	syslog( "LOG_ERR", 'Bad setting for $protocol_version, "%s" in send_acs_status', $protocol_version );	1591	log( "LOG_ERR", 'Bad setting for $protocol_version, "%s" in send_acs_status', $protocol_version );
1592	$msg .= '1.00';	1592	$msg .= '1.00';
1593	}	1593	}
1594		1594
Lines 1608-1614 sub send_acs_status { Link Here
1608	}	1608	}
1609	}	1609	}
1610	if ( length($supported_msgs) < 16 ) {	1610	if ( length($supported_msgs) < 16 ) {
1611	syslog( "LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs );	1611	log( "LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs );
1612	}	1612	}
1613	$msg .= add_field( FID_SUPPORTED_MSGS, $supported_msgs, $server );	1613	$msg .= add_field( FID_SUPPORTED_MSGS, $supported_msgs, $server );
1614	}	1614	}
Lines 1618-1624 sub send_acs_status { Link Here
1618	if ( defined( $account->{print_width} )	1618	if ( defined( $account->{print_width} )
1619	&& defined($print_line)	1619	&& defined($print_line)
1620	&& $account->{print_width} < length($print_line) ) {	1620	&& $account->{print_width} < length($print_line) ) {
1621	syslog( "LOG_WARNING", "send_acs_status: print line '%s' too long. Truncating", $print_line );	1621	log( "LOG_WARNING", "send_acs_status: print line '%s' too long. Truncating", $print_line );
1622	$print_line = substr( $print_line, 0, $account->{print_width} );	1622	$print_line = substr( $print_line, 0, $account->{print_width} );
1623	}	1623	}
1624		1624
Lines 1638-1644 sub patron_status_string { Link Here
1638	my $patron = shift;	1638	my $patron = shift;
1639	my $patron_status;	1639	my $patron_status;
1640		1640
1641	syslog( "LOG_DEBUG", "patron_status_string: %s charge_ok: %s", $patron->id, $patron->charge_ok );	1641	log( "LOG_DEBUG", "patron_status_string: %s charge_ok: %s", $patron->id, $patron->charge_ok );
1642	$patron_status = sprintf(	1642	$patron_status = sprintf(
1643	'%s%s%s%s%s%s%s%s%s%s%s%s%s%s',	1643	'%s%s%s%s%s%s%s%s%s%s%s%s%s%s',
1644	denied( $patron->charge_ok ),	1644	denied( $patron->charge_ok ),
1645	-