Attachment #35574 for bug #7904

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




# ILS.pm: Koha ILS interface module
#

package C4::SIP::ILS;

use warnings;
use strict;
use Sys::Syslog qw(syslog);
use Data::Dumper;

use C4::SIP::ILS::Item;
use C4::SIP::ILS::Patron;
use C4::SIP::ILS::Transaction;
use C4::SIP::ILS::Transaction::Checkout;
use C4::SIP::ILS::Transaction::Checkin;
use C4::SIP::ILS::Transaction::FeePayment;
use C4::SIP::ILS::Transaction::Hold;
use C4::SIP::ILS::Transaction::Renew;
use C4::SIP::ILS::Transaction::RenewAll;

my $debug = 0;


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

sub find_patron {
    my $self = shift;
 	$debug and warn "ILS: finding patron";
    return C4::SIP::ILS::Patron->new(@_);
}

sub find_item {
    my $self = shift;
	$debug and warn "ILS: finding item";
    return C4::SIP::ILS::Item->new(@_);
}

sub institution {

    my ($self, $patron_id, $item_id, $sc_renew) = @_;
    my ($patron, $item, $circ);

    $circ = C4::SIP::ILS::Transaction::Checkout->new();
    # BEGIN TRANSACTION
    $circ->patron($patron = C4::SIP::ILS::Patron->new( $patron_id));
    $circ->item($item = C4::SIP::ILS::Item->new( $item_id));

    if (!$patron) {
		$circ->screen_msg("Invalid Patron");

	$current_loc, $item_props, $cancel) = @_;
    my ($patron, $item, $circ);

    $circ = C4::SIP::ILS::Transaction::Checkin->new();
    # BEGIN TRANSACTION
    $circ->item($item = C4::SIP::ILS::Item->new( $item_id));

    if ($item) {
        $circ->do_checkin($current_loc, $return_date);

		$circ->screen_msg("Item not checked out");
	} else {
		if ($circ->ok) {
			$circ->patron($patron = C4::SIP::ILS::Patron->new( $item->{patron}));
			delete $item->{patron};
			delete $item->{due_date};
			$patron->{items} = [ grep {$_ ne $item_id} @{$patron->{items}} ];

	$pay_type, $fee_id, $trans_id, $currency) = @_;
    my $trans;

    $trans = C4::SIP::ILS::Transaction::FeePayment->new();


    $trans->transaction_id($trans_id);
    my $patron;
    $trans->patron($patron = C4::SIP::ILS::Patron->new($patron_id));
    if (!$patron) {
        $trans->screen_msg('Invalid patron barcode.');
        return $trans;

	$expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
    my ($patron, $item);

	my $trans = C4::SIP::ILS::Transaction::Hold->new();

    $patron = C4::SIP::ILS::Patron->new( $patron_id);
    if (!$patron
	|| (defined($patron_pwd) && !$patron->check_password($patron_pwd))) {
		$trans->screen_msg("Invalid Patron.");
		return $trans;
    }

	unless ($item = C4::SIP::ILS::Item->new($item_id || $title_id)) {
		$trans->screen_msg("No such item.");
		return $trans;
	}

    my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_;
    my ($patron, $item, $hold);

	my $trans = C4::SIP::ILS::Transaction::Hold->new();

    $patron = C4::SIP::ILS::Patron->new( $patron_id );
    if (!$patron) {
		$trans->screen_msg("Invalid patron barcode.");
		return $trans;

		return $trans;
    }

    unless ($item = C4::SIP::ILS::Item->new($item_id || $title_id)) {
		$trans->screen_msg("No such item.");
		return $trans;
    }

    my $hold;
    my $trans;

    $trans = C4::SIP::ILS::Transaction::Hold->new();

    # BEGIN TRANSACTION
    $patron = C4::SIP::ILS::Patron->new( $patron_id );
    unless ($patron) {
		$trans->screen_msg("Invalid patron barcode: '$patron_id'.");
		return $trans;

	    # $trans->ok(1);
	    $trans->screen_msg("Hold updated.");
	    $trans->patron($patron);
	    $trans->item(C4::SIP::ILS::Item->new( $hold->{item_id}));
	    last;
	}
    }

    my ($patron, $item);
    my $trans;

    $trans = C4::SIP::ILS::Transaction::Renew->new();
    $trans->patron($patron = C4::SIP::ILS::Patron->new( $patron_id ));

    if (!$patron) {
		$trans->screen_msg("Invalid patron barcode.");

            syslog("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 );
				last;
			}
		}

    my ($patron, $item_id);
    my $trans;

    $trans = C4::SIP::ILS::Transaction::RenewAll->new();

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




# A Class for hiding the ILS's concept of the item from OpenSIP
#

package C4::SIP::ILS::Item;

use strict;
use warnings;

use Sys::Syslog qw(syslog);
use Carp;

use C4::SIP::ILS::Transaction;

use C4::Debug;
use C4::Context;


sub status_update {     # FIXME: this looks unimplemented
    my ($self, $props) = @_;
    my $status = C4::SIP::ILS::Transaction->new();
    $self->{sip_item_properties} = $props;
    $status->{ok} = 1;
    return $status;

Lines 5-11 Link Here

(-)a/C4/SIP/ILS/Patron.pm (-1 / +1 lines)
5	# system	5	# system
6	#	6	#
7		7
8	package ILS::Patron;	8	package C4::SIP::ILS::Patron;
9		9
10	use strict;	10	use strict;
11	use warnings;	11	use warnings;

Lines 2-8 Link Here

(-)a/C4/SIP/ILS/Transaction.pm (-1 / +1 lines)
2	# Transaction: Superclass of all the transactional status objects	2	# Transaction: Superclass of all the transactional status objects
3	#	3	#
4		4
5	package ILS::Transaction;	5	package C4::SIP::ILS::Transaction;
6		6
7	use Carp;	7	use Carp;
8	use strict;	8	use strict;




# An object to handle checkin status
#

package C4::SIP::ILS::Transaction::Checkin;

use warnings;
use strict;

# use POSIX qw(strftime);

use C4::SIP::ILS::Transaction;
use ILS::Transaction;

use C4::Circulation;
use C4::Reserves qw( ModReserveAffect );
use C4::Items qw( ModItemTransfer );
use C4::Debug;

use parent qw(C4::SIP::ILS::Transaction);

my %fields = (
    magnetic => 0,




# An object to handle checkout status
#

package C4::SIP::ILS::Transaction::Checkout;

use warnings;
use strict;

use Data::Dumper;
use CGI qw ( -utf8 );

use C4::SIP::ILS::Transaction;
use ILS::Transaction;

use C4::Context;
use C4::Circulation;
use C4::Members;
use C4::Reserves qw(ModReserveFill);
use C4::Debug;
use parent qw(C4::SIP::ILS::Transaction);

our $debug;


Lines 1-4 Link Here

(-)a/C4/SIP/ILS/Transaction/FeePayment.pm (-3 / +2 lines)
1	package ILS::Transaction::FeePayment;	1	package C4::SIP::ILS::Transaction::FeePayment;
2		2
3	use warnings;	3	use warnings;
4	use strict;	4	use strict;
Lines 21-28 use strict; Link Here
21	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.	21	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
22		22
23	use C4::Accounts qw(recordpayment);	23	use C4::Accounts qw(recordpayment);
24	use ILS;	24	use parent qw(C4::SIP::ILS::Transaction);
25	use parent qw(ILS::Transaction);
26		25
27		26
28	our $debug = 0;	27	our $debug = 0;




#
# status of a Hold transaction

package C4::SIP::ILS::Transaction::Hold;

use warnings;
use strict;

use C4::SIP::ILS::Transaction;
use ILS::Transaction;

use C4::Reserves;	# AddReserve
use C4::Members;	# GetMember
use C4::Biblio;		# GetBiblioFromItemNumber GetBiblioItemByBiblioNumber
use parent qw(C4::SIP::ILS::Transaction);


our $VERSION = 3.07.00.049;




# Status of a Renew Transaction
#

package C4::SIP::ILS::Transaction::Renew;

use warnings;
use strict;

use ILS;

use C4::Circulation;
use C4::Members;

use parent qw(C4::SIP::ILS::Transaction);

my %fields = (
    renewal_ok => 0,




#
# RenewAll: class to manage status of "Renew All" transaction

package C4::SIP::ILS::Transaction::RenewAll;

use strict;
use warnings;

use Sys::Syslog qw(syslog);

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

use C4::Members qw( GetMember );

use parent qw(C4::SIP::ILS::Transaction::Renew);

my %fields = (
    renewed   => [],

    $self->{unrenewed} = [];
    foreach my $itemx ( @{ $patron->{items} } ) {
        my $item_id = $itemx->{barcode};
        my $item    = C4::SIP::ILS::Item->new($item_id);
        if ( !defined($item) ) {
            syslog(
                'LOG_WARNING',




#!/usr/bin/perl
package C4::SIP::SIPServer;

use strict;
use warnings;

use Socket qw(:DEFAULT :crlf);
require UNIVERSAL::require;

use C4::SIP::Sip::Constants qw(:all);
use C4::SIP::Sip::Configuration;
use C4::SIP::Sip::Checksum qw(checksum verify_cksum);
use C4::SIP::Sip::MsgType qw( handle login_core );
use C4::SIP::Sip qw( read_SIP_packet );

use base qw(Net::Server::PreFork);


#
# Read configuration
#
my $config = C4::SIP::Sip::Configuration->new( $ARGV[0] );
my @parms;

#

    while (!$self->{account}) {
    local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; };
    syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout});
    $input = read_SIP_packet(*STDIN);
    if (!$input) {
        # EOF on the socket
        syslog("LOG_INFO", "raw_transport: shutting down: EOF during login");
        return;
    }
    $input =~ s/[\r\n]+$//sm;	# Strip off trailing line terminator(s)
    last if C4::SIP::Sip::MsgType::handle($input, $self, LOGIN);
    }

    syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",

	    if (exists ($config->{accounts}->{$uid})
		&& ($pwd eq $config->{accounts}->{$uid}->password())) {
			$account = $config->{accounts}->{$uid};
			if ( C4::SIP::Sip::MsgType::login_core($self,$uid,$pwd) ) {
                last;
            }
	    }
		syslog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||''));
		print("Invalid login$CRLF");

    my $expect = '';
    while (1) {
        alarm $timeout;
        $input = read_SIP_packet(*STDIN);
        unless ($input) {
            return;		# EOF
        }

            next;
		}
		# end cheap input hacks
		my $status = handle($input, $self, $expect);
		if (!$status) {
			syslog("LOG_ERR", "sip_protocol_loop: failed to handle %s",substr($input,0,2));
		}

Lines 2-8 Link Here

(-)a/C4/SIP/Sip.pm (-3 / +3 lines)
2	# Sip.pm: General Sip utility functions	2	# Sip.pm: General Sip utility functions
3	#	3	#
4		4
5	package Sip;	5	package C4::SIP::Sip;
6		6
7	use strict;	7	use strict;
8	use warnings;	8	use warnings;
Lines 13-20 use POSIX qw(strftime); Link Here
13	use Socket qw(:crlf);	13	use Socket qw(:crlf);
14	use IO::Handle;	14	use IO::Handle;
15		15
16	use Sip::Constants qw(SIP_DATETIME FID_SCREEN_MSG);	16	use C4::SIP::Sip::Constants qw(SIP_DATETIME FID_SCREEN_MSG);
17	use Sip::Checksum qw(checksum);	17	use C4::SIP::Sip::Checksum qw(checksum);
18		18
19	use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);	19	use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
20		20

Lines 1-4 Link Here

(-)a/C4/SIP/Sip/Checksum.pm (-1 / +1 lines)
1	package Sip::Checksum;	1	package C4::SIP::Sip::Checksum;
2		2
3	use Exporter;	3	use Exporter;
4	use strict;	4	use strict;




# structure.
#

package C4::SIP::Sip::Configuration;

use strict;
use warnings;
use XML::Simple qw(:strict);

use C4::SIP::Sip::Configuration::Institution;
use C4::SIP::Sip::Configuration::Account;
use C4::SIP::Sip::Configuration::Service;

my $parser = new XML::Simple( KeyAttr   => { login => '+id',
					     institution => '+id',

    my %listeners;

    foreach my $acct (values %{$cfg->{accounts}}) {
		C4::SIP::Sip::Configuration::Account->new( $acct );
    }

    # The key to the listeners hash is the 'port' component of the

    # find_server() when building the keys to search the hash.

    foreach my $service (values %{$cfg->{listeners}}) {
		C4::SIP::Sip::Configuration::Service->new( $service );
		$listeners{lc $service->{port}} = $service;
    }
    $cfg->{listeners} = \%listeners;

    foreach my $inst (values %{$cfg->{institutions}}) {
        C4::SIP::Sip::Configuration::Institution->new( $inst );
    }
    return bless $cfg, $class;
}

Lines 3-9 Link Here

(-)a/C4/SIP/Sip/Configuration/Account.pm (-1 / +1 lines)
3	#	3	#
4	#	4	#
5		5
6	package Sip::Configuration::Account;	6	package C4::SIP::Sip::Configuration::Account;
7		7
8	use strict;	8	use strict;
9	use warnings;	9	use warnings;

Lines 3-9 Link Here

(-)a/C4/SIP/Sip/Configuration/Institution.pm (-1 / +1 lines)
3	#	3	#
4	#	4	#
5		5
6	package Sip::Configuration::Institution;	6	package C4::SIP::Sip::Configuration::Institution;
7		7
8	use strict;	8	use strict;
9	use warnings;	9	use warnings;

Lines 3-9 Link Here

(-)a/C4/SIP/Sip/Configuration/Service.pm (-1 / +1 lines)
3	#	3	#
4	#	4	#
5		5
6	package Sip::Configuration::Service;	6	package C4::SIP::Sip::Configuration::Service;
7		7
8	use strict;	8	use strict;
9	use warnings;	9	use warnings;

Lines 5-11 Link Here

(-)a/C4/SIP/Sip/Constants.pm (-1 / +1 lines)
5	# Protocol for communication between a library's Automated	5	# Protocol for communication between a library's Automated
6	# Checkout System (ACS) and stand-alone Self-Check (SC) units	6	# Checkout System (ACS) and stand-alone Self-Check (SC) units
7		7
8	package Sip::Constants;	8	package C4::SIP::Sip::Constants;
9		9
10	use strict;	10	use strict;
11	use warnings;	11	use warnings;




# A Class for handing SIP messages
#

package C4::SIP::Sip::MsgType;

use strict;
use warnings;
use Exporter;
use Sys::Syslog qw(syslog);

use C4::SIP::Sip qw(:all);
use C4::SIP::Sip::Constants qw(:all);
use C4::SIP::Sip::Checksum qw(verify_cksum);

use Data::Dumper;
use CGI qw ( -utf8 );

BEGIN {
    $VERSION = 3.07.00.049;
	@ISA = qw(Exporter);
	@EXPORT_OK = qw(handle login_core);
}

# Predeclare handler subroutines

    if ($msg eq REQUEST_ACS_RESEND_CKSUM) {
		# Special case
		$error_detection = 1;
		$self = C4::SIP::Sip::MsgType->new((REQUEST_ACS_RESEND), 0);
    } elsif((length($msg) > 11) && (substr($msg, -9, 2) eq "AY")) {
		$error_detection = 1;


	} else {
	    # Save the sequence number, then strip off the
	    # error detection data to process the message
	    $self = C4::SIP::Sip::MsgType->new(substr($msg, 0, -9), substr($msg, -7, 1));
	}
    } elsif ($error_detection) {
	# We received a non-ED message when ED is supposed to be active.

		syslog("LOG_WARNING",
	       "Received message without error detection: '%s'", $msg);
		$error_detection = 0;
		$self = C4::SIP::Sip::MsgType->new($msg, 0);
    } else {
		$self = C4::SIP::Sip::MsgType->new($msg, 0);
    }

	if ((substr($msg, 0, 2) ne REQUEST_ACS_RESEND) &&


    if ($patron) {
	$resp .= patron_status_string($patron);
	$resp .= $lang . timestamp();
	$resp .= add_field(FID_PERSONAL_NAME, $patron->name);

	# while the patron ID we got from the SC is valid, let's

    } else {
	# Invalid patron id.  Report that the user has no privs.,
	# no personal name, and is invalid (if we're using 2.00)
	$resp .= 'YYYY' . (' ' x 10) . $lang . timestamp();
	$resp .= add_field(FID_PERSONAL_NAME, '');

	# the patron ID is invalid, but it's a required field, so

	}
	# We never return the obsolete 'U' value for 'desensitize'
	$resp .= sipbool($status->desensitize);
	$resp .= timestamp;

	# Now for the variable fields
	$resp .= add_field(FID_INST_ID, $inst);

	$resp .= add_field(FID_ITEM_ID, $item_id);
	$resp .= add_field(FID_TITLE_ID, $item->title_id);
    if ($item->due_date) {
        $resp .= add_field(FID_DUE_DATE, timestamp($item->due_date));
    } else {
        $resp .= add_field(FID_DUE_DATE, q{});
    }

	# Checkout failed
	# Checkout Response: not ok, no renewal, don't know mag. media,
	# no desensitize
	$resp = sprintf("120NUN%s", timestamp);
	$resp .= add_field(FID_INST_ID, $inst);
	$resp .= add_field(FID_PATRON_ID, $patron_id);
	$resp .= add_field(FID_ITEM_ID, $item_id);

        }
    }
    $resp .= $status->alert ? 'Y' : 'N';
    $resp .= timestamp;
    $resp .= add_field(FID_INST_ID, $inst_id);
    $resp .= add_field(FID_ITEM_ID, $item_id);


			#
			my $module = $server->{config}->{institutions}->{$inst}->{implementation};
			syslog("LOG_DEBUG", 'login_core: ' . Dumper($module));
            # Suspect this is always ILS but so we dont break any eccentic install (for now)
            if ($module eq 'ILS') {
                $module = 'C4::SIP::ILS';
            }
			$module->use;
			if ($@) {
				syslog("LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed",

    if ($patron) {
        $resp .= patron_status_string($patron);
        $resp .= (defined($lang) and length($lang) ==3) ? $lang : $patron->language;
        $resp .= timestamp();

        $resp .= add_count('patron_info/hold_items',
            scalar @{$patron->hold_items});

        # Invalid patron ID:
        # no privileges, no items associated,
        # no personal name, and is invalid (if we're using 2.00)
        $resp .= 'YYYY' . (' ' x 10) . $lang . timestamp();
        $resp .= '0000' x 6;

        $resp .= add_field(FID_INST_ID,       ($ils->institution_id || 'SIP2'));

    ($status, $screen_msg, $print_line) = $ils->end_patron_session($fields->{(FID_PATRON_ID)});

    $resp .= $status ? 'Y' : 'N';
    $resp .= timestamp();

    $resp .= add_field(FID_INST_ID, $server->{ils}->institution);
    $resp .= add_field(FID_PATRON_ID, $fields->{(FID_PATRON_ID)});

    $status = $ils->pay_fee($patron_id, $patron_pwd, $fee_amt, $fee_type,
			   $pay_type, $fee_id, $trans_id, $currency);

    $resp .= ($status->ok ? 'Y' : 'N') . timestamp;
    $resp .= add_field(FID_INST_ID, $inst_id);
    $resp .= add_field(FID_PATRON_ID, $patron_id);
    $resp .= maybe_add(FID_TRANSACTION_ID, $status->transaction_id);

	# Invalid Item ID
	# "Other" circ stat, "Other" security marker, "Unknown" fee type
	$resp .= "010101";
	$resp .= timestamp;
	# Just echo back the invalid item id
	$resp .= add_field(FID_ITEM_ID, $fields->{(FID_ITEM_ID)});
	# title id is required, but we don't have one

	$resp .= $item->sip_circulation_status;
	$resp .= $item->sip_security_marker;
	$resp .= $item->sip_fee_type;
	$resp .= timestamp;

	$resp .= add_field(FID_ITEM_ID,  $item->id);
	$resp .= add_field(FID_TITLE_ID, $item->title_id);

	    $resp .= add_field(FID_HOLD_QUEUE_LEN, $i);
	}
	if ($item->due_date) {
	    $resp .= add_field(FID_DUE_DATE, timestamp($item->due_date));
	}
	if (($i = $item->recall_date) != 0) {
	    $resp .= add_field(FID_RECALL_DATE, timestamp($i));
	}
	if (($i = $item->hold_pickup_date) != 0) {
	    $resp .= add_field(FID_HOLD_PICKUP_DATE, timestamp($i));
	}

    $resp .= maybe_add(FID_SCREEN_MSG, $item->screen_msg, $server);

    if (!$item) {
	# Invalid Item ID
	$resp .= '0';
	$resp .= timestamp;
	$resp .= add_field(FID_ITEM_ID, $item_id);
    } else {
	# Valid Item ID

	$status = $item->status_update($item_props);

	$resp .= $status->ok ? '1' : '0';
	$resp .= timestamp;

	$resp .= add_field(FID_ITEM_ID, $item->id);
	$resp .= add_field(FID_TITLE_ID, $item->title_id);


    if (!defined($patron)) {
	# Invalid patron ID
	$resp .= 'YYYY' . (' ' x 10) . '000' . timestamp();
	$resp .= add_field(FID_PATRON_ID, $patron_id);
	$resp .= add_field(FID_PERSONAL_NAME, '');
	$resp .= add_field(FID_VALID_PATRON, 'N');

	    $status = $patron->enable;
	}
	$resp .= patron_status_string($patron);
	$resp .= $patron->language . timestamp();

	$resp .= add_field(FID_PATRON_ID, $patron->id);
	$resp .= add_field(FID_PERSONAL_NAME, $patron->name);


    $resp .= $status->ok;
    $resp .= sipbool($status->item  &&  $status->item->available($patron_id));
    $resp .= timestamp;

    if ($status->ok) {
	$resp .= add_field(FID_PATRON_ID,   $status->patron->id);

	($status->expiration_date) and
	$resp .= maybe_add(FID_EXPIRATION,
			             timestamp($status->expiration_date));
	$resp .= maybe_add(FID_QUEUE_POS,   $status->queue_position);
	$resp .= maybe_add(FID_PICKUP_LOCN, $status->pickup_location);
	$resp .= maybe_add(FID_ITEM_ID,     $status->item->id);

	    $resp .= 'U';
	}
	$resp .= sipbool($status->desensitize);
	$resp .= timestamp;
	$resp .= add_field(FID_PATRON_ID, $patron->id);
	$resp .= add_field(FID_ITEM_ID,  $item->id);
	$resp .= add_field(FID_TITLE_ID, $item->title_id);
    if ($item->due_date) {
        $resp .= add_field(FID_DUE_DATE, timestamp($item->due_date));
    } else {
        $resp .= add_field(FID_DUE_DATE, q{});
    }

	# renew failed for some reason
	# not OK, renewal not OK, Unknown media type (why bother checking?)
	$resp .= '0NUN';
	$resp .= timestamp;
	# If we found the patron or the item, the return the ILS
	# information, otherwise echo back the infomation we received
	# from the terminal

		$resp .= add_count("renew_all/unrenewed_count", scalar @unrenewed);
	}

    $resp .= timestamp;
    $resp .= add_field(FID_INST_ID, $ils->institution);

    $resp .= join('', map(add_field(FID_RENEWED_ITEMS  , $_), @renewed  ));


    $msg .= "$online_status$checkin_ok$checkout_ok$ACS_renewal_policy";
    $msg .= "$status_update_ok$offline_ok$timeout$retries";
    $msg .= timestamp();

    if ($protocol_version == 1) {
	$msg .= '1.00';


	foreach my $msg_name (@message_type_names) {
	    if ($msg_name eq 'request sc/acs resend') {
		$supported_msgs .= sipbool(1);
	    } else {
		$supported_msgs .= sipbool($ils->supports($msg_name));
	    }
	}
	if (length($supported_msgs) < 16) {

Lines 2-12 Link Here

(-)a/C4/SIP/example_institution_dump.sh (-4 / +4 lines)
2		2
3	perl -I ./ -e '	3	perl -I ./ -e '
4	use Data::Dumper;	4	use Data::Dumper;
5	use ILS;	5	use C4::SIP::ILS;
6	use Sip::Configuration;	6	use C4::SIP::Sip::Configuration;
7	my $code = "MAIN";	7	my $code = "MAIN";
8	my $conf = Sip::Configuration->new("SIPconfig.xml");	8	my $conf = C4::SIP::Sip::Configuration->new("SIPconfig.xml");
9	my $ils = ILS->new($conf->{institutions}->{$code});	9	my $ils = C4::SIP::ILS->new($conf->{institutions}->{$code});
10	print "XML for $code: ", Dumper($conf->{institutions}->{$code}), "\n";	10	print "XML for $code: ", Dumper($conf->{institutions}->{$code}), "\n";
11	print "ILS for $code: ", Dumper($ils), "\n";	11	print "ILS for $code: ", Dumper($ils), "\n";
12	print "\$ils->checkout_ok(): ", ($ils->checkout_ok() ? "Y" : "N"), "\n";	12	print "\$ils->checkout_ok(): ", ($ils->checkout_ok() ? "Y" : "N"), "\n";

Lines 4-10 Link Here

(-)a/C4/SIP/interactive_item_dump.pl (-2 / +2 lines)
4	use warnings;	4	use warnings;
5	use strict;	5	use strict;
6		6
7	use ILS::Item;	7	use C4::SIP::ILS::Item;
8	use Data::Dumper;	8	use Data::Dumper;
9		9
10	my $compare = (@ARGV) ? shift : 0;	10	my $compare = (@ARGV) ? shift : 0;
Lines 14-20 while (1) { Link Here
14	defined($in) or last;	14	defined($in) or last;
15	chomp($in);	15	chomp($in);
16	last unless $in;	16	last unless $in;
17	my $item = ILS::Item->new($in);	17	my $item = C4::SIP::ILS::Item->new($in);
18	unless ($item) {	18	unless ($item) {
19	print "No item ($in)";	19	print "No item ($in)";
20	next;	20	next;

Lines 4-11 Link Here

(-)a/C4/SIP/interactive_patron_check_password.pl (-3 / +3 lines)
4	use warnings;	4	use warnings;
5	use strict;	5	use strict;
6		6
7	use ILS::Patron;	7	use C4::SIP::ILS::Patron;
8	use Sip qw(sipbool);	8	use C4::SIP::Sip qw(sipbool);
9	use Data::Dumper;	9	use Data::Dumper;
10		10
11	while (1) {	11	while (1) {
Lines 14-20 while (1) { Link Here
14	defined($in) or last;	14	defined($in) or last;
15	chomp($in);	15	chomp($in);
16	last unless $in;	16	last unless $in;
17	my $patron = ILS::Patron->new($in);	17	my $patron = C4::SIP::ILS::Patron->new($in);
18	print Dumper($patron);	18	print Dumper($patron);
19	$patron or next;	19	$patron or next;
20	print "Enter patron password: ";	20	print "Enter patron password: ";

Lines 4-10 Link Here

(-)a/C4/SIP/interactive_patron_dump.pl (-2 / +2 lines)
4	use warnings;	4	use warnings;
5	use strict;	5	use strict;
6		6
7	use ILS::Patron;	7	use C4::SIP::ILS::Patron;
8	use Data::Dumper;	8	use Data::Dumper;
9		9
10	while (1) {	10	while (1) {
Lines 13-18 while (1) { Link Here
13	defined($in) or last;	13	defined($in) or last;
14	chomp($in);	14	chomp($in);
15	last unless $in;	15	last unless $in;
16	my $patron = ILS::Patron->new($in);	16	my $patron = C4::SIP::ILS::Patron->new($in);
17	print "Patron ($in):\n", Dumper($patron);	17	print "Patron ($in):\n", Dumper($patron);
18	}	18	}

Lines 4-10 Link Here

(-)a/C4/SIP/interactive_renew_all_dump.pl (-2 / +2 lines)
4	use warnings;	4	use warnings;
5	use strict;	5	use strict;
6		6
7	use ILS::Transaction::RenewAll;	7	use C4::SIP::ILS::Transaction::RenewAll;
8	use Data::Dumper;	8	use Data::Dumper;
9		9
10	while (1) {	10	while (1) {
Lines 15-21 while (1) { Link Here
15	last unless $in;	15	last unless $in;
16	my $patron = ILS::Patron->new($in);	16	my $patron = ILS::Patron->new($in);
17	print "Patron before: \n " . Dumper($patron);	17	print "Patron before: \n " . Dumper($patron);
18	my $action = ILS::Transaction::RenewAll->new();	18	my $action = C4::SIP::ILS::Transaction::RenewAll->new();
19	$action->do_renew_all();	19	$action->do_renew_all();
20	print "\n\nTransaction::RenewAll: " . Dumper($action);	20	print "\n\nTransaction::RenewAll: " . Dumper($action);
21	print "\n", "=" x 35, "\n";	21	print "\n", "=" x 35, "\n";

Lines 5-15 Link Here

(-)a/C4/SIP/t/000_sc_config_auth.t (-1 / +3 lines)
5		5
6	use strict;	6	use strict;
7	use warnings;	7	use warnings;
		8	use FindBin qw($Bin);
		9	use lib "$Bin";
8		10
9	use Test::More tests => 15;	11	use Test::More tests => 15;
10		12
11	BEGIN {	13	BEGIN {
12	use_ok('Sip::Constants', qw(:all));	14	use_ok('C4::SIP::Sip::Constants', qw(:all));
13	use_ok('SIPtest', qw(:basic :user1 :auth));	15	use_ok('SIPtest', qw(:basic :user1 :auth));
14	use_ok('C4::Auth', qw(&check_api_auth));	16	use_ok('C4::Auth', qw(&check_api_auth));
15	use_ok('C4::Context');	17	use_ok('C4::Context');

Lines 6-11 Link Here

(-)a/C4/SIP/t/00sc_status.t (+2 lines)
6		6
7	use strict;	7	use strict;
8	use warnings;	8	use warnings;
		9	use FindBin qw($Bin);
		10	use lib "$Bin";
9		11
10	use SIPtest qw($datepat $username $password $login_test $sc_status_test);	12	use SIPtest qw($datepat $username $password $login_test $sc_status_test);
11		13

Lines 4-11 Link Here

(-)a/C4/SIP/t/01patron_status.t (-2 / +4 lines)
4		4
5	use strict;	5	use strict;
6	use warnings;	6	use warnings;
		7	use FindBin qw($Bin);
		8	use lib "$Bin";
7		9
8	use Sip::Constants qw(:all);	10	use C4::SIP::Sip::Constants qw(:all);
9	use SIPtest qw($datepat $instid $currency :user1);	11	use SIPtest qw($datepat $instid $currency :user1);
10		12
11	my @tests = (	13	my @tests = (
Lines 73-78 my @tests = ( Link Here
73	], },	75	], },
74	);	76	);
75		77
76	SIPtest::run_sip_tests(@tests);	78	SIPtest::run_sip_tests(@tests);
77		79
78	1;	80	1;

Lines 3-11 Link Here

(-)a/C4/SIP/t/02patron_info.t (-1 / +3 lines)
3		3
4	use strict;	4	use strict;
5	use warnings;	5	use warnings;
		6	use FindBin qw($Bin);
		7	use lib "$Bin";
6	use Clone qw(clone);	8	use Clone qw(clone);
7		9
8	use Sip::Constants qw(:all);	10	use C4::SIP::Sip::Constants qw(:all);
9		11
10	use SIPtest qw(:basic :user1);	12	use SIPtest qw(:basic :user1);
11		13

Lines 3-13 Link Here

(-)a/C4/SIP/t/03checkout.t (-1 / +3 lines)
3		3
4	use strict;	4	use strict;
5	use warnings;	5	use warnings;
		6	use FindBin qw($Bin);
		7	use lib "$Bin";
6	use Clone qw(clone);	8	use Clone qw(clone);
7		9
8	use CGI qw ( -utf8 );	10	use CGI qw ( -utf8 );
9		11
10	use Sip::Constants qw(:all);	12	use C4::SIP::Sip::Constants qw(:all);
11	use SIPtest qw(	13	use SIPtest qw(
12	:basic	14	:basic
13	$user_barcode	15	$user_barcode

Lines 3-11 Link Here

(-)a/C4/SIP/t/04patron_status.t (-1 / +3 lines)
3		3
4	use strict;	4	use strict;
5	use warnings;	5	use warnings;
		6	use FindBin qw($Bin);
		7	use lib "$Bin";
6	use Clone qw(clone);	8	use Clone qw(clone);
7		9
8	use Sip::Constants qw(:all);	10	use C4::SIP::Sip::Constants qw(:all);
9	use SIPtest qw(:user1 :basic);	11	use SIPtest qw(:user1 :basic);
10		12
11	my $patron_status_test_template = {	13	my $patron_status_test_template = {

Lines 3-11 Link Here

(-)a/C4/SIP/t/05block_patron.t (-2 / +4 lines)
3		3
4	use strict;	4	use strict;
5	use warnings;	5	use warnings;
		6	use FindBin qw($Bin);
		7	use lib "$Bin";
6	use Clone qw(clone);	8	use Clone qw(clone);
7		9
8	use Sip::Constants qw(:all);	10	use C4::SIP::Sip::Constants qw(:all);
9		11
10	use SIPtest qw(:basic :user1);	12	use SIPtest qw(:basic :user1);
11		13
Lines 40-45 my @tests = ( Link Here
40	clone($block_patron_test_template),	42	clone($block_patron_test_template),
41	);	43	);
42		44
43	SIPtest::run_sip_tests(@tests);	45	SIPtest::run_sip_tests(@tests);
44		46
45	1;	47	1;

Lines 3-11 Link Here

(-)a/C4/SIP/t/06patron_enable.t (-1 / +3 lines)
3		3
4	use strict;	4	use strict;
5	use warnings;	5	use warnings;
		6	use FindBin qw($Bin);
		7	use lib "$Bin";
6	use Clone qw(clone);	8	use Clone qw(clone);
7		9
8	use Sip::Constants qw(:all);	10	use C4::SIP::Sip::Constants qw(:all);
9		11
10	use SIPtest qw(:basic :user1);	12	use SIPtest qw(:basic :user1);
11		13

Lines 3-11 Link Here

(-)a/C4/SIP/t/07hold.t (-1 / +3 lines)
3		3
4	use strict;	4	use strict;
5	use warnings;	5	use warnings;
		6	use FindBin qw($Bin);
		7	use lib "$Bin";
6	use Clone qw(clone);	8	use Clone qw(clone);
7		9
8	use Sip::Constants qw(:all);	10	use C4::SIP::Sip::Constants qw(:all);
9		11
10	use SIPtest qw(:basic :user1 :user2 :item1 :item2);	12	use SIPtest qw(:basic :user1 :user2 :item1 :item2);
11		13

Lines 3-11 Link Here

(-)a/C4/SIP/t/08checkin.t (-1 / +3 lines)
3		3
4	use strict;	4	use strict;
5	use warnings;	5	use warnings;
		6	use FindBin qw($Bin);
		7	use lib "$Bin";
6	use Clone qw(clone);	8	use Clone qw(clone);
7		9
8	use Sip::Constants qw(:all);	10	use C4::SIP::Sip::Constants qw(:all);
9	use SIPtest qw(:basic :user1 :item1);	11	use SIPtest qw(:basic :user1 :item1);
10		12
11	# Checkout response, format:	13	# Checkout response, format:

Lines 3-11 Link Here

(-)a/C4/SIP/t/09renew.t (-1 / +3 lines)
3		3
4	use strict;	4	use strict;
5	use warnings;	5	use warnings;
		6	use FindBin qw($Bin);
		7	use lib "$Bin";
6	use Clone qw(clone);	8	use Clone qw(clone);
7		9
8	use Sip::Constants qw(:all);	10	use C4::SIP::Sip::Constants qw(:all);
9		11
10	use SIPtest qw(:basic :user1 :item1);	12	use SIPtest qw(:basic :user1 :item1);
11		13

Lines 3-11 Link Here

(-)a/C4/SIP/t/10renew_all.t (-1 / +3 lines)
3		3
4	use strict;	4	use strict;
5	use warnings;	5	use warnings;
		6	use FindBin qw($Bin);
		7	use lib "$Bin";
6	use Clone qw(clone);	8	use Clone qw(clone);
7		9
8	use Sip::Constants qw(:all);	10	use C4::SIP::Sip::Constants qw(:all);
9		11
10	use SIPtest qw(:basic :user1 :item1 :item2);	12	use SIPtest qw(:basic :user1 :item1 :item2);
11		13

Lines 3-11 Link Here

(-)a/C4/SIP/t/11item_info.t (-1 / +3 lines)
3		3
4	use strict;	4	use strict;
5	use warnings;	5	use warnings;
		6	use FindBin qw($Bin);
		7	use lib "$Bin";
6	use Clone qw(clone);	8	use Clone qw(clone);
7		9
8	use Sip::Constants qw(:all);	10	use C4::SIP::Sip::Constants qw(:all);
9	use SIPtest qw(:basic :user1 :item1);	11	use SIPtest qw(:basic :user1 :item1);
10		12
11	my $item_info_test_template = {	13	my $item_info_test_template = {

Lines 41-49 use Test::More; Link Here

(-)a/C4/SIP/t/SIPtest.pm (-3 / +3 lines)
41	use CGI qw ( -utf8 );	41	use CGI qw ( -utf8 );
42		42
43	use IO::Socket::INET;	43	use IO::Socket::INET;
44	use Sip qw(:all);	44	use C4::SIP::Sip qw(:all);
45	use Sip::Checksum qw(verify_cksum);	45	use C4::SIP::Sip::Checksum qw(verify_cksum);
46	use Sip::Constants qw(:all);	46	use C4::SIP::Sip::Constants qw(:all);
47		47
48	use C4::Auth qw(&check_api_auth);	48	use C4::Auth qw(&check_api_auth);
49	use C4::Context;	49	use C4::Context;

Lines 7-13 Link Here

(-)a/C4/SIP/xmlparse.pl (-1 / +1 lines)
7	# in Sip::Configuration.pm	7	# in Sip::Configuration.pm
8	#	8	#
9	use strict;	9	use strict;
10	#use warnings; FIXME - Bug 2505	10	use warnings;
11	use English;	11	use English;
12		12
13	use XML::Simple qw(:strict);	13	use XML::Simple qw(:strict);

Lines 39-48 find({ Link Here

(-)a/t/00-load.t (-1 / +2 lines)
39	wanted => sub {	39	wanted => sub {
40	my $m = $_;	40	my $m = $_;
41	return unless $m =~ s/[.]pm$//;	41	return unless $m =~ s/[.]pm$//;
		42
42	$m =~ s{^.*/C4/}{C4/};	43	$m =~ s{^.*/C4/}{C4/};
43	$m =~ s{/}{::}g;	44	$m =~ s{/}{::}g;
44	return if $m =~ /Auth_with_ldap/; # Dont test this, it will fail on use	45	return if $m =~ /Auth_with_ldap/; # Dont test this, it will fail on use
45	return if $m =~ /SIP/; # SIP modules will not load clean	46	return if $m =~ /SIPServer/; # SIP Server module has old package usage
46	use_ok($m) \|\| BAIL_OUT("***** PROBLEMS LOADING FILE '$m'");	47	use_ok($m) \|\| BAIL_OUT("***** PROBLEMS LOADING FILE '$m'");
47	},	48	},
48	}, $lib);	49	}, $lib);




use Test::Warn;

BEGIN {
        use FindBin;
        use lib "$FindBin::Bin/../C4/SIP";
        use_ok('C4::SIP::Sip');
}

my $date_time = C4::SIP::Sip::timestamp();
like( $date_time, qr/^\d{8}    \d{6}$/, 'Timestamp format no param');

my $t = time();

$date_time = C4::SIP::Sip::timestamp($t);
like( $date_time, qr/^\d{8}    \d{6}$/, 'Timestamp format secs');

$date_time = C4::SIP::Sip::timestamp('2011-01-12');
ok( $date_time eq '20110112    235900', 'Timestamp iso date string');

my $myChecksum = C4::SIP::Sip::Checksum::checksum("12345");
my $checker = 65281;
my $stringChecksum = C4::SIP::Sip::Checksum::checksum("teststring");
my $stringChecker = 64425;

is( $myChecksum, $checker, "Checksum: $myChecksum matches expected output");
is( $stringChecksum, $stringChecker, "Checksum: $stringChecksum matches expected output");

my $testdata = "abcdAZ";
my $something = C4::SIP::Sip::Checksum::checksum($testdata);

$something =  sprintf("%4X", $something);
ok( C4::SIP::Sip::Checksum::verify_cksum($testdata.$something), "Checksum: $something is valid.");

my $invalidTest;
warning_is { $invalidTest = C4::SIP::Sip::Checksum::verify_cksum("1234567") }
            'verify_cksum: no sum detected',
            'verify_cksum prints the expected warning for an invalid checksum';
is($invalidTest, 0, "Checksum: 1234567 is invalid as expected");
- 

Return to bug 7904

Lines 2-22 Link Here

(-)a/C4/SIP/ILS.pm (-36 / +36 lines)
2	# ILS.pm: Koha ILS interface module	2	# ILS.pm: Koha ILS interface module
3	#	3	#
4		4
5	package ILS;	5	package C4::SIP::ILS;
6		6
7	use warnings;	7	use warnings;
8	use strict;	8	use strict;
9	use Sys::Syslog qw(syslog);	9	use Sys::Syslog qw(syslog);
10		10	use Data::Dumper;
11	use ILS::Item;	11
12	use ILS::Patron;	12	use C4::SIP::ILS::Item;
13	use ILS::Transaction;	13	use C4::SIP::ILS::Patron;
14	use ILS::Transaction::Checkout;	14	use C4::SIP::ILS::Transaction;
15	use ILS::Transaction::Checkin;	15	use C4::SIP::ILS::Transaction::Checkout;
16	use ILS::Transaction::FeePayment;	16	use C4::SIP::ILS::Transaction::Checkin;
17	use ILS::Transaction::Hold;	17	use C4::SIP::ILS::Transaction::FeePayment;
18	use ILS::Transaction::Renew;	18	use C4::SIP::ILS::Transaction::Hold;
19	use ILS::Transaction::RenewAll;	19	use C4::SIP::ILS::Transaction::Renew;
		20	use C4::SIP::ILS::Transaction::RenewAll;
20		21
21	my $debug = 0;	22	my $debug = 0;
22		23
Lines 45-51 sub new { Link Here
45	my ($class, $institution) = @_;	46	my ($class, $institution) = @_;
46	my $type = ref($class) \|\| $class;	47	my $type = ref($class) \|\| $class;
47	my $self = {};	48	my $self = {};
48	use Data::Dumper;
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	syslog("LOG_DEBUG", "new ILS '%s'", $institution->{id});
51	$self->{institution} = $institution;	51	$self->{institution} = $institution;
Lines 55-67 sub new { Link Here
55	sub find_patron {	55	sub find_patron {
56	my $self = shift;	56	my $self = shift;
57	$debug and warn "ILS: finding patron";	57	$debug and warn "ILS: finding patron";
58	return ILS::Patron->new(@_);	58	return C4::SIP::ILS::Patron->new(@_);
59	}	59	}
60		60
61	sub find_item {	61	sub find_item {
62	my $self = shift;	62	my $self = shift;
63	$debug and warn "ILS: finding item";	63	$debug and warn "ILS: finding item";
64	return ILS::Item->new(@_);	64	return C4::SIP::ILS::Item->new(@_);
65	}	65	}
66		66
67	sub institution {	67	sub institution {
Lines 129-138 sub checkout { Link Here
129	my ($self, $patron_id, $item_id, $sc_renew) = @_;	129	my ($self, $patron_id, $item_id, $sc_renew) = @_;
130	my ($patron, $item, $circ);	130	my ($patron, $item, $circ);
131		131
132	$circ = new ILS::Transaction::Checkout;	132	$circ = C4::SIP::ILS::Transaction::Checkout->new();
133	# BEGIN TRANSACTION	133	# BEGIN TRANSACTION
134	$circ->patron($patron = new ILS::Patron $patron_id);	134	$circ->patron($patron = C4::SIP::ILS::Patron->new( $patron_id));
135	$circ->item($item = new ILS::Item $item_id);	135	$circ->item($item = C4::SIP::ILS::Item->new( $item_id));
136		136
137	if (!$patron) {	137	if (!$patron) {
138	$circ->screen_msg("Invalid Patron");	138	$circ->screen_msg("Invalid Patron");
Lines 176-184 sub checkin { Link Here
176	$current_loc, $item_props, $cancel) = @_;	176	$current_loc, $item_props, $cancel) = @_;
177	my ($patron, $item, $circ);	177	my ($patron, $item, $circ);
178		178
179	$circ = new ILS::Transaction::Checkin;	179	$circ = C4::SIP::ILS::Transaction::Checkin->new();
180	# BEGIN TRANSACTION	180	# BEGIN TRANSACTION
181	$circ->item($item = new ILS::Item $item_id);	181	$circ->item($item = C4::SIP::ILS::Item->new( $item_id));
182		182
183	if ($item) {	183	if ($item) {
184	$circ->do_checkin($current_loc, $return_date);	184	$circ->do_checkin($current_loc, $return_date);
Lines 194-200 sub checkin { Link Here
194	$circ->screen_msg("Item not checked out");	194	$circ->screen_msg("Item not checked out");
195	} else {	195	} else {
196	if ($circ->ok) {	196	if ($circ->ok) {
197	$circ->patron($patron = new ILS::Patron $item->{patron});	197	$circ->patron($patron = C4::SIP::ILS::Patron->new( $item->{patron}));
198	delete $item->{patron};	198	delete $item->{patron};
199	delete $item->{due_date};	199	delete $item->{due_date};
200	$patron->{items} = [ grep {$_ ne $item_id} @{$patron->{items}} ];	200	$patron->{items} = [ grep {$_ ne $item_id} @{$patron->{items}} ];
Lines 219-230 sub pay_fee { Link Here
219	$pay_type, $fee_id, $trans_id, $currency) = @_;	219	$pay_type, $fee_id, $trans_id, $currency) = @_;
220	my $trans;	220	my $trans;
221		221
222	$trans = ILS::Transaction::FeePayment->new();	222	$trans = C4::SIP::ILS::Transaction::FeePayment->new();
223		223
224		224
225	$trans->transaction_id($trans_id);	225	$trans->transaction_id($trans_id);
226	my $patron;	226	my $patron;
227	$trans->patron($patron = ILS::Patron->new($patron_id));	227	$trans->patron($patron = C4::SIP::ILS::Patron->new($patron_id));
228	if (!$patron) {	228	if (!$patron) {
229	$trans->screen_msg('Invalid patron barcode.');	229	$trans->screen_msg('Invalid patron barcode.');
230	return $trans;	230	return $trans;
Lines 240-255 sub add_hold { Link Here
240	$expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;	240	$expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
241	my ($patron, $item);	241	my ($patron, $item);
242		242
243	my $trans = new ILS::Transaction::Hold;	243	my $trans = C4::SIP::ILS::Transaction::Hold->new();
244		244
245	$patron = new ILS::Patron $patron_id;	245	$patron = C4::SIP::ILS::Patron->new( $patron_id);
246	if (!$patron	246	if (!$patron
247	\|\| (defined($patron_pwd) && !$patron->check_password($patron_pwd))) {	247	\|\| (defined($patron_pwd) && !$patron->check_password($patron_pwd))) {
248	$trans->screen_msg("Invalid Patron.");	248	$trans->screen_msg("Invalid Patron.");
249	return $trans;	249	return $trans;
250	}	250	}
251		251
252	unless ($item = new ILS::Item ($item_id \|\| $title_id)) {	252	unless ($item = C4::SIP::ILS::Item->new($item_id \|\| $title_id)) {
253	$trans->screen_msg("No such item.");	253	$trans->screen_msg("No such item.");
254	return $trans;	254	return $trans;
255	}	255	}
Lines 287-295 sub cancel_hold { Link Here
287	my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_;	287	my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_;
288	my ($patron, $item, $hold);	288	my ($patron, $item, $hold);
289		289
290	my $trans = new ILS::Transaction::Hold;	290	my $trans = C4::SIP::ILS::Transaction::Hold->new();
291		291
292	$patron = new ILS::Patron $patron_id;	292	$patron = C4::SIP::ILS::Patron->new( $patron_id );
293	if (!$patron) {	293	if (!$patron) {
294	$trans->screen_msg("Invalid patron barcode.");	294	$trans->screen_msg("Invalid patron barcode.");
295	return $trans;	295	return $trans;
Lines 298-304 sub cancel_hold { Link Here
298	return $trans;	298	return $trans;
299	}	299	}
300		300
301	unless ($item = new ILS::Item ($item_id \|\| $title_id)) {	301	unless ($item = C4::SIP::ILS::Item->new($item_id \|\| $title_id)) {
302	$trans->screen_msg("No such item.");	302	$trans->screen_msg("No such item.");
303	return $trans;	303	return $trans;
304	}	304	}
Lines 345-354 sub alter_hold { Link Here
345	my $hold;	345	my $hold;
346	my $trans;	346	my $trans;
347		347
348	$trans = new ILS::Transaction::Hold;	348	$trans = C4::SIP::ILS::Transaction::Hold->new();
349		349
350	# BEGIN TRANSACTION	350	# BEGIN TRANSACTION
351	$patron = new ILS::Patron $patron_id;	351	$patron = C4::SIP::ILS::Patron->new( $patron_id );
352	unless ($patron) {	352	unless ($patron) {
353	$trans->screen_msg("Invalid patron barcode: '$patron_id'.");	353	$trans->screen_msg("Invalid patron barcode: '$patron_id'.");
354	return $trans;	354	return $trans;
Lines 366-372 sub alter_hold { Link Here
366	# $trans->ok(1);	366	# $trans->ok(1);
367	$trans->screen_msg("Hold updated.");	367	$trans->screen_msg("Hold updated.");
368	$trans->patron($patron);	368	$trans->patron($patron);
369	$trans->item(new ILS::Item $hold->{item_id});	369	$trans->item(C4::SIP::ILS::Item->new( $hold->{item_id}));
370	last;	370	last;
371	}	371	}
372	}	372	}
Lines 390-397 sub renew { Link Here
390	my ($patron, $item);	390	my ($patron, $item);
391	my $trans;	391	my $trans;
392		392
393	$trans = new ILS::Transaction::Renew;	393	$trans = C4::SIP::ILS::Transaction::Renew->new();
394	$trans->patron($patron = new ILS::Patron $patron_id);	394	$trans->patron($patron = C4::SIP::ILS::Patron->new( $patron_id ));
395		395
396	if (!$patron) {	396	if (!$patron) {
397	$trans->screen_msg("Invalid patron barcode.");	397	$trans->screen_msg("Invalid patron barcode.");
Lines 421-427 sub renew { Link Here
421	syslog("LOG_DEBUG", "checking item %s of %s: $item_id vs. %s", ++$j, $count, $i->{barcode});	421	syslog("LOG_DEBUG", "checking item %s of %s: $item_id vs. %s", ++$j, $count, $i->{barcode});
422	if ($i->{barcode} eq $item_id) {	422	if ($i->{barcode} eq $item_id) {
423	# We have it checked out	423	# We have it checked out
424	$item = new ILS::Item $item_id;	424	$item = C4::SIP::ILS::Item->new( $item_id );
425	last;	425	last;
426	}	426	}
427	}	427	}
Lines 448-456 sub renew_all { Link Here
448	my ($patron, $item_id);	448	my ($patron, $item_id);
449	my $trans;	449	my $trans;
450		450
451	$trans = new ILS::Transaction::RenewAll;	451	$trans = C4::SIP::ILS::Transaction::RenewAll->new();
452		452
453	$trans->patron($patron = new ILS::Patron $patron_id);	453	$trans->patron($patron = C4::SIP::ILS::Patron->new( $patron_id ));
454	if (defined $patron) {	454	if (defined $patron) {
455	syslog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s", $patron->name, $patron->renew_ok);	455	syslog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s", $patron->name, $patron->renew_ok);
456	} else {	456	} else {

Lines 4-10 Link Here

(-)a/C4/SIP/ILS/Item.pm (-3 / +3 lines)
4	# A Class for hiding the ILS's concept of the item from OpenSIP	4	# A Class for hiding the ILS's concept of the item from OpenSIP
5	#	5	#
6		6
7	package ILS::Item;	7	package C4::SIP::ILS::Item;
8		8
9	use strict;	9	use strict;
10	use warnings;	10	use warnings;
Lines 12-18 use warnings; Link Here
12	use Sys::Syslog qw(syslog);	12	use Sys::Syslog qw(syslog);
13	use Carp;	13	use Carp;
14		14
15	use ILS::Transaction;	15	use C4::SIP::ILS::Transaction;
16		16
17	use C4::Debug;	17	use C4::Debug;
18	use C4::Context;	18	use C4::Context;
Lines 233-239 sub AUTOLOAD { Link Here
233		233
234	sub status_update { # FIXME: this looks unimplemented	234	sub status_update { # FIXME: this looks unimplemented
235	my ($self, $props) = @_;	235	my ($self, $props) = @_;
236	my $status = new ILS::Transaction;	236	my $status = C4::SIP::ILS::Transaction->new();
237	$self->{sip_item_properties} = $props;	237	$self->{sip_item_properties} = $props;
238	$status->{ok} = 1;	238	$status->{ok} = 1;
239	return $status;	239	return $status;

Lines 2-23 Link Here

(-)a/C4/SIP/ILS/Transaction/Checkin.pm (-4 / +3 lines)
2	# An object to handle checkin status	2	# An object to handle checkin status
3	#	3	#
4		4
5	package ILS::Transaction::Checkin;	5	package C4::SIP::ILS::Transaction::Checkin;
6		6
7	use warnings;	7	use warnings;
8	use strict;	8	use strict;
9		9
10	# use POSIX qw(strftime);	10	# use POSIX qw(strftime);
11		11
12	use ILS;	12	use C4::SIP::ILS::Transaction;
13	use ILS::Transaction;
14		13
15	use C4::Circulation;	14	use C4::Circulation;
16	use C4::Reserves qw( ModReserveAffect );	15	use C4::Reserves qw( ModReserveAffect );
17	use C4::Items qw( ModItemTransfer );	16	use C4::Items qw( ModItemTransfer );
18	use C4::Debug;	17	use C4::Debug;
19		18
20	use parent qw(ILS::Transaction);	19	use parent qw(C4::SIP::ILS::Transaction);
21		20
22	my %fields = (	21	my %fields = (
23	magnetic => 0,	22	magnetic => 0,

Lines 2-8 Link Here

(-)a/C4/SIP/ILS/Transaction/Checkout.pm (-4 / +3 lines)
2	# An object to handle checkout status	2	# An object to handle checkout status
3	#	3	#
4		4
5	package ILS::Transaction::Checkout;	5	package C4::SIP::ILS::Transaction::Checkout;
6		6
7	use warnings;	7	use warnings;
8	use strict;	8	use strict;
Lines 12-26 use Sys::Syslog qw(syslog); Link Here
12	use Data::Dumper;	12	use Data::Dumper;
13	use CGI qw ( -utf8 );	13	use CGI qw ( -utf8 );
14		14
15	use ILS;	15	use C4::SIP::ILS::Transaction;
16	use ILS::Transaction;
17		16
18	use C4::Context;	17	use C4::Context;
19	use C4::Circulation;	18	use C4::Circulation;
20	use C4::Members;	19	use C4::Members;
21	use C4::Reserves qw(ModReserveFill);	20	use C4::Reserves qw(ModReserveFill);
22	use C4::Debug;	21	use C4::Debug;
23	use parent qw(ILS::Transaction);	22	use parent qw(C4::SIP::ILS::Transaction);
24		23
25	our $debug;	24	our $debug;
26		25

Lines 1-18 Link Here

(-)a/C4/SIP/ILS/Transaction/Hold.pm (-4 / +3 lines)
1	#	1	#
2	# status of a Hold transaction	2	# status of a Hold transaction
3		3
4	package ILS::Transaction::Hold;	4	package C4::SIP::ILS::Transaction::Hold;
5		5
6	use warnings;	6	use warnings;
7	use strict;	7	use strict;
8		8
9	use ILS;	9	use C4::SIP::ILS::Transaction;
10	use ILS::Transaction;
11		10
12	use C4::Reserves; # AddReserve	11	use C4::Reserves; # AddReserve
13	use C4::Members; # GetMember	12	use C4::Members; # GetMember
14	use C4::Biblio; # GetBiblioFromItemNumber GetBiblioItemByBiblioNumber	13	use C4::Biblio; # GetBiblioFromItemNumber GetBiblioItemByBiblioNumber
15	use parent qw(ILS::Transaction);	14	use parent qw(C4::SIP::ILS::Transaction);
16		15
17		16
18	our $VERSION = 3.07.00.049;	17	our $VERSION = 3.07.00.049;

Lines 2-18 Link Here

(-)a/C4/SIP/ILS/Transaction/Renew.pm (-4 / +2 lines)
2	# Status of a Renew Transaction	2	# Status of a Renew Transaction
3	#	3	#
4		4
5	package ILS::Transaction::Renew;	5	package C4::SIP::ILS::Transaction::Renew;
6		6
7	use warnings;	7	use warnings;
8	use strict;	8	use strict;
9		9
10	use ILS;
11
12	use C4::Circulation;	10	use C4::Circulation;
13	use C4::Members;	11	use C4::Members;
14		12
15	use parent qw(ILS::Transaction);	13	use parent qw(C4::SIP::ILS::Transaction);
16		14
17	my %fields = (	15	my %fields = (
18	renewal_ok => 0,	16	renewal_ok => 0,

Lines 1-18 Link Here

(-)a/C4/SIP/ILS/Transaction/RenewAll.pm (-4 / +4 lines)
1	#	1	#
2	# RenewAll: class to manage status of "Renew All" transaction	2	# RenewAll: class to manage status of "Renew All" transaction
3		3
4	package ILS::Transaction::RenewAll;	4	package C4::SIP::ILS::Transaction::RenewAll;
5		5
6	use strict;	6	use strict;
7	use warnings;	7	use warnings;
8		8
9	use Sys::Syslog qw(syslog);	9	use Sys::Syslog qw(syslog);
10		10
11	use ILS::Item;	11	use C4::SIP::ILS::Item;
12		12
13	use C4::Members qw( GetMember );	13	use C4::Members qw( GetMember );
14		14
15	use parent qw(ILS::Transaction::Renew);	15	use parent qw(C4::SIP::ILS::Transaction::Renew);
16		16
17	my %fields = (	17	my %fields = (
18	renewed => [],	18	renewed => [],
Lines 40-46 sub do_renew_all { Link Here
40	$self->{unrenewed} = [];	40	$self->{unrenewed} = [];
41	foreach my $itemx ( @{ $patron->{items} } ) {	41	foreach my $itemx ( @{ $patron->{items} } ) {
42	my $item_id = $itemx->{barcode};	42	my $item_id = $itemx->{barcode};
43	my $item = 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	syslog(
46	'LOG_WARNING',	46	'LOG_WARNING',

Lines 1-5 Link Here

(-)a/C4/SIP/SIPServer.pm (-11 / +14 lines)
1	#!/usr/bin/perl	1	#!/usr/bin/perl
2	package SIPServer;	2	package C4::SIP::SIPServer;
3		3
4	use strict;	4	use strict;
5	use warnings;	5	use warnings;
Lines 11-20 use IO::Socket::INET; Link Here
11	use Socket qw(:DEFAULT :crlf);	11	use Socket qw(:DEFAULT :crlf);
12	require UNIVERSAL::require;	12	require UNIVERSAL::require;
13		13
14	use Sip::Constants qw(:all);	14	use C4::SIP::Sip::Constants qw(:all);
15	use Sip::Configuration;	15	use C4::SIP::Sip::Configuration;
16	use Sip::Checksum qw(checksum verify_cksum);	16	use C4::SIP::Sip::Checksum qw(checksum verify_cksum);
17	use Sip::MsgType;	17	use C4::SIP::Sip::MsgType qw( handle login_core );
		18	use C4::SIP::Sip qw( read_SIP_packet );
18		19
19	use base qw(Net::Server::PreFork);	20	use base qw(Net::Server::PreFork);
20		21
Lines 35-41 my %transports = ( Link Here
35	#	36	#
36	# Read configuration	37	# Read configuration
37	#	38	#
38	my $config = new Sip::Configuration $ARGV[0];	39	my $config = C4::SIP::Sip::Configuration->new( $ARGV[0] );
39	my @parms;	40	my @parms;
40		41
41	#	42	#
Lines 129-142 sub raw_transport { Link Here
129	while (!$self->{account}) {	130	while (!$self->{account}) {
130	local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; };	131	local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; };
131	syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout});	132	syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout});
132	$input = Sip::read_SIP_packet(*STDIN);	133	$input = read_SIP_packet(*STDIN);
133	if (!$input) {	134	if (!$input) {
134	# EOF on the socket	135	# EOF on the socket
135	syslog("LOG_INFO", "raw_transport: shutting down: EOF during login");	136	syslog("LOG_INFO", "raw_transport: shutting down: EOF during login");
136	return;	137	return;
137	}	138	}
138	$input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s)	139	$input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s)
139	last if Sip::MsgType::handle($input, $self, LOGIN);	140	last if C4::SIP::Sip::MsgType::handle($input, $self, LOGIN);
140	}	141	}
141		142
142	syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",	143	syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",
Lines 206-212 sub telnet_transport { Link Here
206	if (exists ($config->{accounts}->{$uid})	207	if (exists ($config->{accounts}->{$uid})
207	&& ($pwd eq $config->{accounts}->{$uid}->password())) {	208	&& ($pwd eq $config->{accounts}->{$uid}->password())) {
208	$account = $config->{accounts}->{$uid};	209	$account = $config->{accounts}->{$uid};
209	Sip::MsgType::login_core($self,$uid,$pwd) and last;	210	if ( C4::SIP::Sip::MsgType::login_core($self,$uid,$pwd) ) {
		211	last;
		212	}
210	}	213	}
211	syslog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid\|\|''));	214	syslog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid\|\|''));
212	print("Invalid login$CRLF");	215	print("Invalid login$CRLF");
Lines 259-265 sub sip_protocol_loop { Link Here
259	my $expect = '';	262	my $expect = '';
260	while (1) {	263	while (1) {
261	alarm $timeout;	264	alarm $timeout;
262	$input = Sip::read_SIP_packet(*STDIN);	265	$input = read_SIP_packet(*STDIN);
263	unless ($input) {	266	unless ($input) {
264	return; # EOF	267	return; # EOF
265	}	268	}
Lines 273-279 sub sip_protocol_loop { Link Here
273	next;	276	next;
274	}	277	}
275	# end cheap input hacks	278	# end cheap input hacks
276	my $status = Sip::MsgType::handle($input, $self, $expect);	279	my $status = handle($input, $self, $expect);
277	if (!$status) {	280	if (!$status) {
278	syslog("LOG_ERR", "sip_protocol_loop: failed to handle %s",substr($input,0,2));	281	syslog("LOG_ERR", "sip_protocol_loop: failed to handle %s",substr($input,0,2));
279	}	282	}

Lines 4-18 Link Here

(-)a/C4/SIP/Sip/Configuration.pm (-7 / +7 lines)
4	# structure.	4	# structure.
5	#	5	#
6		6
7	package Sip::Configuration;	7	package C4::SIP::Sip::Configuration;
8		8
9	use strict;	9	use strict;
10	use warnings;	10	use warnings;
11	use XML::Simple qw(:strict);	11	use XML::Simple qw(:strict);
12		12
13	use Sip::Configuration::Institution;	13	use C4::SIP::Sip::Configuration::Institution;
14	use Sip::Configuration::Account;	14	use C4::SIP::Sip::Configuration::Account;
15	use Sip::Configuration::Service;	15	use C4::SIP::Sip::Configuration::Service;
16		16
17	my $parser = new XML::Simple( KeyAttr => { login => '+id',	17	my $parser = new XML::Simple( KeyAttr => { login => '+id',
18	institution => '+id',	18	institution => '+id',
Lines 33-39 sub new { Link Here
33	my %listeners;	33	my %listeners;
34		34
35	foreach my $acct (values %{$cfg->{accounts}}) {	35	foreach my $acct (values %{$cfg->{accounts}}) {
36	new Sip::Configuration::Account $acct;	36	C4::SIP::Sip::Configuration::Account->new( $acct );
37	}	37	}
38		38
39	# The key to the listeners hash is the 'port' component of the	39	# The key to the listeners hash is the 'port' component of the
Lines 43-55 sub new { Link Here
43	# find_server() when building the keys to search the hash.	43	# find_server() when building the keys to search the hash.
44		44
45	foreach my $service (values %{$cfg->{listeners}}) {	45	foreach my $service (values %{$cfg->{listeners}}) {
46	new Sip::Configuration::Service $service;	46	C4::SIP::Sip::Configuration::Service->new( $service );
47	$listeners{lc $service->{port}} = $service;	47	$listeners{lc $service->{port}} = $service;
48	}	48	}
49	$cfg->{listeners} = \%listeners;	49	$cfg->{listeners} = \%listeners;
50		50
51	foreach my $inst (values %{$cfg->{institutions}}) {	51	foreach my $inst (values %{$cfg->{institutions}}) {
52	new Sip::Configuration::Institution $inst;	52	C4::SIP::Sip::Configuration::Institution->new( $inst );
53	}	53	}
54	return bless $cfg, $class;	54	return bless $cfg, $class;
55	}	55	}

Lines 4-19 Link Here

(-)a/C4/SIP/Sip/MsgType.pm (-37 / +41 lines)
4	# A Class for handing SIP messages	4	# A Class for handing SIP messages
5	#	5	#
6		6
7	package Sip::MsgType;	7	package C4::SIP::Sip::MsgType;
8		8
9	use strict;	9	use strict;
10	use warnings;	10	use warnings;
11	use Exporter;	11	use Exporter;
12	use Sys::Syslog qw(syslog);	12	use Sys::Syslog qw(syslog);
13		13
14	use Sip qw(:all);	14	use C4::SIP::Sip qw(:all);
15	use Sip::Constants qw(:all);	15	use C4::SIP::Sip::Constants qw(:all);
16	use Sip::Checksum qw(verify_cksum);	16	use C4::SIP::Sip::Checksum qw(verify_cksum);
17		17
18	use Data::Dumper;	18	use Data::Dumper;
19	use CGI qw ( -utf8 );	19	use CGI qw ( -utf8 );
Lines 26-32 use vars qw(@ISA $VERSION @EXPORT_OK); Link Here
26	BEGIN {	26	BEGIN {
27	$VERSION = 3.07.00.049;	27	$VERSION = 3.07.00.049;
28	@ISA = qw(Exporter);	28	@ISA = qw(Exporter);
29	@EXPORT_OK = qw(handle);	29	@EXPORT_OK = qw(handle login_core);
30	}	30	}
31		31
32	# Predeclare handler subroutines	32	# Predeclare handler subroutines
Lines 373-379 sub handle { Link Here
373	if ($msg eq REQUEST_ACS_RESEND_CKSUM) {	373	if ($msg eq REQUEST_ACS_RESEND_CKSUM) {
374	# Special case	374	# Special case
375	$error_detection = 1;	375	$error_detection = 1;
376	$self = new Sip::MsgType ((REQUEST_ACS_RESEND), 0);	376	$self = C4::SIP::Sip::MsgType->new((REQUEST_ACS_RESEND), 0);
377	} elsif((length($msg) > 11) && (substr($msg, -9, 2) eq "AY")) {	377	} elsif((length($msg) > 11) && (substr($msg, -9, 2) eq "AY")) {
378	$error_detection = 1;	378	$error_detection = 1;
379		379
Lines 386-392 sub handle { Link Here
386	} else {	386	} else {
387	# Save the sequence number, then strip off the	387	# Save the sequence number, then strip off the
388	# error detection data to process the message	388	# error detection data to process the message
389	$self = new Sip::MsgType (substr($msg, 0, -9), substr($msg, -7, 1));	389	$self = C4::SIP::Sip::MsgType->new(substr($msg, 0, -9), substr($msg, -7, 1));
390	}	390	}
391	} elsif ($error_detection) {	391	} elsif ($error_detection) {
392	# We received a non-ED message when ED is supposed to be active.	392	# We received a non-ED message when ED is supposed to be active.
Lines 394-402 sub handle { Link Here
394	syslog("LOG_WARNING",	394	syslog("LOG_WARNING",
395	"Received message without error detection: '%s'", $msg);	395	"Received message without error detection: '%s'", $msg);
396	$error_detection = 0;	396	$error_detection = 0;
397	$self = new Sip::MsgType ($msg, 0);	397	$self = C4::SIP::Sip::MsgType->new($msg, 0);
398	} else {	398	} else {
399	$self = new Sip::MsgType ($msg, 0);	399	$self = C4::SIP::Sip::MsgType->new($msg, 0);
400	}	400	}
401		401
402	if ((substr($msg, 0, 2) ne REQUEST_ACS_RESEND) &&	402	if ((substr($msg, 0, 2) ne REQUEST_ACS_RESEND) &&
Lines 438-444 sub build_patron_status { Link Here
438		438
439	if ($patron) {	439	if ($patron) {
440	$resp .= patron_status_string($patron);	440	$resp .= patron_status_string($patron);
441	$resp .= $lang . Sip::timestamp();	441	$resp .= $lang . timestamp();
442	$resp .= add_field(FID_PERSONAL_NAME, $patron->name);	442	$resp .= add_field(FID_PERSONAL_NAME, $patron->name);
443		443
444	# while the patron ID we got from the SC is valid, let's	444	# while the patron ID we got from the SC is valid, let's
Lines 460-466 sub build_patron_status { Link Here
460	} else {	460	} else {
461	# Invalid patron id. Report that the user has no privs.,	461	# Invalid patron id. Report that the user has no privs.,
462	# no personal name, and is invalid (if we're using 2.00)	462	# no personal name, and is invalid (if we're using 2.00)
463	$resp .= 'YYYY' . (' ' x 10) . $lang . Sip::timestamp();	463	$resp .= 'YYYY' . (' ' x 10) . $lang . timestamp();
464	$resp .= add_field(FID_PERSONAL_NAME, '');	464	$resp .= add_field(FID_PERSONAL_NAME, '');
465		465
466	# the patron ID is invalid, but it's a required field, so	466	# the patron ID is invalid, but it's a required field, so
Lines 543-549 sub handle_checkout { Link Here
543	}	543	}
544	# We never return the obsolete 'U' value for 'desensitize'	544	# We never return the obsolete 'U' value for 'desensitize'
545	$resp .= sipbool($status->desensitize);	545	$resp .= sipbool($status->desensitize);
546	$resp .= Sip::timestamp;	546	$resp .= timestamp;
547		547
548	# Now for the variable fields	548	# Now for the variable fields
549	$resp .= add_field(FID_INST_ID, $inst);	549	$resp .= add_field(FID_INST_ID, $inst);
Lines 551-557 sub handle_checkout { Link Here
551	$resp .= add_field(FID_ITEM_ID, $item_id);	551	$resp .= add_field(FID_ITEM_ID, $item_id);
552	$resp .= add_field(FID_TITLE_ID, $item->title_id);	552	$resp .= add_field(FID_TITLE_ID, $item->title_id);
553	if ($item->due_date) {	553	if ($item->due_date) {
554	$resp .= add_field(FID_DUE_DATE, Sip::timestamp($item->due_date));	554	$resp .= add_field(FID_DUE_DATE, timestamp($item->due_date));
555	} else {	555	} else {
556	$resp .= add_field(FID_DUE_DATE, q{});	556	$resp .= add_field(FID_DUE_DATE, q{});
557	}	557	}
Lines 581-587 sub handle_checkout { Link Here
581	# Checkout failed	581	# Checkout failed
582	# Checkout Response: not ok, no renewal, don't know mag. media,	582	# Checkout Response: not ok, no renewal, don't know mag. media,
583	# no desensitize	583	# no desensitize
584	$resp = sprintf("120NUN%s", Sip::timestamp);	584	$resp = sprintf("120NUN%s", timestamp);
585	$resp .= add_field(FID_INST_ID, $inst);	585	$resp .= add_field(FID_INST_ID, $inst);
586	$resp .= add_field(FID_PATRON_ID, $patron_id);	586	$resp .= add_field(FID_PATRON_ID, $patron_id);
587	$resp .= add_field(FID_ITEM_ID, $item_id);	587	$resp .= add_field(FID_ITEM_ID, $item_id);
Lines 663-669 sub handle_checkin { Link Here
663	}	663	}
664	}	664	}
665	$resp .= $status->alert ? 'Y' : 'N';	665	$resp .= $status->alert ? 'Y' : 'N';
666	$resp .= Sip::timestamp;	666	$resp .= timestamp;
667	$resp .= add_field(FID_INST_ID, $inst_id);	667	$resp .= add_field(FID_INST_ID, $inst_id);
668	$resp .= add_field(FID_ITEM_ID, $item_id);	668	$resp .= add_field(FID_ITEM_ID, $item_id);
669		669
Lines 832-837 sub login_core { Link Here
832	#	832	#
833	my $module = $server->{config}->{institutions}->{$inst}->{implementation};	833	my $module = $server->{config}->{institutions}->{$inst}->{implementation};
834	syslog("LOG_DEBUG", 'login_core: ' . Dumper($module));	834	syslog("LOG_DEBUG", 'login_core: ' . Dumper($module));
		835	# Suspect this is always ILS but so we dont break any eccentic install (for now)
		836	if ($module eq 'ILS') {
		837	$module = 'C4::SIP::ILS';
		838	}
835	$module->use;	839	$module->use;
836	if ($@) {	840	if ($@) {
837	syslog("LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed",	841	syslog("LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed",
Lines 938-944 sub handle_patron_info { Link Here
938	if ($patron) {	942	if ($patron) {
939	$resp .= patron_status_string($patron);	943	$resp .= patron_status_string($patron);
940	$resp .= (defined($lang) and length($lang) ==3) ? $lang : $patron->language;	944	$resp .= (defined($lang) and length($lang) ==3) ? $lang : $patron->language;
941	$resp .= Sip::timestamp();	945	$resp .= timestamp();
942		946
943	$resp .= add_count('patron_info/hold_items',	947	$resp .= add_count('patron_info/hold_items',
944	scalar @{$patron->hold_items});	948	scalar @{$patron->hold_items});
Lines 1006-1012 sub handle_patron_info { Link Here
1006	# Invalid patron ID:	1010	# Invalid patron ID:
1007	# no privileges, no items associated,	1011	# no privileges, no items associated,
1008	# no personal name, and is invalid (if we're using 2.00)	1012	# no personal name, and is invalid (if we're using 2.00)
1009	$resp .= 'YYYY' . (' ' x 10) . $lang . Sip::timestamp();	1013	$resp .= 'YYYY' . (' ' x 10) . $lang . timestamp();
1010	$resp .= '0000' x 6;	1014	$resp .= '0000' x 6;
1011		1015
1012	$resp .= add_field(FID_INST_ID, ($ils->institution_id \|\| 'SIP2'));	1016	$resp .= add_field(FID_INST_ID, ($ils->institution_id \|\| 'SIP2'));
Lines 1038-1044 sub handle_end_patron_session { Link Here
1038	($status, $screen_msg, $print_line) = $ils->end_patron_session($fields->{(FID_PATRON_ID)});	1042	($status, $screen_msg, $print_line) = $ils->end_patron_session($fields->{(FID_PATRON_ID)});
1039		1043
1040	$resp .= $status ? 'Y' : 'N';	1044	$resp .= $status ? 'Y' : 'N';
1041	$resp .= Sip::timestamp();	1045	$resp .= timestamp();
1042		1046
1043	$resp .= add_field(FID_INST_ID, $server->{ils}->institution);	1047	$resp .= add_field(FID_INST_ID, $server->{ils}->institution);
1044	$resp .= add_field(FID_PATRON_ID, $fields->{(FID_PATRON_ID)});	1048	$resp .= add_field(FID_PATRON_ID, $fields->{(FID_PATRON_ID)});
Lines 1073-1079 sub handle_fee_paid { Link Here
1073	$status = $ils->pay_fee($patron_id, $patron_pwd, $fee_amt, $fee_type,	1077	$status = $ils->pay_fee($patron_id, $patron_pwd, $fee_amt, $fee_type,
1074	$pay_type, $fee_id, $trans_id, $currency);	1078	$pay_type, $fee_id, $trans_id, $currency);
1075		1079
1076	$resp .= ($status->ok ? 'Y' : 'N') . Sip::timestamp;	1080	$resp .= ($status->ok ? 'Y' : 'N') . timestamp;
1077	$resp .= add_field(FID_INST_ID, $inst_id);	1081	$resp .= add_field(FID_INST_ID, $inst_id);
1078	$resp .= add_field(FID_PATRON_ID, $patron_id);	1082	$resp .= add_field(FID_PATRON_ID, $patron_id);
1079	$resp .= maybe_add(FID_TRANSACTION_ID, $status->transaction_id);	1083	$resp .= maybe_add(FID_TRANSACTION_ID, $status->transaction_id);
Lines 1104-1110 sub handle_item_information { Link Here
1104	# Invalid Item ID	1108	# Invalid Item ID
1105	# "Other" circ stat, "Other" security marker, "Unknown" fee type	1109	# "Other" circ stat, "Other" security marker, "Unknown" fee type
1106	$resp .= "010101";	1110	$resp .= "010101";
1107	$resp .= Sip::timestamp;	1111	$resp .= timestamp;
1108	# Just echo back the invalid item id	1112	# Just echo back the invalid item id
1109	$resp .= add_field(FID_ITEM_ID, $fields->{(FID_ITEM_ID)});	1113	$resp .= add_field(FID_ITEM_ID, $fields->{(FID_ITEM_ID)});
1110	# title id is required, but we don't have one	1114	# title id is required, but we don't have one
Lines 1114-1120 sub handle_item_information { Link Here
1114	$resp .= $item->sip_circulation_status;	1118	$resp .= $item->sip_circulation_status;
1115	$resp .= $item->sip_security_marker;	1119	$resp .= $item->sip_security_marker;
1116	$resp .= $item->sip_fee_type;	1120	$resp .= $item->sip_fee_type;
1117	$resp .= Sip::timestamp;	1121	$resp .= timestamp;
1118		1122
1119	$resp .= add_field(FID_ITEM_ID, $item->id);	1123	$resp .= add_field(FID_ITEM_ID, $item->id);
1120	$resp .= add_field(FID_TITLE_ID, $item->title_id);	1124	$resp .= add_field(FID_TITLE_ID, $item->title_id);
Lines 1134-1146 sub handle_item_information { Link Here
1134	$resp .= add_field(FID_HOLD_QUEUE_LEN, $i);	1138	$resp .= add_field(FID_HOLD_QUEUE_LEN, $i);
1135	}	1139	}
1136	if ($item->due_date) {	1140	if ($item->due_date) {
1137	$resp .= add_field(FID_DUE_DATE, Sip::timestamp($item->due_date));	1141	$resp .= add_field(FID_DUE_DATE, timestamp($item->due_date));
1138	}	1142	}
1139	if (($i = $item->recall_date) != 0) {	1143	if (($i = $item->recall_date) != 0) {
1140	$resp .= add_field(FID_RECALL_DATE, Sip::timestamp($i));	1144	$resp .= add_field(FID_RECALL_DATE, timestamp($i));
1141	}	1145	}
1142	if (($i = $item->hold_pickup_date) != 0) {	1146	if (($i = $item->hold_pickup_date) != 0) {
1143	$resp .= add_field(FID_HOLD_PICKUP_DATE, Sip::timestamp($i));	1147	$resp .= add_field(FID_HOLD_PICKUP_DATE, timestamp($i));
1144	}	1148	}
1145		1149
1146	$resp .= maybe_add(FID_SCREEN_MSG, $item->screen_msg, $server);	1150	$resp .= maybe_add(FID_SCREEN_MSG, $item->screen_msg, $server);
Lines 1178-1184 sub handle_item_status_update { Link Here
1178	if (!$item) {	1182	if (!$item) {
1179	# Invalid Item ID	1183	# Invalid Item ID
1180	$resp .= '0';	1184	$resp .= '0';
1181	$resp .= Sip::timestamp;	1185	$resp .= timestamp;
1182	$resp .= add_field(FID_ITEM_ID, $item_id);	1186	$resp .= add_field(FID_ITEM_ID, $item_id);
1183	} else {	1187	} else {
1184	# Valid Item ID	1188	# Valid Item ID
Lines 1186-1192 sub handle_item_status_update { Link Here
1186	$status = $item->status_update($item_props);	1190	$status = $item->status_update($item_props);
1187		1191
1188	$resp .= $status->ok ? '1' : '0';	1192	$resp .= $status->ok ? '1' : '0';
1189	$resp .= Sip::timestamp;	1193	$resp .= timestamp;
1190		1194
1191	$resp .= add_field(FID_ITEM_ID, $item->id);	1195	$resp .= add_field(FID_ITEM_ID, $item->id);
1192	$resp .= add_field(FID_TITLE_ID, $item->title_id);	1196	$resp .= add_field(FID_TITLE_ID, $item->title_id);
Lines 1220-1226 sub handle_patron_enable { Link Here
1220		1224
1221	if (!defined($patron)) {	1225	if (!defined($patron)) {
1222	# Invalid patron ID	1226	# Invalid patron ID
1223	$resp .= 'YYYY' . (' ' x 10) . '000' . Sip::timestamp();	1227	$resp .= 'YYYY' . (' ' x 10) . '000' . timestamp();
1224	$resp .= add_field(FID_PATRON_ID, $patron_id);	1228	$resp .= add_field(FID_PATRON_ID, $patron_id);
1225	$resp .= add_field(FID_PERSONAL_NAME, '');	1229	$resp .= add_field(FID_PERSONAL_NAME, '');
1226	$resp .= add_field(FID_VALID_PATRON, 'N');	1230	$resp .= add_field(FID_VALID_PATRON, 'N');
Lines 1232-1238 sub handle_patron_enable { Link Here
1232	$status = $patron->enable;	1236	$status = $patron->enable;
1233	}	1237	}
1234	$resp .= patron_status_string($patron);	1238	$resp .= patron_status_string($patron);
1235	$resp .= $patron->language . Sip::timestamp();	1239	$resp .= $patron->language . timestamp();
1236		1240
1237	$resp .= add_field(FID_PATRON_ID, $patron->id);	1241	$resp .= add_field(FID_PATRON_ID, $patron->id);
1238	$resp .= add_field(FID_PERSONAL_NAME, $patron->name);	1242	$resp .= add_field(FID_PERSONAL_NAME, $patron->name);
Lines 1292-1305 sub handle_hold { Link Here
1292		1296
1293	$resp .= $status->ok;	1297	$resp .= $status->ok;
1294	$resp .= sipbool($status->item && $status->item->available($patron_id));	1298	$resp .= sipbool($status->item && $status->item->available($patron_id));
1295	$resp .= Sip::timestamp;	1299	$resp .= timestamp;
1296		1300
1297	if ($status->ok) {	1301	if ($status->ok) {
1298	$resp .= add_field(FID_PATRON_ID, $status->patron->id);	1302	$resp .= add_field(FID_PATRON_ID, $status->patron->id);
1299		1303
1300	($status->expiration_date) and	1304	($status->expiration_date) and
1301	$resp .= maybe_add(FID_EXPIRATION,	1305	$resp .= maybe_add(FID_EXPIRATION,
1302	Sip::timestamp($status->expiration_date));	1306	timestamp($status->expiration_date));
1303	$resp .= maybe_add(FID_QUEUE_POS, $status->queue_position);	1307	$resp .= maybe_add(FID_QUEUE_POS, $status->queue_position);
1304	$resp .= maybe_add(FID_PICKUP_LOCN, $status->pickup_location);	1308	$resp .= maybe_add(FID_PICKUP_LOCN, $status->pickup_location);
1305	$resp .= maybe_add(FID_ITEM_ID, $status->item->id);	1309	$resp .= maybe_add(FID_ITEM_ID, $status->item->id);
Lines 1362-1373 sub handle_renew { Link Here
1362	$resp .= 'U';	1366	$resp .= 'U';
1363	}	1367	}
1364	$resp .= sipbool($status->desensitize);	1368	$resp .= sipbool($status->desensitize);
1365	$resp .= Sip::timestamp;	1369	$resp .= timestamp;
1366	$resp .= add_field(FID_PATRON_ID, $patron->id);	1370	$resp .= add_field(FID_PATRON_ID, $patron->id);
1367	$resp .= add_field(FID_ITEM_ID, $item->id);	1371	$resp .= add_field(FID_ITEM_ID, $item->id);
1368	$resp .= add_field(FID_TITLE_ID, $item->title_id);	1372	$resp .= add_field(FID_TITLE_ID, $item->title_id);
1369	if ($item->due_date) {	1373	if ($item->due_date) {
1370	$resp .= add_field(FID_DUE_DATE, Sip::timestamp($item->due_date));	1374	$resp .= add_field(FID_DUE_DATE, timestamp($item->due_date));
1371	} else {	1375	} else {
1372	$resp .= add_field(FID_DUE_DATE, q{});	1376	$resp .= add_field(FID_DUE_DATE, q{});
1373	}	1377	}
Lines 1381-1387 sub handle_renew { Link Here
1381	# renew failed for some reason	1385	# renew failed for some reason
1382	# not OK, renewal not OK, Unknown media type (why bother checking?)	1386	# not OK, renewal not OK, Unknown media type (why bother checking?)
1383	$resp .= '0NUN';	1387	$resp .= '0NUN';
1384	$resp .= Sip::timestamp;	1388	$resp .= timestamp;
1385	# If we found the patron or the item, the return the ILS	1389	# If we found the patron or the item, the return the ILS
1386	# information, otherwise echo back the infomation we received	1390	# information, otherwise echo back the infomation we received
1387	# from the terminal	1391	# from the terminal
Lines 1443-1449 sub handle_renew_all { Link Here
1443	$resp .= add_count("renew_all/unrenewed_count", scalar @unrenewed);	1447	$resp .= add_count("renew_all/unrenewed_count", scalar @unrenewed);
1444	}	1448	}
1445		1449
1446	$resp .= Sip::timestamp;	1450	$resp .= timestamp;
1447	$resp .= add_field(FID_INST_ID, $ils->institution);	1451	$resp .= add_field(FID_INST_ID, $ils->institution);
1448		1452
1449	$resp .= join('', map(add_field(FID_RENEWED_ITEMS , $_), @renewed ));	1453	$resp .= join('', map(add_field(FID_RENEWED_ITEMS , $_), @renewed ));
Lines 1516-1522 sub send_acs_status { Link Here
1516		1520
1517	$msg .= "$online_status$checkin_ok$checkout_ok$ACS_renewal_policy";	1521	$msg .= "$online_status$checkin_ok$checkout_ok$ACS_renewal_policy";
1518	$msg .= "$status_update_ok$offline_ok$timeout$retries";	1522	$msg .= "$status_update_ok$offline_ok$timeout$retries";
1519	$msg .= Sip::timestamp();	1523	$msg .= timestamp();
1520		1524
1521	if ($protocol_version == 1) {	1525	if ($protocol_version == 1) {
1522	$msg .= '1.00';	1526	$msg .= '1.00';
Lines 1538-1546 sub send_acs_status { Link Here
1538		1542
1539	foreach my $msg_name (@message_type_names) {	1543	foreach my $msg_name (@message_type_names) {
1540	if ($msg_name eq 'request sc/acs resend') {	1544	if ($msg_name eq 'request sc/acs resend') {
1541	$supported_msgs .= Sip::sipbool(1);	1545	$supported_msgs .= sipbool(1);
1542	} else {	1546	} else {
1543	$supported_msgs .= Sip::sipbool($ils->supports($msg_name));	1547	$supported_msgs .= sipbool($ils->supports($msg_name));
1544	}	1548	}
1545	}	1549	}
1546	if (length($supported_msgs) < 16) {	1550	if (length($supported_msgs) < 16) {

Lines 21-58 use Test::More tests => 9; Link Here

(-)a/t/SIP_Sip.t (-11 / +8 lines)
21	use Test::Warn;	21	use Test::Warn;
22		22
23	BEGIN {	23	BEGIN {
24	use FindBin;
25	use lib "$FindBin::Bin/../C4/SIP";
26	use_ok('C4::SIP::Sip');	24	use_ok('C4::SIP::Sip');
27	}	25	}
28		26
29	my $date_time = Sip::timestamp();	27	my $date_time = C4::SIP::Sip::timestamp();
30	like( $date_time, qr/^\d{8} \d{6}$/, 'Timestamp format no param');	28	like( $date_time, qr/^\d{8} \d{6}$/, 'Timestamp format no param');
31		29
32	my $t = time();	30	my $t = time();
33		31
34	$date_time = Sip::timestamp($t);	32	$date_time = C4::SIP::Sip::timestamp($t);
35	like( $date_time, qr/^\d{8} \d{6}$/, 'Timestamp format secs');	33	like( $date_time, qr/^\d{8} \d{6}$/, 'Timestamp format secs');
36		34
37	$date_time = Sip::timestamp('2011-01-12');	35	$date_time = C4::SIP::Sip::timestamp('2011-01-12');
38	ok( $date_time eq '20110112 235900', 'Timestamp iso date string');	36	ok( $date_time eq '20110112 235900', 'Timestamp iso date string');
39		37
40	my $myChecksum = Sip::Checksum::checksum("12345");	38	my $myChecksum = C4::SIP::Sip::Checksum::checksum("12345");
41	my $checker = 65281;	39	my $checker = 65281;
42	my $stringChecksum = Sip::Checksum::checksum("teststring");	40	my $stringChecksum = C4::SIP::Sip::Checksum::checksum("teststring");
43	my $stringChecker = 64425;	41	my $stringChecker = 64425;
44		42
45	is( $myChecksum, $checker, "Checksum: $myChecksum matches expected output");	43	is( $myChecksum, $checker, "Checksum: $myChecksum matches expected output");
46	is( $stringChecksum, $stringChecker, "Checksum: $stringChecksum matches expected output");	44	is( $stringChecksum, $stringChecker, "Checksum: $stringChecksum matches expected output");
47		45
48	my $testdata = "abcdAZ";	46	my $testdata = "abcdAZ";
49	my $something = Sip::Checksum::checksum($testdata);	47	my $something = C4::SIP::Sip::Checksum::checksum($testdata);
50		48
51	$something = sprintf("%4X", $something);	49	$something = sprintf("%4X", $something);
52	ok( Sip::Checksum::verify_cksum($testdata.$something), "Checksum: $something is valid.");	50	ok( C4::SIP::Sip::Checksum::verify_cksum($testdata.$something), "Checksum: $something is valid.");
53		51
54	my $invalidTest;	52	my $invalidTest;
55	warning_is { $invalidTest = Sip::Checksum::verify_cksum("1234567") }	53	warning_is { $invalidTest = C4::SIP::Sip::Checksum::verify_cksum("1234567") }
56	'verify_cksum: no sum detected',	54	'verify_cksum: no sum detected',
57	'verify_cksum prints the expected warning for an invalid checksum';	55	'verify_cksum prints the expected warning for an invalid checksum';
58	is($invalidTest, 0, "Checksum: 1234567 is invalid as expected");	56	is($invalidTest, 0, "Checksum: 1234567 is invalid as expected");
59	-