1package URI::news; # draft-gilman-news-url-01 2 3require URI::_server; 4@ISA=qw(URI::_server); 5 6use strict; 7use URI::Escape qw(uri_unescape); 8use Carp (); 9 10sub default_port { 119 } 11 12# newsURL = scheme ":" [ news-server ] [ refbygroup | message ] 13# scheme = "news" | "snews" | "nntp" 14# news-server = "//" server "/" 15# refbygroup = group [ "/" messageno [ "-" messageno ] ] 16# message = local-part "@" domain 17 18sub _group 19{ 20 my $self = shift; 21 my $old = $self->path; 22 if (@_) { 23 my($group,$from,$to) = @_; 24 if ($group =~ /\@/) { 25 $group =~ s/^<(.*)>$/$1/; # "<" and ">" should not be part of it 26 } 27 $group =~ s,%,%25,g; 28 $group =~ s,/,%2F,g; 29 my $path = $group; 30 if (defined $from) { 31 $path .= "/$from"; 32 $path .= "-$to" if defined $to; 33 } 34 $self->path($path); 35 } 36 37 $old =~ s,^/,,; 38 if ($old !~ /\@/ && $old =~ s,/(.*),, && wantarray) { 39 my $extra = $1; 40 return (uri_unescape($old), split(/-/, $extra)); 41 } 42 uri_unescape($old); 43} 44 45 46sub group 47{ 48 my $self = shift; 49 if (@_) { 50 Carp::croak("Group name can't contain '\@'") if $_[0] =~ /\@/; 51 } 52 my @old = $self->_group(@_); 53 return if $old[0] =~ /\@/; 54 wantarray ? @old : $old[0]; 55} 56 57sub message 58{ 59 my $self = shift; 60 if (@_) { 61 Carp::croak("Message must contain '\@'") unless $_[0] =~ /\@/; 62 } 63 my $old = $self->_group(@_); 64 return unless $old =~ /\@/; 65 return $old; 66} 67 681; 69