use strict;
use warnings;

package URI::cpan;
# ABSTRACT: URLs that refer to things on the CPAN
$URI::cpan::VERSION = '1.007';
use parent qw(URI::_generic);

#pod =head1 SYNOPSIS
#pod
#pod   use URI::cpan;
#pod
#pod   my $uri = URI->new('cpan:///distfile/RJBS/URI-cpan-1.000.tar.gz');
#pod
#pod   $uri->author;       # => RJBS
#pod   $uri->dist_name;    # => URI-cpan
#pod   $uri->dist_version; # => 1.000
#pod
#pod Other forms of cpan: URI include:
#pod
#pod   cpan:///author/RJBS
#pod
#pod Reserved for likely future use are:
#pod
#pod   cpan:///dist
#pod   cpan:///module
#pod   cpan:///package
#pod
#pod =cut

use Carp ();
use URI::cpan::author;
use URI::cpan::dist;
use URI::cpan::distfile;
use URI::cpan::module;
use URI::cpan::package;
use URI::cpan::dist;

my %type_class = (
  author   => 'URI::cpan::author',
  distfile => 'URI::cpan::distfile',

  # These will be uncommented when we figure out what the heck to do with them.
  # -- rjbs, 2009-03-30
  #
  # dist    => 'URI::cpan::dist',
  # package => 'URI::cpan::package',
  # module  => 'URI::cpan::module',
);

sub _init {
  my $self = shift->SUPER::_init(@_);
  my $class = ref($self);

  Carp::croak "invalid cpan URI: non-empty query string not supported"
    if $self->query;

  Carp::croak "invalid cpan URI: non-empty fragment string not supported"
    if $self->fragment;

  my (undef, @path_parts) = split m{/}, $self->path;
  my $type = $path_parts[0];

  Carp::croak "invalid cpan URI: do not understand path " . $self->path
    unless my $new_class = $type_class{ $type };

  bless $self => $new_class;

  $self->validate;

  return $self;
}

sub _p_rel {
  my ($self) = @_;
  my $path = $self->path;
  $path =~ s{^/\w+/}{};
  return $path;
}

#pod =head1 WARNINGS
#pod
#pod URI objects are difficult to subclass, so I have not (yet?) taken the time to
#pod remove mutability from the objects.  This means that you can probably alter a
#pod URI::cpan object into a state where it is no longer valid.
#pod
#pod Please don't change the contents of these objects after construction.
#pod
#pod =head1 SEE ALSO
#pod
#pod L<URI::cpan::author> and L<URI::cpan::distfile>
#pod
#pod =head1 THANKS
#pod
#pod This code is derived from code written at Pobox.com by Hans Dieter Pearcey.
#pod Dieter helped thrash out this new implementation, too.
#pod
#pod =cut

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

URI::cpan - URLs that refer to things on the CPAN

=head1 VERSION

version 1.007

=head1 SYNOPSIS

  use URI::cpan;

  my $uri = URI->new('cpan:///distfile/RJBS/URI-cpan-1.000.tar.gz');

  $uri->author;       # => RJBS
  $uri->dist_name;    # => URI-cpan
  $uri->dist_version; # => 1.000

Other forms of cpan: URI include:

  cpan:///author/RJBS

Reserved for likely future use are:

  cpan:///dist
  cpan:///module
  cpan:///package

=head1 WARNINGS

URI objects are difficult to subclass, so I have not (yet?) taken the time to
remove mutability from the objects.  This means that you can probably alter a
URI::cpan object into a state where it is no longer valid.

Please don't change the contents of these objects after construction.

=head1 SEE ALSO

L<URI::cpan::author> and L<URI::cpan::distfile>

=head1 THANKS

This code is derived from code written at Pobox.com by Hans Dieter Pearcey.
Dieter helped thrash out this new implementation, too.

=head1 AUTHOR

Ricardo SIGNES <rjbs@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2009 by Ricardo SIGNES.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut