git.maemo.org Git - dh-make-perl/blob - dev/i386/liburi-perl/liburi-perl-1.35.dfsg.1/URI/sip.pm

   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::escapes{$1}/go;
  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;