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