X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FSIP%2FSip.pm;h=b6f1916ac91518c5d0db00b667c2574f7a6487dc;hb=4a72f6b2375895c690dcaaaff26b07de53cfd518;hp=8a0f067dacf7a21fcd5aeef18ce97a87dd2b51c3;hpb=ef8171ba425f766b67d9e139194b6a8d570e301e;p=koha_fer diff --git a/C4/SIP/Sip.pm b/C4/SIP/Sip.pm index 8a0f067dac..b6f1916ac9 100644 --- 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'"); }