home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / auto / URI / URL / _generic / _netloc_elem.al next >
Text File  |  1997-11-28  |  878b  |  28 lines
  1. # NOTE: Derived from ./blib/lib/URI/URL/_generic.pm.  Changes made here will be lost.
  2. package URI::URL::_generic;
  3.  
  4. sub _netloc_elem {
  5.     my($self, $elem, @val) = @_;
  6.     my $old = $self->_elem($elem, @val);
  7.     return $old unless @val;
  8.  
  9.     # update the 'netloc' element
  10.     my $nl = '';
  11.     my $host = $self->{'host'};
  12.     if (defined $host) {  # can't be any netloc without any host
  13.     my $user = $self->{'user'};
  14.     $nl .= uri_escape($user, $URI::URL::reserved) if defined $user;
  15.     $nl .= ":" . uri_escape($self->{'password'}, $URI::URL::reserved)
  16.       if defined($user) and defined($self->{'password'});
  17.     $nl .= '@' if length $nl;
  18.     $nl .= uri_escape($host, $URI::URL::reserved);
  19.     my $port = $self->{'port'};
  20.     $nl .= ":$port" if defined($port) && $port != $self->default_port;
  21.     }
  22.     $self->{'netloc'} = $nl;
  23.     $self->{'_str'} = '';
  24.     $old;
  25. }
  26.  
  27. 1;
  28.