package WWW::CPAN; use 5.006; use strict; use warnings; our $VERSION = '0.011'; use Class::Lego::Constructor 0.004 (); use parent qw( Class::Accessor Class::Lego::Constructor ); my $FIELDS = { host => 'search.cpan.org', ua => sub { # default useragent my %options = ( agent => 'www-cpan/' . $VERSION, ); # require LWP::UserAgent; # return LWP::UserAgent->new( %options ); require LWP::UserAgent::Determined; return LWP::UserAgent::Determined->new( %options ); }, j_loader => sub { # json loader sub require JSON::Any; JSON::Any->import; # XXX JSON::Any needs this my $j = JSON::Any->new; return sub { $j->Load(shift); } }, x_loader => sub { # xml loader sub require XML::Simple; my %options = ( ForceArray => [qw( module dist match )], KeyAttr => [], ); my $x = XML::Simple->new( %options ); return sub { $x->XMLin(shift); } }, }; __PACKAGE__->mk_constructor0( $FIELDS ); __PACKAGE__->mk_accessors( keys %$FIELDS ); use Class::Lego::Myself; __PACKAGE__->give_my_self; use Carp qw( carp ); sub _build_distmeta_uri { my $self = shift; my $params = shift; if ( ! ref $params ) { $params = { dist => $params }; } require URI; my $uri = URI->new(); $uri->scheme('http'); $uri->authority( $self->host ); my @path = qw( meta ); if ( $params->{author} ) { push @path, $params->{author}; } my $dist = $params->{dist}; if ( $params->{version} ) { $dist .= '-' . $params->{version}; } push @path, $dist; push @path, 'META.json'; # XXX support YAML as well $uri->path_segments(@path); return $uri; } sub fetch_distmeta { (my $self, @_) = &find_my_self; my $uri = $self->_build_distmeta_uri(@_); my $r = $self->ua->get($uri); if ( $r->is_success ) { return $self->j_loader->( $r->content ); } else { carp $r->status_line; # FIXME needs more convincing error handling return; } } # http://search.cpan.org/search?query=Archive&mode=all&format=xml sub _build_query_uri { my $self = shift; my $params = shift; if ( ! ref $params ) { $params = { query => $params, mode => 'all', format => 'xml', }; } require URI; my $uri = URI->new(); $uri->scheme('http'); $uri->authority( $self->host ); my @path = qw( search ); $uri->path_segments(@path); $params->{mode} ||= 'all'; $params->{format} ||= 'xml'; $uri->query_form( $params ); return $uri; } # other params: s (start), n (page size, should be <= 100) sub _basic_query { my $self = shift; my $uri = $self->_build_query_uri(@_); my $r = $self->ua->get($uri); if ( $r->is_success ) { return $self->x_loader->( $r->content ); } else { carp $r->status_line; # FIXME needs more convincing error handling return; } } sub search { my $self = &find_my_self; return $self->_basic_query(@_); } # TODO fetch the entire result by default # &query is an alias to &search (see Method::Alias for the rationale) sub query { goto &{ $_[0]->can('search') }; } "I didn't do it! -- Bart Simpson";