r6307 - in /branches/upstream/libnet-sip-perl/current: Changes META.yml README lib/Net/SIP.pm lib/Net/SIP/Packet.pm
rmayorga-guest at users.alioth.debian.org
rmayorga-guest at users.alioth.debian.org
Mon Aug 6 22:36:59 UTC 2007
Author: rmayorga-guest
Date: Mon Aug 6 22:36:59 2007
New Revision: 6307
URL: http://svn.debian.org/wsvn/?sc=1&rev=6307
Log:
[svn-upgrade] Integrating new upstream version, libnet-sip-perl (0.31)
Modified:
branches/upstream/libnet-sip-perl/current/Changes
branches/upstream/libnet-sip-perl/current/META.yml
branches/upstream/libnet-sip-perl/current/README
branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Packet.pm
Modified: branches/upstream/libnet-sip-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/Changes?rev=6307&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/Changes (original)
+++ branches/upstream/libnet-sip-perl/current/Changes Mon Aug 6 22:36:59 2007
@@ -1,7 +1,10 @@
Revision history for Net::SIP
+0.31
+ - make it usable for perl5.9, tested with 5.9.5
+
0.30
- - Option cb_established for Simple::Call:reinvite to specify
+ - Option cb_preliminary for Simple::Call:reinvite to specify
callback which will be triggered when preliminary response
is received
more parameter for cb_create in Simple::listen, so that
Modified: branches/upstream/libnet-sip-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/META.yml?rev=6307&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/META.yml (original)
+++ branches/upstream/libnet-sip-perl/current/META.yml Mon Aug 6 22:36:59 2007
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Net-SIP
-version: 0.30
+version: 0.31
version_from: lib/Net/SIP.pm
installdirs: site
requires:
Modified: branches/upstream/libnet-sip-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/README?rev=6307&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/README (original)
+++ branches/upstream/libnet-sip-perl/current/README Mon Aug 6 22:36:59 2007
@@ -16,7 +16,7 @@
It was tested on Linux (Ubuntu 6.10, 7.04), MacOSX 10.3+10.4,
OpenBSD3.9+4.1 with various perl versions starting with
-perl5.8.7.
+perl5.8.7, including 5.9.5.
Sample Code was tested with Snom 300 Phones, Asterisk 1.2,
Fritz!Box and KPhone.
Modified: branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm?rev=6307&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm Mon Aug 6 22:36:59 2007
@@ -4,7 +4,7 @@
require 5.008;
package Net::SIP;
-our $VERSION = '0.30';
+our $VERSION = '0.31';
# this includes nearly everything else
use Net::SIP::Simple ();
Modified: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Packet.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Packet.pm?rev=6307&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Packet.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Packet.pm Mon Aug 6 22:36:59 2007
@@ -74,22 +74,18 @@
$header = \@hnew;
}
- my $self = fields::new($class);
- my $rebless;
if ( $code =~m{^\d} ) {
# Response
- $self->{code} = $code;
- $self->{text} = defined($text) ? $text:'';
- $rebless = 'Net::SIP::Response';
+ $class = 'Net::SIP::Response' if $class eq 'Net::SIP::Packet';
} else {
# Request
- $self->{code} = uc($code); # uppercase method
- $self->{text} = defined($text) ? $text:'';
- $rebless = 'Net::SIP::Request';
- }
-
- # rebless to Net::SIP::{Request,Response}
- bless $self,$rebless if $class eq 'Net::SIP::Packet';
+ $code = uc($code); # uppercase method
+ $class = 'Net::SIP::Request' if $class eq 'Net::SIP::Packet';
+ }
+
+ my $self = fields::new($class);
+ $self->{code} = $code;
+ $self->{text} = defined($text) ? $text:'';
# $self->{header} is list of Net::SIP::HeaderPair which cares about normalized
# keys while maintaining the original key, so that one can restore header
@@ -135,14 +131,14 @@
###########################################################################
sub new_from_string {
my ($class,$string) = @_;
+ my $data = _string2parts( $string );
+ if ( $class eq 'Net::SIP::Packet' ) {
+ $class = $data->{code} =~m{^\d}
+ ? 'Net::SIP::Response'
+ :'Net::SIP::Request';
+ }
my $self = fields::new($class);
- $self->{as_string} = $string;
- if ( $class eq 'Net::SIP::Packet' ) {
- # rebless
- # as a side effect is_request will parse string so that code,header etc
- # will be set
- bless $self,( $self->is_request ? 'Net::SIP::Request':'Net::SIP::Response' );
- }
+ %$self = %$data;
return $self;
}
@@ -490,27 +486,36 @@
sub as_parts {
my $self = shift;
- # if parts are up to date return immediatly
+ # if parts are up to date return immediatly#
+ if ( ! $self->{code} ) {
+ my $data = _string2parts( $self->{as_string} );
+ %$self = ( %$self,%$data );
+ }
return @{$self}{qw(code text header body)} if $self->{code};
+}
+
+sub _string2parts {
+ my $string = shift;
+ my %result = ( as_string => $string );
# otherwise parse request
- my ($header,$body) = split( m{\r?\n\r?\n}, $self->{as_string},2 );
+ my ($header,$body) = split( m{\r?\n\r?\n}, $string,2 );
my @header = split( m{\r?\n}, $header );
if ( $header[0] =~m{^SIP/2.0\s+(\d+)\s+(\S.*?)\s*$} ) {
# Response, e.g. SIP/2.0 407 Authorization required
- $self->{code} = $1;
- $self->{text} = $2;
+ $result{code} = $1;
+ $result{text} = $2;
} elsif ( $header[0] =~m{^(\w+)\s+(\S.*?)\s+SIP/2\.0\s*$} ) {
# Request, e.g. INVITE <sip:bla at fasel> SIP/2.0
- $self->{code} = $1;
- $self->{text} = $2;
+ $result{code} = $1;
+ $result{text} = $2;
} else {
die "bad request: starts with '$header[0]'";
}
shift(@header);
- $self->{body} = $body;
+ $result{body} = $body;
my @hdr;
my @lines;
@@ -566,10 +571,9 @@
}
push @lines, [ $line, int(@v) ];
}
- $self->{header} = \@hdr;
- $self->{lines} = \@lines;
-
- return @{$self}{qw( code text header body )};
+ $result{header} = \@hdr;
+ $result{lines} = \@lines;
+ return \%result;
}
###########################################################################
More information about the Pkg-perl-cvs-commits
mailing list