Commit | Line | Data |
3fea05b9 |
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 | |
8 | package URI::sip; |
9 | |
10 | require URI::_server; |
11 | require URI::_userpass; |
12 | @ISA=qw(URI::_server URI::_userpass); |
13 | |
14 | use strict; |
15 | use vars qw(@ISA $VERSION); |
16 | use URI::Escape qw(uri_unescape); |
17 | |
18 | $VERSION = "0.10"; |
19 | |
20 | sub default_port { 5060 } |
21 | |
22 | sub 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::escape_char($1)/ego; |
34 | $$self .= "$auth"; |
35 | } |
36 | $$self .= $rest; |
37 | } |
38 | $old; |
39 | } |
40 | |
41 | sub 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 | |
62 | sub 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. |
79 | sub path {} |
80 | sub path_query {} |
81 | sub path_segments {} |
82 | sub abs { shift } |
83 | sub rel { shift } |
84 | sub query_keywords {} |
85 | |
86 | 1; |