diff options
| author | Andreas Brachold <vdr07@deltab.de> | 2007-11-11 06:55:13 +0000 |
|---|---|---|
| committer | Andreas Brachold <vdr07@deltab.de> | 2007-11-11 06:55:13 +0000 |
| commit | 3282be229999dc36c197b264d63063a18d136331 (patch) | |
| tree | 98a42db29d955b39e7bed1b599fdcc56c3a29de9 /lib/URI/_server.pm | |
| parent | cfdd733c17cfa4f1a43b827a656e9e53cc2524ac (diff) | |
| download | xxv-3282be229999dc36c197b264d63063a18d136331.tar.gz xxv-3282be229999dc36c197b264d63063a18d136331.tar.bz2 | |
* Update installation list with required modules
* Remove unused/doubled provided external perl moduls
Diffstat (limited to 'lib/URI/_server.pm')
| -rw-r--r-- | lib/URI/_server.pm | 106 |
1 files changed, 0 insertions, 106 deletions
diff --git a/lib/URI/_server.pm b/lib/URI/_server.pm deleted file mode 100644 index 10059f0..0000000 --- a/lib/URI/_server.pm +++ /dev/null @@ -1,106 +0,0 @@ -package URI::_server; -require URI::_generic; -@ISA=qw(URI::_generic); - -use strict; -use URI::Escape qw(uri_unescape); - -sub userinfo -{ - my $self = shift; - my $old = $self->authority; - - if (@_) { - my $new = $old; - $new = "" unless defined $new; - $new =~ s/.*@//; # remove old stuff - my $ui = shift; - if (defined $ui) { - $ui =~ s/@/%40/g; # protect @ - $new = "$ui\@$new"; - } - $self->authority($new); - } - return undef if !defined($old) || $old !~ /(.*)@/; - return $1; -} - -sub host -{ - my $self = shift; - my $old = $self->authority; - if (@_) { - my $tmp = $old; - $tmp = "" unless defined $tmp; - my $ui = ($tmp =~ /(.*@)/) ? $1 : ""; - my $port = ($tmp =~ /(:\d+)$/) ? $1 : ""; - my $new = shift; - $new = "" unless defined $new; - if (length $new) { - $new =~ s/[@]/%40/g; # protect @ - $port = $1 if $new =~ s/(:\d+)$//; - } - $self->authority("$ui$new$port"); - } - return undef unless defined $old; - $old =~ s/.*@//; - $old =~ s/:\d+$//; - return uri_unescape($old); -} - -sub _port -{ - my $self = shift; - my $old = $self->authority; - if (@_) { - my $new = $old; - $new =~ s/:\d*$//; - my $port = shift; - $new .= ":$port" if defined $port; - $self->authority($new); - } - return $1 if defined($old) && $old =~ /:(\d*)$/; - return; -} - -sub port -{ - my $self = shift; - my $port = $self->_port(@_); - $port = $self->default_port if !defined($port) || $port eq ""; - $port; -} - -sub host_port -{ - my $self = shift; - my $old = $self->authority; - $self->host(shift) if @_; - return undef unless defined $old; - $old =~ s/.*@//; # zap userinfo - $old =~ s/:$//; # empty port does not could - $old .= ":" . $self->port unless $old =~ /:/; - $old; -} - - -sub default_port { undef } - -sub canonical -{ - my $self = shift; - my $other = $self->SUPER::canonical; - my $host = $other->host || ""; - my $port = $other->_port; - my $uc_host = $host =~ /[A-Z]/; - my $def_port = defined($port) && ($port eq "" || - $port == $self->default_port); - if ($uc_host || $def_port) { - $other = $other->clone if $other == $self; - $other->host(lc $host) if $uc_host; - $other->port(undef) if $def_port; - } - $other; -} - -1; |
