Bug 9865: make SIP msg encoding configurable via SIPconfig.xml

[koha_fer] / C4 / SIP / Sip.pm

diff --git a/C4/SIP/Sip.pm b/C4/SIP/Sip.pm
index 8a0f067..b6f1916 100644 (file)
--- a/C4/SIP/Sip.pm
+++ b/C4/SIP/Sip.pm
@@ -6,12 +6,12 @@ package 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);
@@ -19,7 +19,7 @@ use Sip::Checksum qw(checksum);
 use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
 
 BEGIN {
-       $VERSION = 1.00;
+    $VERSION = 3.07.00.049;
        @ISA = qw(Exporter);
 
        @EXPORT_OK = qw(y_or_n timestamp add_field maybe_add add_count
@@ -37,7 +37,7 @@ BEGIN {
 
 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
@@ -49,7 +49,9 @@ our $last_response = '';
 
 sub timestamp {
     my $time = $_[0] || time();
-    if ($time=~m/^(\d{4})\-(\d{2})\-(\d{2})/) {
+    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);
     }
@@ -155,7 +157,6 @@ sub read_SIP_packet {
     # local $/ = "\r";      # don't need any of these here.  use whatever the prevailing $/ is.
     local $/ = "\015";    # proper SPEC: (octal) \015 = (hex) x0D = (dec) 13 = (ascii) carriage return
     {    # adapted from http://perldoc.perl.org/5.8.8/functions/readline.html
-        for ( my $tries = 1 ; $tries <= 3 ; $tries++ ) {
             undef $!;
             $record = readline($fh);
             if ( defined($record) ) {
@@ -170,14 +171,7 @@ sub read_SIP_packet {
                 while ( chomp($record) ) { 1; }
 
                 $record and last;    # success
-            } else {
-                if ($!) {
-                    syslog( "LOG_DEBUG", "read_SIP_packet (try #$tries) ERROR: $! $@" );
-                    # die "read_SIP_packet ERROR: $!";
-                    warn "read_SIP_packet ERROR: $! $@";
-                }
             }
-        }
     }
     if ($record) {
         my $len2 = length($record);
@@ -215,7 +209,13 @@ sub read_SIP_packet {
 #
 
 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);
@@ -230,9 +230,11 @@ sub write_msg {
 
 
     if ($file) {
-        print $file "$msg\r";
+        $file->autoflush(1);
+        print $file $msg, $terminator;
     } else {
-        print "$msg\r";
+        STDOUT->autoflush(1);
+        print $msg, $terminator;
         syslog("LOG_INFO", "OUTPUT MSG: '$msg'");
     }