r6343 - in /trunk/libnet-sip-perl: Changes META.yml README debian/changelog lib/Net/SIP.pm lib/Net/SIP/Packet.pm

rmayorga-guest at users.alioth.debian.org rmayorga-guest at users.alioth.debian.org
Wed Aug 8 19:20:51 UTC 2007


Author: rmayorga-guest
Date: Wed Aug  8 19:20:51 2007
New Revision: 6343

URL: http://svn.debian.org/wsvn/?sc=1&rev=6343
Log:
* adding patch to the new upstream release

Modified:
    trunk/libnet-sip-perl/Changes
    trunk/libnet-sip-perl/META.yml
    trunk/libnet-sip-perl/README
    trunk/libnet-sip-perl/debian/changelog
    trunk/libnet-sip-perl/lib/Net/SIP.pm
    trunk/libnet-sip-perl/lib/Net/SIP/Packet.pm

Modified: trunk/libnet-sip-perl/Changes
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/Changes?rev=6343&op=diff
==============================================================================
--- trunk/libnet-sip-perl/Changes (original)
+++ trunk/libnet-sip-perl/Changes Wed Aug  8 19:20:51 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: trunk/libnet-sip-perl/META.yml
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/META.yml?rev=6343&op=diff
==============================================================================
--- trunk/libnet-sip-perl/META.yml (original)
+++ trunk/libnet-sip-perl/META.yml Wed Aug  8 19:20:51 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: trunk/libnet-sip-perl/README
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/README?rev=6343&op=diff
==============================================================================
--- trunk/libnet-sip-perl/README (original)
+++ trunk/libnet-sip-perl/README Wed Aug  8 19:20:51 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: trunk/libnet-sip-perl/debian/changelog
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/debian/changelog?rev=6343&op=diff
==============================================================================
--- trunk/libnet-sip-perl/debian/changelog (original)
+++ trunk/libnet-sip-perl/debian/changelog Wed Aug  8 19:20:51 2007
@@ -1,3 +1,9 @@
+libnet-sip-perl (0.31-1) UNRELEASED; urgency=low
+
+  * (NOT RELEASED YET) New upstream release
+
+ -- Rene Mayorga <rmayorga at debian.org.sv>  Wed, 08 Aug 2007 13:18:09 -0600
+
 libnet-sip-perl (0.30-1) unstable; urgency=low
 
   * Initial release (Closes: #432912)

Modified: trunk/libnet-sip-perl/lib/Net/SIP.pm
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/lib/Net/SIP.pm?rev=6343&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP.pm Wed Aug  8 19:20:51 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: trunk/libnet-sip-perl/lib/Net/SIP/Packet.pm
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/lib/Net/SIP/Packet.pm?rev=6343&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Packet.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Packet.pm Wed Aug  8 19:20:51 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