# Sip.pm: General Sip utility functions
#
-package Sip;
+package C4::SIP::Sip;
use strict;
use warnings;
-use English;
use Exporter;
-
+use Encode;
use Sys::Syslog qw(syslog);
use POSIX qw(strftime);
+use Socket qw(:crlf);
+use IO::Handle;
-use Sip::Constants qw(SIP_DATETIME);
-use Sip::Checksum qw(checksum);
-
-use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
+use C4::SIP::Sip::Constants qw(SIP_DATETIME FID_SCREEN_MSG);
+use C4::SIP::Sip::Checksum qw(checksum);
-BEGIN {
- $VERSION = 1.00;
- @ISA = qw(Exporter);
+use base qw(Exporter);
- @EXPORT_OK = qw(y_or_n timestamp add_field maybe_add add_count
- denied sipbool boolspace write_msg read_SIP_packet
- $error_detection $protocol_version $field_delimiter
- $last_response);
+our @EXPORT_OK = qw(y_or_n timestamp add_field maybe_add add_count
+ denied sipbool boolspace write_msg
+ $error_detection $protocol_version $field_delimiter
+ $last_response);
- %EXPORT_TAGS = (
- all => [qw(y_or_n timestamp add_field maybe_add
- add_count denied sipbool boolspace write_msg
- read_SIP_packet
- $error_detection $protocol_version
- $field_delimiter $last_response)]);
-}
+our %EXPORT_TAGS = (
+ all => [qw(y_or_n timestamp add_field maybe_add
+ add_count denied sipbool boolspace write_msg
+ $error_detection $protocol_version
+ $field_delimiter $last_response)]);
our $error_detection = 0;
our $protocol_version = 1;
-our $field_delimiter = '|'; # Protocol Default
+our $field_delimiter = '|'; # Protocol Default
# We need to keep a copy of the last message we sent to the SC,
# in case there's a transmission error and the SC sends us a
sub timestamp {
my $time = $_[0] || time();
-
+ if ( ref $time eq 'DateTime') {
+ return $time->strftime(SIP_DATETIME);
+ } elsif ($time=~m/^(\d{4})\-(\d{2})\-(\d{2})/) {
+ # passing a db returned date as is + bogus time
+ return sprintf( '%04d%02d%02d 235900', $1, $2, $3);
+ }
return strftime(SIP_DATETIME, localtime($time));
}
if (!defined($value)) {
syslog("LOG_DEBUG", "add_field: Undefined value being added to '%s'",
$field_id);
- $value = '';
+ $value = '';
}
+ $value=~s/\r/ /g; # CR terminates a sip message
+ # Protect against them in sip text fields
- # Replace any occurences of the field delimiter in the
+ # Replace any occurrences of the field delimiter in the
# field value with the HTML character entity
$ent = sprintf("&#%d;", ord($field_delimiter));
while (($i = index($value, $field_delimiter)) != ($[-1)) {
- substr($value, $i, 1) = $ent;
+ substr($value, $i, 1) = $ent;
}
return $field_id . $value . $field_delimiter;
#
# maybe_add(field_id, value):
# If value is defined and non-empty, then return the
-# constructed field value, otherwise return the empty string
+# constructed field value, otherwise return the empty string.
+# NOTE: if zero is a valid value for your field, don't use maybe_add!
#
sub maybe_add {
- my ($fid, $value) = @_;
+ my ($fid, $value, $server) = @_;
+
+ if ( $fid eq FID_SCREEN_MSG && $server->{account}->{screen_msg_regex} ) {
+ foreach my $regex (
+ ref $server->{account}->{screen_msg_regex} eq "ARRAY"
+ ? @{ $server->{account}->{screen_msg_regex} }
+ : $server->{account}->{screen_msg_regex} )
+ {
+ $value =~ s/$regex->{find}/$regex->{replace}/g;
+ }
+ }
return (defined($value) && $value) ? add_field($fid, $value) : '';
}
# If the field is unsupported, it will be undef, return blanks
# as per the spec.
if (!defined($count)) {
- return ' ' x 4;
+ return ' ' x 4;
}
$count = sprintf("%04d", $count);
if (length($count) != 4) {
- syslog("LOG_WARNING", "handle_patron_info: %s wrong size: '%s'",
+ syslog("LOG_WARNING", "handle_patron_info: %s wrong size: '%s'",
$label, $count);
- $count = ' ' x 4;
+ $count = ' ' x 4;
}
return $count;
}
#
sub denied {
my $bool = shift;
-
return boolspace(!$bool);
}
sub sipbool {
my $bool = shift;
-
return $bool ? 'Y' : 'N';
}
#
sub boolspace {
my $bool = shift;
-
return $bool ? 'Y' : ' ';
}
-
-# read_SIP_packet($file)
-#
-# Read a packet from $file, using the correct record separator
-#
-sub read_SIP_packet {
- my $file = shift;
- my $record;
- local $/ = "\r";
-
- $record = readline($file);
- syslog("LOG_INFO", "INPUT MSG: '$record'") if $record;
- return $record;
-}
-
#
# write_msg($msg, $file)
#
#
sub write_msg {
- my ($self, $msg, $file) = @_;
+ my ($self, $msg, $file, $terminator, $encoding) = @_;
+
+ $terminator ||= q{};
+ $terminator = ( $terminator eq 'CR' ) ? $CR : $CRLF;
+
+ $msg = encode($encoding, $msg) if ( $encoding );
+
my $cksum;
+ # $msg = encode_utf8($msg);
if ($error_detection) {
- if (defined($self->{seqno})) {
- $msg .= 'AY' . $self->{seqno};
- }
- $msg .= 'AZ';
- $cksum = checksum($msg);
- $msg .= sprintf('%04.4X', $cksum);
+ if (defined($self->{seqno})) {
+ $msg .= 'AY' . $self->{seqno};
+ }
+ $msg .= 'AZ';
+ $cksum = checksum($msg);
+ $msg .= sprintf('%04.4X', $cksum);
}
if ($file) {
- print $file "$msg\r";
+ $file->autoflush(1);
+ print $file $msg, $terminator;
} else {
- print "$msg\r";
- syslog("LOG_INFO", "OUTPUT MSG: '$msg'");
+ STDOUT->autoflush(1);
+ print $msg, $terminator;
+ syslog("LOG_INFO", "OUTPUT MSG: '$msg'");
}
$last_response = $msg;
projects / koha.git / blobdiff