gitea
/
Koha-clms
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Bug 7904 Change SIP modules to use standard LIB path 

For historical reasons the SIPServer and SIP modules
have used an extra module path in addition to the
standard Koha one. This has caused numerous irritants
in attempting to set up scripts and basic tests. It
does not help in attempting to modify or debug
this code

This patch changes the package value in the modules
under the C4/SIP directory and makes calls to
them use the full package name.

Where the export mechanism was being short circuited
routines have been explicitly exported and imported
declarations of 'use ILS' when that module was
not being used and which only generated warnings
have been removed.

As a lot of the changes affect lines where
an object is instantiated with new. The opportunity
has been taken to replace the ambiguous indirect
syntax with the preferred direct call

In intializing ILS the full path is added as this
will not require any changes to existing configs.
I suspect this feature is unused, and adds
obfuscation rather than flexibility but have kept
the feature as we need this change in order to
rationalize and extend the testing of the server.

The visible difference is that with the normal Koha
PERL5LIB setting. Compilation of Modules under C4/SIP
should be successful and not fail with unlocated modules,
allowing developers to see any perl warnings

All the SIP modules can now be run through the tests
in t/00-load.t now except for SIPServer itself

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>

Signed-off-by: Jonathan Druart <jonathan.druart@biblibre.com>
Signed-off-by: Tomas Cohen Arazi <tomascohen@gmail.com>
This commit is contained in:
Colin Campbell 2014-10-30 15:36:09 +00:00 committed by Tomas Cohen Arazi
parent fee7bd7fdc
commit d85f757ce7
41 changed files with 194 additions and 168 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
C4/SIP/ILS.pm
View File

