X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FSIP%2FSip.pm;h=3f41226352df9f5e680fb52dd92a460eb5aa4cce;hb=2b90ea2cb0e5e976de7ddef0151ae83d8ac578e6;hp=4e3f299afb5eec008531e629deb8052e5ddd9e8d;hpb=6eb021ab0e113e2b6b897c89475f1eadc7a2c15b;p=koha.git diff --git a/C4/SIP/Sip.pm b/C4/SIP/Sip.pm index 4e3f299afb..3f41226352 100644 --- a/C4/SIP/Sip.pm +++ b/C4/SIP/Sip.pm @@ -2,43 +2,36 @@ # 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 @@ -75,7 +68,7 @@ sub add_field { $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)); @@ -92,7 +85,18 @@ sub add_field { # 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) : ''; } @@ -145,67 +149,6 @@ sub boolspace { return $bool ? 'Y' : ' '; } - -# read_SIP_packet($file) -# -# Read a packet from $file, using the correct record separator -# -sub read_SIP_packet { - my $record; - my $fh = shift or syslog("LOG_ERR", "read_SIP_packet: no filehandle argument!"); - my $len1 = 999; - - # 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) ) { - while ( chomp($record) ) { 1; } - $len1 = length($record); - syslog( "LOG_DEBUG", "read_SIP_packet, INPUT MSG: '$record'" ); - $record =~ s/^\s*[^A-z0-9]+//s; # Every line must start with a "real" character. Not whitespace, control chars, etc. - $record =~ s/[^A-z0-9]+$//s; # Same for the end. Note this catches the problem some clients have sending empty fields at the end, like ||| - $record =~ s/\015?\012//g; # Extra line breaks must die - $record =~ s/\015?\012//s; # Extra line breaks must die - $record =~ s/\015*\012*$//s; # treat as one line to include the extra linebreaks we are trying to remove! - 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); - syslog("LOG_INFO", "read_SIP_packet, INPUT MSG: '$record'") if $record; - ($len1 != $len2) and syslog("LOG_DEBUG", "read_SIP_packet, trimmed %s character(s) (after chomps).", $len1-$len2); - } else { - syslog("LOG_WARNING", "read_SIP_packet input %s, end of input.", (defined($record) ? "empty ($record)" : 'undefined')); - } - # - # Cen-Tec self-check terminals transmit '\r\n' line terminators. - # This is actually very hard to deal with in perl in a reasonable - # since every OTHER piece of hardware out there gets the protocol - # right. - # - # The incorrect line terminator presents as a \r at the end of the - # first record, and then a \n at the BEGINNING of the next record. - # So, the simplest thing to do is just throw away a leading newline - # on the input. - # - # This is now handled by the vigorous cleansing above. - # syslog("LOG_INFO", encode_utf8("INPUT MSG: '$record'")) if $record; - syslog("LOG_INFO", "INPUT MSG: '$record'") if $record; - return $record; -} - # # write_msg($msg, $file) # @@ -218,7 +161,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); @@ -234,10 +183,10 @@ sub write_msg { if ($file) { $file->autoflush(1); - print $file "$msg\r"; + print $file $msg, $terminator; } else { STDOUT->autoflush(1); - print $msg, "\r"; + print $msg, $terminator; syslog("LOG_INFO", "OUTPUT MSG: '$msg'"); }