1# 2# Written by Ryan Kereliuk <ryker@ryker.org>. This file may be 3# distributed under the same terms as Perl itself. 4# 5# The RFC 3261 sip URI is <scheme>:<authority>;<params>?<query>. 6# 7 8package URI::sip; 9 10require URI::_server; 11require URI::_userpass; 12@ISA=qw(URI::_server URI::_userpass); 13 14use strict; 15use vars qw(@ISA $VERSION); 16use URI::Escape qw(uri_unescape); 17 18$VERSION = "0.10"; 19 20sub default_port { 5060 } 21 22sub authority 23{ 24 my $self = shift; 25 $$self =~ m,^($URI::scheme_re:)?([^;?]*)(.*)$,os or die; 26 my $old = $2; 27 28 if (@_) { 29 my $auth = shift; 30 $$self = defined($1) ? $1 : ""; 31 my $rest = $3; 32 if (defined $auth) { 33 $auth =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; 34 $$self .= "$auth"; 35 } 36 $$self .= $rest; 37 } 38 $old; 39} 40 41sub params_form 42{ 43 my $self = shift; 44 $$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die; 45 my $paramstr = $3; 46 47 if (@_) { 48 my @args = @_; 49 $$self = $1 . $2; 50 my $rest = $4; 51 my @new; 52 for (my $i=0; $i < @args; $i += 2) { 53 push(@new, "$args[$i]=$args[$i+1]"); 54 } 55 $paramstr = join(";", @new); 56 $$self .= ";" . $paramstr . $rest; 57 } 58 $paramstr =~ s/^;//o; 59 return split(/[;=]/, $paramstr); 60} 61 62sub params 63{ 64 my $self = shift; 65 $$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die; 66 my $paramstr = $3; 67 68 if (@_) { 69 my $new = shift; 70 $$self = $1 . $2; 71 my $rest = $4; 72 $$self .= $paramstr . $rest; 73 } 74 $paramstr =~ s/^;//o; 75 return $paramstr; 76} 77 78# Inherited methods that make no sense for a SIP URI. 79sub path {} 80sub path_query {} 81sub path_segments {} 82sub abs { shift } 83sub rel { shift } 84sub query_keywords {} 85 861; 87