@ -2,21 +2,22 @@
# ILS.pm: Koha ILS interface module
#
package ILS;
package C4::SIP::ILS;
use warnings;
use strict;
use Sys::Syslog qw(syslog);
use Data::Dumper;
use ILS::Item;
use ILS::Patron;
use ILS::Transaction;
use ILS::Transaction::Checkout;
use ILS::Transaction::Checkin;
use ILS::Transaction::FeePayment;
use ILS::Transaction::Hold;
use ILS::Transaction::Renew;
use ILS::Transaction::RenewAll;
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;
@ -45,7 +46,6 @@ sub new {
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;
@ -55,13 +55,13 @@ sub new {
sub find_patron {
my $self = shift;
$debug and warn "ILS: finding patron";
return ILS::Patron->new(@_);
return C4::SIP::ILS::Patron->new(@_);
}
sub find_item {
my $self = shift;
$debug and warn "ILS: finding item";
return ILS::Item->new(@_);
return C4::SIP::ILS::Item->new(@_);
}
sub institution {
@ -129,10 +129,10 @@ sub checkout {
my ($self, $patron_id, $item_id, $sc_renew) = @_;
my ($patron, $item, $circ);
$circ = new ILS::Transaction::Checkout;
$circ = C4::SIP::ILS::Transaction::Checkout->new();
# BEGIN TRANSACTION
$circ->patron($patron = new ILS::Patron $patron_id);
$circ->item($item = new ILS::Item $item_id);
$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");
@ -176,9 +176,9 @@ sub checkin {
$current_loc, $item_props, $cancel) = @_;
my ($patron, $item, $circ);
$circ = new ILS::Transaction::Checkin;
$circ = C4::SIP::ILS::Transaction::Checkin->new();
# BEGIN TRANSACTION
$circ->item($item = new ILS::Item $item_id);
$circ->item($item = C4::SIP::ILS::Item->new( $item_id));
if ($item) {
$circ->do_checkin($current_loc, $return_date);
@ -194,7 +194,7 @@ sub checkin {
$circ->screen_msg("Item not checked out");
} else {
if ($circ->ok) {
$circ->patron($patron = new ILS::Patron $item->{patron});
$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}} ];
@ -219,12 +219,12 @@ sub pay_fee {
$pay_type, $fee_id, $trans_id, $currency) = @_;
my $trans;
$trans = ILS::Transaction::FeePayment->new();
$trans = C4::SIP::ILS::Transaction::FeePayment->new();
$trans->transaction_id($trans_id);
my $patron;
$trans->patron($patron = ILS::Patron->new($patron_id));
$trans->patron($patron = C4::SIP::ILS::Patron->new($patron_id));
if (!$patron) {
$trans->screen_msg('Invalid patron barcode.');
return $trans;
@ -240,16 +240,16 @@ sub add_hold {
$expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
my ($patron, $item);
my $trans = new ILS::Transaction::Hold;
my $trans = C4::SIP::ILS::Transaction::Hold->new();
$patron = new ILS::Patron $patron_id;
$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 = new ILS::Item ($item_id || $title_id)) {
unless ($item = C4::SIP::ILS::Item->new($item_id || $title_id)) {
$trans->screen_msg("No such item.");
return $trans;
}
@ -287,9 +287,9 @@ sub cancel_hold {
my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_;
my ($patron, $item, $hold);
my $trans = new ILS::Transaction::Hold;
my $trans = C4::SIP::ILS::Transaction::Hold->new();
$patron = new ILS::Patron $patron_id;
$patron = C4::SIP::ILS::Patron->new( $patron_id );
if (!$patron) {
$trans->screen_msg("Invalid patron barcode.");
return $trans;
@ -298,7 +298,7 @@ sub cancel_hold {
return $trans;
}
unless ($item = new ILS::Item ($item_id || $title_id)) {
unless ($item = C4::SIP::ILS::Item->new($item_id || $title_id)) {
$trans->screen_msg("No such item.");
return $trans;
}
@ -345,10 +345,10 @@ sub alter_hold {
my $hold;
my $trans;
$trans = new ILS::Transaction::Hold;
$trans = C4::SIP::ILS::Transaction::Hold->new();
# BEGIN TRANSACTION
$patron = new ILS::Patron $patron_id;
$patron = C4::SIP::ILS::Patron->new( $patron_id );
unless ($patron) {
$trans->screen_msg("Invalid patron barcode: '$patron_id'.");
return $trans;
@ -366,7 +366,7 @@ sub alter_hold {
# $trans->ok(1);
$trans->screen_msg("Hold updated.");
$trans->patron($patron);
$trans->item(new ILS::Item $hold->{item_id});
$trans->item(C4::SIP::ILS::Item->new( $hold->{item_id}));
last;
}
}
@ -390,8 +390,8 @@ sub renew {
my ($patron, $item);
my $trans;
$trans = new ILS::Transaction::Renew;
$trans->patron($patron = new ILS::Patron $patron_id);
$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.");
@ -421,7 +421,7 @@ sub renew {
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 = new ILS::Item $item_id;
$item = C4::SIP::ILS::Item->new( $item_id );
last;
}
}
@ -448,9 +448,9 @@ sub renew_all {
my ($patron, $item_id);
my $trans;
$trans = new ILS::Transaction::RenewAll;
$trans = C4::SIP::ILS::Transaction::RenewAll->new();
$trans->patron($patron = new ILS::Patron $patron_id);
$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 {

6
C4/SIP/ILS/Item.pm
View File

@ -4,7 +4,7 @@
# A Class for hiding the ILS's concept of the item from OpenSIP
#
package ILS::Item;
package C4::SIP::ILS::Item;
use strict;
use warnings;
@ -12,7 +12,7 @@ use warnings;
use Sys::Syslog qw(syslog);
use Carp;
use ILS::Transaction;
use C4::SIP::ILS::Transaction;
use C4::Debug;
use C4::Context;
@ -233,7 +233,7 @@ sub AUTOLOAD {
sub status_update { # FIXME: this looks unimplemented
my ($self, $props) = @_;
my $status = new ILS::Transaction;
my $status = C4::SIP::ILS::Transaction->new();
$self->{sip_item_properties} = $props;
$status->{ok} = 1;
return $status;

2
C4/SIP/ILS/Patron.pm
View File

@ -5,7 +5,7 @@
# system
#
package ILS::Patron;
package C4::SIP::ILS::Patron;
use strict;
use warnings;

2
C4/SIP/ILS/Transaction.pm
View File

@ -2,7 +2,7 @@
# Transaction: Superclass of all the transactional status objects
#
package ILS::Transaction;
package C4::SIP::ILS::Transaction;
use Carp;
use strict;

7
C4/SIP/ILS/Transaction/Checkin.pm
View File

@ -2,22 +2,21 @@
# An object to handle checkin status
#
package ILS::Transaction::Checkin;
package C4::SIP::ILS::Transaction::Checkin;
use warnings;
use strict;
# use POSIX qw(strftime);
use ILS;
use ILS::Transaction;
use C4::SIP::ILS::Transaction;
use C4::Circulation;
use C4::Reserves qw( ModReserveAffect );
use C4::Items qw( ModItemTransfer );
use C4::Debug;
use parent qw(ILS::Transaction);
use parent qw(C4::SIP::ILS::Transaction);
my %fields = (
magnetic => 0,

7
C4/SIP/ILS/Transaction/Checkout.pm
View File

@ -2,7 +2,7 @@
# An object to handle checkout status
#
package ILS::Transaction::Checkout;
package C4::SIP::ILS::Transaction::Checkout;
use warnings;
use strict;
@ -12,15 +12,14 @@ use Sys::Syslog qw(syslog);
use Data::Dumper;
use CGI qw ( -utf8 );
use ILS;
use ILS::Transaction;
use C4::SIP::ILS::Transaction;
use C4::Context;
use C4::Circulation;
use C4::Members;
use C4::Reserves qw(ModReserveFill);
use C4::Debug;
use parent qw(ILS::Transaction);
use parent qw(C4::SIP::ILS::Transaction);
our $debug;

5
C4/SIP/ILS/Transaction/FeePayment.pm
View File

@ -1,4 +1,4 @@
package ILS::Transaction::FeePayment;
package C4::SIP::ILS::Transaction::FeePayment;
use warnings;
use strict;
@ -21,8 +21,7 @@ use strict;
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use C4::Accounts qw(recordpayment);
use ILS;
use parent qw(ILS::Transaction);
use parent qw(C4::SIP::ILS::Transaction);
our $debug = 0;

7
C4/SIP/ILS/Transaction/Hold.pm
View File

@ -1,18 +1,17 @@
#
# status of a Hold transaction
package ILS::Transaction::Hold;
package C4::SIP::ILS::Transaction::Hold;
use warnings;
use strict;
use ILS;
use ILS::Transaction;
use C4::SIP::ILS::Transaction;
use C4::Reserves; # AddReserve
use C4::Members; # GetMember
use C4::Biblio; # GetBiblioFromItemNumber GetBiblioItemByBiblioNumber
use parent qw(ILS::Transaction);
use parent qw(C4::SIP::ILS::Transaction);
our $VERSION = 3.07.00.049;

6
C4/SIP/ILS/Transaction/Renew.pm
View File

@ -2,17 +2,15 @@
# Status of a Renew Transaction
#
package ILS::Transaction::Renew;
package C4::SIP::ILS::Transaction::Renew;
use warnings;
use strict;
use ILS;
use C4::Circulation;
use C4::Members;
use parent qw(ILS::Transaction);
use parent qw(C4::SIP::ILS::Transaction);
my %fields = (
renewal_ok => 0,

8
C4/SIP/ILS/Transaction/RenewAll.pm
View File

@ -1,18 +1,18 @@
#
# RenewAll: class to manage status of "Renew All" transaction
package ILS::Transaction::RenewAll;
package C4::SIP::ILS::Transaction::RenewAll;
use strict;
use warnings;
use Sys::Syslog qw(syslog);
use ILS::Item;
use C4::SIP::ILS::Item;
use C4::Members qw( GetMember );
use parent qw(ILS::Transaction::Renew);
use parent qw(C4::SIP::ILS::Transaction::Renew);
my %fields = (
renewed => [],
@ -40,7 +40,7 @@ sub do_renew_all {
$self->{unrenewed} = [];
foreach my $itemx ( @{ $patron->{items} } ) {
my $item_id = $itemx->{barcode};
my $item = ILS::Item->new($item_id);
my $item = C4::SIP::ILS::Item->new($item_id);
if ( !defined($item) ) {
syslog(
'LOG_WARNING',

25
C4/SIP/SIPServer.pm
View File

@ -1,5 +1,5 @@
#!/usr/bin/perl
package SIPServer;
package C4::SIP::SIPServer;
use strict;
use warnings;
@ -11,10 +11,11 @@ use IO::Socket::INET;
use Socket qw(:DEFAULT :crlf);
require UNIVERSAL::require;
use Sip::Constants qw(:all);
use Sip::Configuration;
use Sip::Checksum qw(checksum verify_cksum);
use Sip::MsgType;
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);
@ -35,7 +36,7 @@ my %transports = (
#
# Read configuration
#
my $config = new Sip::Configuration $ARGV[0];
my $config = C4::SIP::Sip::Configuration->new( $ARGV[0] );
my @parms;
#
@ -129,14 +130,14 @@ sub raw_transport {
while (!$self->{account}) {
local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; };
syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout});
$input = Sip::read_SIP_packet(*STDIN);
$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 Sip::MsgType::handle($input, $self, LOGIN);
last if C4::SIP::Sip::MsgType::handle($input, $self, LOGIN);
}
syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",
@ -206,7 +207,9 @@ sub telnet_transport {
if (exists ($config->{accounts}->{$uid})
&& ($pwd eq $config->{accounts}->{$uid}->password())) {
$account = $config->{accounts}->{$uid};
Sip::MsgType::login_core($self,$uid,$pwd) and last;
if ( C4::SIP::Sip::MsgType::login_core($self,$uid,$pwd) ) {
last;
}
}
syslog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||''));
print("Invalid login$CRLF");
@ -259,7 +262,7 @@ sub sip_protocol_loop {
my $expect = '';
while (1) {
alarm $timeout;
$input = Sip::read_SIP_packet(*STDIN);
$input = read_SIP_packet(*STDIN);
unless ($input) {
return; # EOF
}
@ -273,7 +276,7 @@ sub sip_protocol_loop {
next;
}
# end cheap input hacks
my $status = Sip::MsgType::handle($input, $self, $expect);
my $status = handle($input, $self, $expect);
if (!$status) {
syslog("LOG_ERR", "sip_protocol_loop: failed to handle %s",substr($input,0,2));
}

6
C4/SIP/Sip.pm
View File

@ -2,7 +2,7 @@
# Sip.pm: General Sip utility functions
#
package Sip;
package C4::SIP::Sip;
use strict;
use warnings;
@ -13,8 +13,8 @@ use POSIX qw(strftime);
use Socket qw(:crlf);
use IO::Handle;
use Sip::Constants qw(SIP_DATETIME FID_SCREEN_MSG);
use Sip::Checksum qw(checksum);
use C4::SIP::Sip::Constants qw(SIP_DATETIME FID_SCREEN_MSG);
use C4::SIP::Sip::Checksum qw(checksum);
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);

2
C4/SIP/Sip/Checksum.pm
View File

@ -1,4 +1,4 @@
package Sip::Checksum;
package C4::SIP::Sip::Checksum;
use Exporter;
use strict;

14
C4/SIP/Sip/Configuration.pm
View File

@ -4,15 +4,15 @@
# structure.
#
package Sip::Configuration;
package C4::SIP::Sip::Configuration;
use strict;
use warnings;
use XML::Simple qw(:strict);
use Sip::Configuration::Institution;
use Sip::Configuration::Account;
use Sip::Configuration::Service;
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',
@ -33,7 +33,7 @@ sub new {
my %listeners;
foreach my $acct (values %{$cfg->{accounts}}) {
new Sip::Configuration::Account $acct;
C4::SIP::Sip::Configuration::Account->new( $acct );
}
# The key to the listeners hash is the 'port' component of the
@ -43,13 +43,13 @@ sub new {
# find_server() when building the keys to search the hash.
foreach my $service (values %{$cfg->{listeners}}) {
new Sip::Configuration::Service $service;
C4::SIP::Sip::Configuration::Service->new( $service );
$listeners{lc $service->{port}} = $service;
}
$cfg->{listeners} = \%listeners;
foreach my $inst (values %{$cfg->{institutions}}) {
new Sip::Configuration::Institution $inst;
C4::SIP::Sip::Configuration::Institution->new( $inst );
}
return bless $cfg, $class;
}

2
C4/SIP/Sip/Configuration/Account.pm
View File

@ -3,7 +3,7 @@
#
#
package Sip::Configuration::Account;
package C4::SIP::Sip::Configuration::Account;
use strict;
use warnings;

2
C4/SIP/Sip/Configuration/Institution.pm
View File

@ -3,7 +3,7 @@
#
#
package Sip::Configuration::Institution;
package C4::SIP::Sip::Configuration::Institution;
use strict;
use warnings;

2
C4/SIP/Sip/Configuration/Service.pm
View File

@ -3,7 +3,7 @@
#
#
package Sip::Configuration::Service;
package C4::SIP::Sip::Configuration::Service;
use strict;
use warnings;

2
C4/SIP/Sip/Constants.pm
View File

@ -5,7 +5,7 @@
# Protocol for communication between a library's Automated
# Checkout System (ACS) and stand-alone Self-Check (SC) units
package Sip::Constants;
package C4::SIP::Sip::Constants;
use strict;
use warnings;

78
C4/SIP/Sip/MsgType.pm
View File

@ -4,16 +4,16 @@
# A Class for handing SIP messages
#
package Sip::MsgType;
package C4::SIP::Sip::MsgType;
use strict;
use warnings;
use Exporter;
use Sys::Syslog qw(syslog);
use Sip qw(:all);
use Sip::Constants qw(:all);
use Sip::Checksum qw(verify_cksum);
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 );
@ -26,7 +26,7 @@ use vars qw(@ISA $VERSION @EXPORT_OK);
BEGIN {
$VERSION = 3.07.00.049;
@ISA = qw(Exporter);
@EXPORT_OK = qw(handle);
@EXPORT_OK = qw(handle login_core);
}
# Predeclare handler subroutines
@ -373,7 +373,7 @@ sub handle {
if ($msg eq REQUEST_ACS_RESEND_CKSUM) {
# Special case
$error_detection = 1;
$self = new Sip::MsgType ((REQUEST_ACS_RESEND), 0);
$self = C4::SIP::Sip::MsgType->new((REQUEST_ACS_RESEND), 0);
} elsif((length($msg) > 11) && (substr($msg, -9, 2) eq "AY")) {
$error_detection = 1;
@ -386,7 +386,7 @@ sub handle {
} else {
# Save the sequence number, then strip off the
# error detection data to process the message
$self = new Sip::MsgType (substr($msg, 0, -9), substr($msg, -7, 1));
$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.
@ -394,9 +394,9 @@ sub handle {
syslog("LOG_WARNING",
"Received message without error detection: '%s'", $msg);
$error_detection = 0;
$self = new Sip::MsgType ($msg, 0);
$self = C4::SIP::Sip::MsgType->new($msg, 0);
} else {
$self = new Sip::MsgType ($msg, 0);
$self = C4::SIP::Sip::MsgType->new($msg, 0);
}
if ((substr($msg, 0, 2) ne REQUEST_ACS_RESEND) &&
@ -438,7 +438,7 @@ sub build_patron_status {
if ($patron) {
$resp .= patron_status_string($patron);
$resp .= $lang . Sip::timestamp();
$resp .= $lang . timestamp();
$resp .= add_field(FID_PERSONAL_NAME, $patron->name);
# while the patron ID we got from the SC is valid, let's
@ -460,7 +460,7 @@ sub build_patron_status {
} 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 . Sip::timestamp();
$resp .= 'YYYY' . (' ' x 10) . $lang . timestamp();
$resp .= add_field(FID_PERSONAL_NAME, '');
# the patron ID is invalid, but it's a required field, so
@ -543,7 +543,7 @@ sub handle_checkout {
}
# We never return the obsolete 'U' value for 'desensitize'
$resp .= sipbool($status->desensitize);
$resp .= Sip::timestamp;
$resp .= timestamp;
# Now for the variable fields
$resp .= add_field(FID_INST_ID, $inst);
@ -551,7 +551,7 @@ sub handle_checkout {
$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, Sip::timestamp($item->due_date));
$resp .= add_field(FID_DUE_DATE, timestamp($item->due_date));
} else {
$resp .= add_field(FID_DUE_DATE, q{});
}
@ -581,7 +581,7 @@ sub handle_checkout {
# Checkout failed
# Checkout Response: not ok, no renewal, don't know mag. media,
# no desensitize
$resp = sprintf("120NUN%s", Sip::timestamp);
$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);
@ -663,7 +663,7 @@ sub handle_checkin {
}
}
$resp .= $status->alert ? 'Y' : 'N';
$resp .= Sip::timestamp;
$resp .= timestamp;
$resp .= add_field(FID_INST_ID, $inst_id);
$resp .= add_field(FID_ITEM_ID, $item_id);
@ -832,6 +832,10 @@ sub login_core {
#
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",
@ -938,7 +942,7 @@ sub handle_patron_info {
if ($patron) {
$resp .= patron_status_string($patron);
$resp .= (defined($lang) and length($lang) ==3) ? $lang : $patron->language;
$resp .= Sip::timestamp();
$resp .= timestamp();
$resp .= add_count('patron_info/hold_items',
scalar @{$patron->hold_items});
@ -1006,7 +1010,7 @@ sub handle_patron_info {
# 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 . Sip::timestamp();
$resp .= 'YYYY' . (' ' x 10) . $lang . timestamp();
$resp .= '0000' x 6;
$resp .= add_field(FID_INST_ID, ($ils->institution_id || 'SIP2'));
@ -1038,7 +1042,7 @@ sub handle_end_patron_session {
($status, $screen_msg, $print_line) = $ils->end_patron_session($fields->{(FID_PATRON_ID)});
$resp .= $status ? 'Y' : 'N';
$resp .= Sip::timestamp();
$resp .= timestamp();
$resp .= add_field(FID_INST_ID, $server->{ils}->institution);
$resp .= add_field(FID_PATRON_ID, $fields->{(FID_PATRON_ID)});
@ -1073,7 +1077,7 @@ sub handle_fee_paid {
$status = $ils->pay_fee($patron_id, $patron_pwd, $fee_amt, $fee_type,
$pay_type, $fee_id, $trans_id, $currency);
$resp .= ($status->ok ? 'Y' : 'N') . Sip::timestamp;
$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);
@ -1104,7 +1108,7 @@ sub handle_item_information {
# Invalid Item ID
# "Other" circ stat, "Other" security marker, "Unknown" fee type
$resp .= "010101";
$resp .= Sip::timestamp;
$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
@ -1114,7 +1118,7 @@ sub handle_item_information {
$resp .= $item->sip_circulation_status;
$resp .= $item->sip_security_marker;
$resp .= $item->sip_fee_type;
$resp .= Sip::timestamp;
$resp .= timestamp;
$resp .= add_field(FID_ITEM_ID, $item->id);
$resp .= add_field(FID_TITLE_ID, $item->title_id);
@ -1134,13 +1138,13 @@ sub handle_item_information {
$resp .= add_field(FID_HOLD_QUEUE_LEN, $i);
}
if ($item->due_date) {
$resp .= add_field(FID_DUE_DATE, Sip::timestamp($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, Sip::timestamp($i));
$resp .= add_field(FID_RECALL_DATE, timestamp($i));
}
if (($i = $item->hold_pickup_date) != 0) {
$resp .= add_field(FID_HOLD_PICKUP_DATE, Sip::timestamp($i));
$resp .= add_field(FID_HOLD_PICKUP_DATE, timestamp($i));
}
$resp .= maybe_add(FID_SCREEN_MSG, $item->screen_msg, $server);
@ -1178,7 +1182,7 @@ sub handle_item_status_update {
if (!$item) {
# Invalid Item ID
$resp .= '0';
$resp .= Sip::timestamp;
$resp .= timestamp;
$resp .= add_field(FID_ITEM_ID, $item_id);
} else {
# Valid Item ID
@ -1186,7 +1190,7 @@ sub handle_item_status_update {
$status = $item->status_update($item_props);
$resp .= $status->ok ? '1' : '0';
$resp .= Sip::timestamp;
$resp .= timestamp;
$resp .= add_field(FID_ITEM_ID, $item->id);
$resp .= add_field(FID_TITLE_ID, $item->title_id);
@ -1220,7 +1224,7 @@ sub handle_patron_enable {
if (!defined($patron)) {
# Invalid patron ID
$resp .= 'YYYY' . (' ' x 10) . '000' . Sip::timestamp();
$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');
@ -1232,7 +1236,7 @@ sub handle_patron_enable {
$status = $patron->enable;
}
$resp .= patron_status_string($patron);
$resp .= $patron->language . Sip::timestamp();
$resp .= $patron->language . timestamp();
$resp .= add_field(FID_PATRON_ID, $patron->id);
$resp .= add_field(FID_PERSONAL_NAME, $patron->name);
@ -1292,14 +1296,14 @@ sub handle_hold {
$resp .= $status->ok;
$resp .= sipbool($status->item && $status->item->available($patron_id));
$resp .= Sip::timestamp;
$resp .= timestamp;
if ($status->ok) {
$resp .= add_field(FID_PATRON_ID, $status->patron->id);
($status->expiration_date) and
$resp .= maybe_add(FID_EXPIRATION,
Sip::timestamp($status->expiration_date));
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);
@ -1362,12 +1366,12 @@ sub handle_renew {
$resp .= 'U';
}
$resp .= sipbool($status->desensitize);
$resp .= Sip::timestamp;
$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, Sip::timestamp($item->due_date));
$resp .= add_field(FID_DUE_DATE, timestamp($item->due_date));
} else {
$resp .= add_field(FID_DUE_DATE, q{});
}
@ -1381,7 +1385,7 @@ sub handle_renew {
# renew failed for some reason
# not OK, renewal not OK, Unknown media type (why bother checking?)
$resp .= '0NUN';
$resp .= Sip::timestamp;
$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
@ -1443,7 +1447,7 @@ sub handle_renew_all {
$resp .= add_count("renew_all/unrenewed_count", scalar @unrenewed);
}
$resp .= Sip::timestamp;
$resp .= timestamp;
$resp .= add_field(FID_INST_ID, $ils->institution);
$resp .= join('', map(add_field(FID_RENEWED_ITEMS , $_), @renewed ));
@ -1516,7 +1520,7 @@ sub send_acs_status {
$msg .= "$online_status$checkin_ok$checkout_ok$ACS_renewal_policy";
$msg .= "$status_update_ok$offline_ok$timeout$retries";
$msg .= Sip::timestamp();
$msg .= timestamp();
if ($protocol_version == 1) {
$msg .= '1.00';
@ -1538,9 +1542,9 @@ sub send_acs_status {
foreach my $msg_name (@message_type_names) {
if ($msg_name eq 'request sc/acs resend') {
$supported_msgs .= Sip::sipbool(1);
$supported_msgs .= sipbool(1);
} else {
$supported_msgs .= Sip::sipbool($ils->supports($msg_name));
$supported_msgs .= sipbool($ils->supports($msg_name));
}
}
if (length($supported_msgs) < 16) {

8
C4/SIP/example_institution_dump.sh
View File

@ -2,11 +2,11 @@
perl -I ./ -e '
use Data::Dumper;
use ILS;
use Sip::Configuration;
use C4::SIP::ILS;
use C4::SIP::Sip::Configuration;
my $code = "MAIN";
my $conf = Sip::Configuration->new("SIPconfig.xml");
my $ils = ILS->new($conf->{institutions}->{$code});
my $conf = C4::SIP::Sip::Configuration->new("SIPconfig.xml");
my $ils = C4::SIP::ILS->new($conf->{institutions}->{$code});
print "XML for $code: ", Dumper($conf->{institutions}->{$code}), "\n";
print "ILS for $code: ", Dumper($ils), "\n";
print "\$ils->checkout_ok(): ", ($ils->checkout_ok() ? "Y" : "N"), "\n";

4
C4/SIP/interactive_item_dump.pl
View File

@ -4,7 +4,7 @@
use warnings;
use strict;
use ILS::Item;
use C4::SIP::ILS::Item;
use Data::Dumper;
my $compare = (@ARGV) ? shift : 0;
@ -14,7 +14,7 @@ while (1) {
defined($in) or last;
chomp($in);
last unless $in;
my $item = ILS::Item->new($in);
my $item = C4::SIP::ILS::Item->new($in);
unless ($item) {
print "No item ($in)";
next;

6
C4/SIP/interactive_patron_check_password.pl
View File

@ -4,8 +4,8 @@
use warnings;
use strict;
use ILS::Patron;
use Sip qw(sipbool);
use C4::SIP::ILS::Patron;
use C4::SIP::Sip qw(sipbool);
use Data::Dumper;
while (1) {
@ -14,7 +14,7 @@ while (1) {
defined($in) or last;
chomp($in);
last unless $in;
my $patron = ILS::Patron->new($in);
my $patron = C4::SIP::ILS::Patron->new($in);
print Dumper($patron);
$patron or next;
print "Enter patron password: ";

4
C4/SIP/interactive_patron_dump.pl
View File

@ -4,7 +4,7 @@
use warnings;
use strict;
use ILS::Patron;
use C4::SIP::ILS::Patron;
use Data::Dumper;
while (1) {
@ -13,6 +13,6 @@ while (1) {
defined($in) or last;
chomp($in);
last unless $in;
my $patron = ILS::Patron->new($in);
my $patron = C4::SIP::ILS::Patron->new($in);
print "Patron ($in):\n", Dumper($patron);
}

4
C4/SIP/interactive_renew_all_dump.pl
View File

@ -4,7 +4,7 @@
use warnings;
use strict;
use ILS::Transaction::RenewAll;
use C4::SIP::ILS::Transaction::RenewAll;
use Data::Dumper;
while (1) {
@ -15,7 +15,7 @@ while (1) {
last unless $in;
my $patron = ILS::Patron->new($in);
print "Patron before: \n " . Dumper($patron);
my $action = ILS::Transaction::RenewAll->new();
my $action = C4::SIP::ILS::Transaction::RenewAll->new();
$action->do_renew_all();
print "\n\nTransaction::RenewAll: " . Dumper($action);
print "\n", "=" x 35, "\n";

4
C4/SIP/t/000_sc_config_auth.t
View File

@ -5,11 +5,13 @@
use strict;
use warnings;
use FindBin qw($Bin);
use lib "$Bin";
use Test::More tests => 15;
BEGIN {
use_ok('Sip::Constants', qw(:all));
use_ok('C4::SIP::Sip::Constants', qw(:all));
use_ok('SIPtest', qw(:basic :user1 :auth));
use_ok('C4::Auth', qw(&check_api_auth));
use_ok('C4::Context');

2
C4/SIP/t/00sc_status.t
View File

@ -6,6 +6,8 @@
use strict;
use warnings;
use FindBin qw($Bin);
use lib "$Bin";
use SIPtest qw($datepat $username $password $login_test $sc_status_test);

6
C4/SIP/t/01patron_status.t
View File

@ -4,8 +4,10 @@
use strict;
use warnings;
use FindBin qw($Bin);
use lib "$Bin";
use Sip::Constants qw(:all);
use C4::SIP::Sip::Constants qw(:all);
use SIPtest qw($datepat $instid $currency :user1);
my @tests = (
@ -73,6 +75,6 @@ my @tests = (
], },
);
SIPtest::run_sip_tests(@tests);
SIPtest::run_sip_tests(@tests);
1;

4
C4/SIP/t/02patron_info.t
View File

@ -3,9 +3,11 @@
use strict;
use warnings;
use FindBin qw($Bin);
use lib "$Bin";
use Clone qw(clone);
use Sip::Constants qw(:all);
use C4::SIP::Sip::Constants qw(:all);
use SIPtest qw(:basic :user1);

4
C4/SIP/t/03checkout.t
View File

@ -3,11 +3,13 @@
use strict;
use warnings;
use FindBin qw($Bin);
use lib "$Bin";
use Clone qw(clone);
use CGI qw ( -utf8 );
use Sip::Constants qw(:all);
use C4::SIP::Sip::Constants qw(:all);
use SIPtest qw(
:basic
$user_barcode

4
C4/SIP/t/04patron_status.t
View File

@ -3,9 +3,11 @@
use strict;
use warnings;
use FindBin qw($Bin);
use lib "$Bin";
use Clone qw(clone);
use Sip::Constants qw(:all);
use C4::SIP::Sip::Constants qw(:all);
use SIPtest qw(:user1 :basic);
my $patron_status_test_template = {

6
C4/SIP/t/05block_patron.t
View File

@ -3,9 +3,11 @@
use strict;
use warnings;
use FindBin qw($Bin);
use lib "$Bin";
use Clone qw(clone);
use Sip::Constants qw(:all);
use C4::SIP::Sip::Constants qw(:all);
use SIPtest qw(:basic :user1);
@ -40,6 +42,6 @@ my @tests = (
clone($block_patron_test_template),
);
SIPtest::run_sip_tests(@tests);
SIPtest::run_sip_tests(@tests);
1;

4
C4/SIP/t/06patron_enable.t
View File

@ -3,9 +3,11 @@
use strict;
use warnings;
use FindBin qw($Bin);
use lib "$Bin";
use Clone qw(clone);
use Sip::Constants qw(:all);
use C4::SIP::Sip::Constants qw(:all);
use SIPtest qw(:basic :user1);

4
C4/SIP/t/07hold.t
View File

@ -3,9 +3,11 @@
use strict;
use warnings;
use FindBin qw($Bin);
use lib "$Bin";
use Clone qw(clone);
use Sip::Constants qw(:all);
use C4::SIP::Sip::Constants qw(:all);
use SIPtest qw(:basic :user1 :user2 :item1 :item2);

4
C4/SIP/t/08checkin.t
View File

@ -3,9 +3,11 @@
use strict;
use warnings;
use FindBin qw($Bin);
use lib "$Bin";
use Clone qw(clone);
use Sip::Constants qw(:all);
use C4::SIP::Sip::Constants qw(:all);
use SIPtest qw(:basic :user1 :item1);
# Checkout response, format:

4
C4/SIP/t/09renew.t
View File

@ -3,9 +3,11 @@
use strict;
use warnings;
use FindBin qw($Bin);
use lib "$Bin";
use Clone qw(clone);
use Sip::Constants qw(:all);
use C4::SIP::Sip::Constants qw(:all);
use SIPtest qw(:basic :user1 :item1);

4
C4/SIP/t/10renew_all.t
View File

@ -3,9 +3,11 @@
use strict;
use warnings;
use FindBin qw($Bin);
use lib "$Bin";
use Clone qw(clone);
use Sip::Constants qw(:all);
use C4::SIP::Sip::Constants qw(:all);
use SIPtest qw(:basic :user1 :item1 :item2);

4
C4/SIP/t/11item_info.t
View File

@ -3,9 +3,11 @@
use strict;
use warnings;
use FindBin qw($Bin);
use lib "$Bin";
use Clone qw(clone);
use Sip::Constants qw(:all);
use C4::SIP::Sip::Constants qw(:all);
use SIPtest qw(:basic :user1 :item1);
my $item_info_test_template = {

6
C4/SIP/t/SIPtest.pm
View File

@ -41,9 +41,9 @@ use Test::More;
use CGI qw ( -utf8 );
use IO::Socket::INET;
use Sip qw(:all);
use Sip::Checksum qw(verify_cksum);
use Sip::Constants qw(:all);
use C4::SIP::Sip qw(:all);
use C4::SIP::Sip::Checksum qw(verify_cksum);
use C4::SIP::Sip::Constants qw(:all);
use C4::Auth qw(&check_api_auth);
use C4::Context;

2
C4/SIP/xmlparse.pl
View File

@ -7,7 +7,7 @@
# in Sip::Configuration.pm
#
use strict;
#use warnings; FIXME - Bug 2505
use warnings;
use English;
use XML::Simple qw(:strict);

3
t/00-load.t
View File

@ -39,10 +39,11 @@ find({
wanted => sub {
my $m = $_;
return unless $m =~ s/[.]pm$//;
$m =~ s{^.*/C4/}{C4/};
$m =~ s{/}{::}g;
return if $m =~ /Auth_with_ldap/; # Dont test this, it will fail on use
return if $m =~ /SIP/; # SIP modules will not load clean
return if $m =~ /SIPServer/; # SIP Server module has old package usage
use_ok($m) || BAIL_OUT("***** PROBLEMS LOADING FILE '$m'");
},
}, $lib);

18
t/SIP_Sip.t
View File

@ -21,38 +21,36 @@ use Test::More tests => 9;
use Test::Warn;
BEGIN {
use FindBin;
use lib "$FindBin::Bin/../C4/SIP";
use_ok('C4::SIP::Sip');
}
my $date_time = Sip::timestamp();
my $date_time = C4::SIP::Sip::timestamp();
like( $date_time, qr/^\d{8} \d{6}$/, 'Timestamp format no param');
my $t = time();
$date_time = Sip::timestamp($t);
$date_time = C4::SIP::Sip::timestamp($t);
like( $date_time, qr/^\d{8} \d{6}$/, 'Timestamp format secs');
$date_time = Sip::timestamp('2011-01-12');
$date_time = C4::SIP::Sip::timestamp('2011-01-12');
ok( $date_time eq '20110112 235900', 'Timestamp iso date string');
my $myChecksum = Sip::Checksum::checksum("12345");
my $myChecksum = C4::SIP::Sip::Checksum::checksum("12345");
my $checker = 65281;
my $stringChecksum = Sip::Checksum::checksum("teststring");
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 = Sip::Checksum::checksum($testdata);
my $something = C4::SIP::Sip::Checksum::checksum($testdata);
$something = sprintf("%4X", $something);
ok( Sip::Checksum::verify_cksum($testdata.$something), "Checksum: $something is valid.");
ok( C4::SIP::Sip::Checksum::verify_cksum($testdata.$something), "Checksum: $something is valid.");
my $invalidTest;
warning_is { $invalidTest = Sip::Checksum::verify_cksum("1234567") }
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");