File Coverage

blib/lib/URI/sip.pm
Criterion Covered Total %
statement 48 49 97.9
branch 9 12 75.0
condition n/a
subroutine 10 14 71.4
pod 8 10 80.0
total 75 85 88.2


line stmt bran cond sub pod time code
1             #
2             # Written by Ryan Kereliuk . This file may be
3             # distributed under the same terms as Perl itself.
4             #
5             # The RFC 3261 sip URI is :;?.
6             #
7              
8             package URI::sip;
9              
10 1     1   7 use strict;
  1         8  
  1         30  
11 1     1   6 use warnings;
  1         1  
  1         28  
12              
13 1     1   411 use parent qw(URI::_server URI::_userpass);
  1         298  
  1         5  
14              
15 1     1   44 use URI::Escape ();
  1         2  
  1         539  
16              
17             our $VERSION = '5.19';
18              
19 6     6 1 13 sub default_port { 5060 }
20              
21             sub authority
22             {
23 35     35 1 64 my $self = shift;
24 35 50       236 $$self =~ m,^($URI::scheme_re:)?([^;?]*)(.*)$,os or die;
25 35         80 my $start = $1;
26 35         54 my $authoritystr = $2;
27 35         46 my $rest = $3;
28              
29 35 100       62 if (@_) {
30 5         20 $authoritystr = shift;
31 5         34 $authoritystr =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;
  0         0  
32 5         14 $$self = $start . $authoritystr . $rest;
33             }
34 35         99 return $authoritystr;
35             }
36              
37             sub params_form
38             {
39 2     2 0 12 my $self = shift;
40 2 50       57 $$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die;
41 2         9 my $start = $1 . $2;
42 2         4 my $paramstr = $3;
43 2         3 my $rest = $4;
44              
45 2 100       16 if (@_) {
46 1         2 my @paramarr;
47 1         3 for (my $i = 0; $i < @_; $i += 2) {
48 2         8 push(@paramarr, "$_[$i]=$_[$i+1]");
49             }
50 1         3 $paramstr = join(";", @paramarr);
51 1         3 $$self = $start . ";" . $paramstr . $rest;
52             }
53 2         16 $paramstr =~ s/^;//o;
54 2         15 return split(/[;=]/, $paramstr);
55             }
56              
57             sub params
58             {
59 4     4 0 13 my $self = shift;
60 4 50       74 $$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die;
61 4         25 my $start = $1 . $2;
62 4         8 my $paramstr = $3;
63 4         8 my $rest = $4;
64              
65 4 100       9 if (@_) {
66 1         2 $paramstr = shift;
67 1         3 $$self = $start . ";" . $paramstr . $rest;
68             }
69 4         12 $paramstr =~ s/^;//o;
70 4         18 return $paramstr;
71             }
72              
73             # Inherited methods that make no sense for a SIP URI.
74       0 1   sub path {}
75       0 1   sub path_query {}
76       0 1   sub path_segments {}
77 2     2 1 21 sub abs { shift }
78 1     1 1 4 sub rel { shift }
79       0 1   sub query_keywords {}
80              
81             1;