Last change
on this file since 27174 was 27174, checked in by davidb, 11 years ago |
Perl modules from CPAN that are used in supporting activate.pl, but not part of the Perl core. Only PMs included.
|
File size:
1.7 KB
|
Line | |
---|
1 | #
|
---|
2 | # Written by Ryan Kereliuk <[email protected]>. 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.11";
|
---|
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;
|
---|
Note:
See
TracBrowser
for help on using the repository browser.