home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / URI / URL / news.pm < prev    next >
Encoding:
Perl POD Document  |  1996-10-30  |  1.5 KB  |  74 lines  |  [TEXT/McPL]
  1. package URI::URL::news;
  2. require URI::URL;
  3. @ISA = qw(URI::URL);
  4.  
  5. use URI::Escape;
  6.  
  7. sub new {
  8.     my($class, $init, $base) = @_;
  9.     my $self = bless { }, $class;
  10.     $self->{'scheme'}  = lc($1) if $init =~ s/^\s*([\w\+\.\-]+)://;
  11.     $self->groupart(uri_unescape($init));
  12.     $self->base($base) if $base;
  13.     $self;
  14. }
  15.  
  16. sub groupart {
  17.     my $self = shift;
  18.     my $old = $self->{'path'};
  19.     if (@_) {
  20.     my $p = shift;
  21.     if (defined $p && $p =~ /\@/) {
  22.         # it is an message id
  23.         $p =~ s/^<(.*)>$/$1/;  # "<" and ">" should not be part of it
  24.     }
  25.     $self->{'path'} = $p;
  26.     }
  27.     $old;
  28. }
  29.  
  30. *path = \&groupart;
  31.  
  32. sub article   {
  33.     my $self = shift;
  34.     Carp::croak("Illegal article id name (does not contain '\@')")
  35.       if @_ && $_[0] !~ /\@/;
  36.     my $old = $self->groupart(@_);
  37.     return undef if $old !~ /\@/;
  38.     $old;
  39. }
  40.  
  41.  
  42. sub group {
  43.     my $self = shift;
  44.     Carp::croak("Illegal group name (contains '\@')")
  45.       if @_ && $_[0] =~ /\@/;
  46.     my $old = $self->groupart(@_);
  47.     return undef if $old =~ /\@/;
  48.     $old;
  49. }
  50.  
  51. sub crack
  52. {
  53.     my $self = shift;
  54.     ('news',             # scheme
  55.      undef,              # user
  56.      undef,              # passwd
  57.      undef,              # host
  58.      undef,              # port
  59.      $self->{'path'},    # path
  60.      undef,              # params
  61.      undef,              # query
  62.      undef               # fragment
  63.     )
  64. }
  65.  
  66.  
  67. sub as_string {
  68.     my $self = shift;
  69.     my $scheme = $self->{'scheme'} || "news";
  70.     "$scheme:" . uri_escape($self->{'path'});
  71. }
  72.  
  73. 1;
  74.