D::File includes now a list of modules, D::Module not indexed anymore

monken · monken · commit 19fa75666ead · 2011-03-17T17:07:25.000+01:00
diff --git a/inc/monken/p5-elasticsearch-model b/inc/monken/p5-elasticsearch-model
@@ -1 +1 @@
-Subproject commit b4c8c08858d3b423431253d9e3399a9e5ad7eaf7
+Subproject commit 2fe61f73f4752057bd33848066f7bfd18728f2e4
diff --git a/lib/MetaCPAN/Document/File.pm b/lib/MetaCPAN/Document/File.pm
@@ -11,6 +11,7 @@ use Plack::MIME;
 use List::MoreUtils qw(uniq);
 use MetaCPAN::Pod::Lines;
 use MetaCPAN::Types qw(:all);
+use MooseX::Types::Moose qw(ArrayRef);
 
 Plack::MIME->add_type( ".t"   => "text/x-script.perl" );
 Plack::MIME->add_type( ".pod" => "text/x-script.perl" );
@@ -19,10 +20,10 @@ Plack::MIME->add_type( ".xs"  => "text/x-c" );
 has id => ( id => [qw(author release path)] );
 
 has [qw(path author name distribution)] => ();
-has module => ( required => 0, is => 'rw' );
+has module => ( required => 0, is => 'ro', isa => Module, coerce => 1 );
 has documentation => ( required => 0, is => 'rw' );
 has release => ( parent => 1 );
-has url    => ( lazy_build => 1,      index   => 'no' );
+has date => ( isa => 'DateTime' );
 has stat => ( isa => Stat, required => 0 );
 has sloc => ( isa => 'Int',        lazy_build => 1 );
 has slop => ( isa => 'Int', is => 'rw', default => 0 );
@@ -49,6 +50,7 @@ sub is_perl_file {
 sub _build_indexed {
     my $self = shift;
     return 1 unless(my $pkg = $self->module);
+    $pkg = $pkg->[0]->{name} || return 0;;
     my $content = ${$self->content};
     return $content =~ /    # match a package declaration
       ^[\h\{;]*             # intro chars on a line
@@ -116,14 +118,6 @@ sub _build_path {
     return join( '/', $self->release->name, $self->name );
 }
 
-sub _build_path_uri {
-    URI::Escape::uri_escape( URI::Escape::uri_escape( shift->path ) );
-}
-
-sub _build_url {
-    'http://search.metacpan.org/source/' . shift->path;
-}
-
 sub _build_pod_lines {
     my $self = shift;
     return [] unless ( $self->is_perl_file );
diff --git a/lib/MetaCPAN/Document/Mirror.pm b/lib/MetaCPAN/Document/Mirror.pm
@@ -11,6 +11,6 @@ has [qw(tz src http rsync ftp freq note dnsrr ccode aka_name A_or_CNAME)]
     => ( required => 0 );
 has location => ( isa => Location, coerce => 1, required => 0 );
 has contact => ( isa => 'ArrayRef' );
-has [qw(inceptdate reitredate)] => ( isa => ESDateTime, required => 0, coerce => 1 );
+has [qw(inceptdate reitredate)] => ( isa => 'DateTime', required => 0, coerce => 1 );
 
 __PACKAGE__->meta->make_immutable;
diff --git a/lib/MetaCPAN/Document/Module.pm b/lib/MetaCPAN/Document/Module.pm
@@ -1,44 +1,16 @@
 package MetaCPAN::Document::Module;
 use Moose;
 use ElasticSearchX::Model::Document;
-
 use MetaCPAN::Util;
-use URI::Escape ();
 
-has id => ( id => [qw(author release name)] );
-has version_numified => ( isa => 'Num', lazy_build => 1 );
-has [qw(author distribution)] => ();
-has [qw(path file_id)] => ( lazy_build => 1 );
-has release => ( parent => 1 );
 has name => ( index => 'analyzed' );
-has [qw(version)] => ( required => 0 );
-has date     => ( isa   => 'DateTime' );
-has abstract => ( index => 'analyzed', lazy_build => 1 );
-has status => ( default => 'cpan' );
-has maturity => ( default => 'released' );
-
-has file => ( property => 0, required => 0 );
-
-sub BUILD {
-    my $self = shift;
-    $self->file->module($self->name) if($self->file);
-    return $self;
-}
+has version => ( required => 0 );
+has version_numified => ( isa => 'Num', lazy_build => 1 );
 
 sub _build_version_numified {
-    return MetaCPAN::Util::numify_version( shift->version );
-}
-
-sub _build_path {
-    shift->file->path;
-}
-
-sub _build_file_id {
-    shift->file->id;
-}
-
-sub _build_abstract {
-    shift->file->abstract;
+    my $self = shift;
+    return 0 unless($self->version);
+    return MetaCPAN::Util::numify_version( $self->version );
 }
 
-__PACKAGE__->meta->make_immutable;
+__PACKAGE__->meta->make_immutable;
diff --git a/lib/MetaCPAN/Plack/Module.pm b/lib/MetaCPAN/Plack/Module.pm
@@ -3,12 +3,12 @@ use base 'MetaCPAN::Plack::Base';
 use strict;
 use warnings;
 
-sub index { 'module' }
+sub index { 'file' }
 
 sub query {
     shift;
     return { query  => { match_all => {} },
-        filter => { term => { "name.raw"    => shift } },
+        filter => { term => { "file.module.name.raw"    => shift } },
          size   => 1,
          sort   => { date      => { reverse => \1 } } 
          };
diff --git a/lib/MetaCPAN/Plack/Pod.pm b/lib/MetaCPAN/Plack/Pod.pm
@@ -9,7 +9,7 @@ use MetaCPAN::Pod::XHTML;
 sub handle {
     my ( $self, $env ) = @_;
     if ( $env->{REQUEST_URI} =~ m{\A/pod/([^\/]*?)\/?$} ) {
-        $self->rewrite_request($env);
+        use Devel::Dwarn; DwarnN($env);
         my $res =
           Plack::App::Proxy->new( backend => 'LWP', remote => "http://" . $self->remote . "/cpan" )
           ->to_app->($env);
diff --git a/lib/MetaCPAN/Plack/Source.pm b/lib/MetaCPAN/Plack/Source.pm
@@ -45,7 +45,7 @@ sub file_path {
     my ($tarball) = File::Find::Rule->new->file->name("$distvname.tar.gz")->in($author, $http);
     return unless ( $tarball && -e $tarball );
     my $arch = Archive::Tar::Wrapper->new();
-    $distvname =~ s/-TRIAL$//;
+    $distvname =~ s/-TRIAL$//; # FIXME: while(my $entry = $arch->list_next()) {
     my $logic_path = "$distvname/$file";    # path within unzipped archive
     $arch->read( $tarball, $logic_path ); # read only one file
     my $phys_path = $arch->locate( $logic_path );
diff --git a/lib/MetaCPAN/Pod/XHTML.pm b/lib/MetaCPAN/Pod/XHTML.pm
@@ -1,15 +1,8 @@
 package MetaCPAN::Pod::XHTML;
 
 use Moose;
-
 extends 'Pod::Simple::XHTML';
 
-use feature 'say';
-use Data::Dump qw( dump );
-use HTML::Entities;
-use IO::File;
-use Path::Class::File;
-
 sub start_L {
     my ( $self, $flags ) = @_;
     my ( $type, $to, $section ) = @{$flags}{ 'type', 'to', 'section' };
diff --git a/lib/MetaCPAN/Role/Common.pm b/lib/MetaCPAN/Role/Common.pm
@@ -5,6 +5,7 @@ use ElasticSearch;
 use Log::Contextual qw( set_logger :dlog );
 use Log::Log4perl ':easy';
 use MetaCPAN::Types qw(:all);
+use ElasticSearchX::Model::Document::Types qw(:all);
 use MetaCPAN::Model;
 
 has 'cpan' => ( is         => 'rw',
@@ -72,7 +73,7 @@ sub _build_cpan {
 }
 
 sub remote {
-    shift->es->transport->servers->[0];
+    shift->es->transport->default_servers->[0];
 }
 
 sub run { }
diff --git a/lib/MetaCPAN/Script/Latest.pm b/lib/MetaCPAN/Script/Latest.pm
@@ -38,7 +38,7 @@ sub run {
             next if ( $row->{_source}->{status} eq 'latest' );
             log_info { "Upgrading $row->{_source}->{name} to latest" };
 
-            for (qw(file module dependency)) {
+            for (qw(file dependency)) {
                 log_debug { "Upgrading $_" };
                 $self->reindex( $_, $row->{_id}, 'latest' );
             }
@@ -50,7 +50,7 @@ sub run {
         } elsif ( $row->{_source}->{status} eq 'latest' ) {
             log_info { "Downgrading $row->{_source}->{name} to cpan" };
 
-            for (qw(file module dependency)) {
+            for (qw(file dependency)) {
                 log_debug { "Downgrading $_" };
                 $self->reindex( $_, $row->{_id}, 'cpan' );
             }
@@ -79,7 +79,7 @@ sub reindex {
     my $rs = $es->search(%$search);
     while ( my $row = shift @{ $rs->{hits}->{hits} } ) {
         log_debug { $status eq 'latest' ? "Upgrading " : "Downgrading ",
-          $type, " ", $row->{_source}->{name} || $row->{_source}->{module} || '' };
+          $type, " ", $row->{_source}->{name} || '' };
         $es->index( index => 'cpan',
                     type  => $type,
                     id    => $row->{_id},
@@ -106,5 +106,5 @@ __END__
 =head1 DESCRIPTION
 
 After importing releases from cpan, this script will set the status
-to latest on the most recent release, its files, modules and dependencies.
+to latest on the most recent release, its files and dependencies.
 It also makes sure that there is only one latest release per distribution.
diff --git a/lib/MetaCPAN/Script/Release.pm b/lib/MetaCPAN/Script/Release.pm
@@ -96,6 +96,7 @@ sub import_tarball {
     my $at     = Archive::Tar->new($tarball);
     my $tmpdir = dir(File::Temp::tempdir);
     my $d      = CPAN::DistnameInfo->new($tarball);
+    my $date = $self->pkg_datestamp($tarball);
     my ( $author, $archive, $name ) =
       ( $d->cpanid, $d->filename, $d->distvname );
     my $version = MetaCPAN::Util::fix_version( $d->version );
@@ -126,6 +127,7 @@ sub import_tarball {
                     name         => $fname,
                     directory    => $child->is_dir ? 1 : 0,
                     release      => $name,
+                    date => $date,
                     distribution => $meta->name,
                     author       => $author,
                     full_path    => $child->full_path,
@@ -168,7 +170,7 @@ sub import_tarball {
         my $obj = $file_set->put($file);
         $file->{abstract} = $obj->abstract;
         $file->{id}       = $obj->id;
-        $file->{module}   = $obj->module;
+        $file->{module}   = {};
     }
 
     my $create =
@@ -180,7 +182,7 @@ sub import_tarball {
         distribution => $meta->name,
         archive      => $archive,
         maturity     => $d->maturity,
-        date         => $self->pkg_datestamp($tarball), };
+        date         => $date, };
 
     my $release = $cpan->type('release')->put($create);
     
@@ -224,11 +226,8 @@ sub import_tarball {
         while ( my ( $module, $data ) = each %$provides ) {
             my $path = $data->{file};
             my $file = List::Util::first { $_->{path} =~ /\Q$path\E$/ } @files;
-            push( @modules,
-                  {  %$data,
-                     name => $module,
-                     file => $file,
-                  } );
+            $file->{module}->{$module} = $data;
+            push(@modules, $file);
         }
 
     }
@@ -249,35 +248,27 @@ sub import_tarball {
                 $info = Module::Metadata->new_from_file(
                                           $tmpdir->file( $file->{full_path} ) );
             }
-            push( @modules,
-                  {  file => $file,
-                     name => $_,
-                     $info->version
+            $file->{module}->{$_} ||= 
+                  {  $info->version
                      ? ( version => $info->version->numify )
-                     : () } ) for ( $info->packages_inside );
+                     : () } for ( $info->packages_inside );
+            push(@modules, $file);
             alarm(0);
         };
     }
 
     log_debug { "Indexing ", scalar @modules, " modules" };
     $i = 1;
     my $mod_set = $cpan->type('module');
-    foreach my $module (@modules) {
-        my $file = MetaCPAN::Document::File->new( %{$module->{file}}, index => $cpan );
+    foreach my $file (@modules) {
+        my @modules = map { { name => $_, %{$file->{module}->{$_}} } } keys %{$file->{module}};
+        my %module = @modules ? (module => \@modules) : ();
+        delete $file->{module};
+        $file = MetaCPAN::Document::File->new( %$file, %module, index => $cpan );
         $file->clear_indexed;
-        my $obj = $mod_set->put( { %$module,
-                                        file         => $file,
-                                        date         => $release->date,
-                                        release      => $release->name,
-                                        distribution => $release->distribution,
-                                        author       => $release->author,
-                                        maturity     => $d->maturity,
-                                     } );
-        Dlog_trace { "adding module ", $obj->name };
-        Dlog_trace { $_ } $obj->meta->get_data($obj);
-        log_trace { "reindexing file $module->{file}->{path}" };
-        $file->put;
+        log_trace { "reindexing file $file->{path}" };
         Dlog_trace { $_ } $file->meta->get_data($file);
+        $file->put;
     }
     
     $tmpdir->rmtree;
diff --git a/lib/MetaCPAN/Types.pm b/lib/MetaCPAN/Types.pm
@@ -1,19 +1,25 @@
 package MetaCPAN::Types;
 use ElasticSearch;
+use MetaCPAN::Document::Module;
 
 use MooseX::Types -declare => [
     qw(
-      ES
       Logger
       Resources
       Stat
+      Module
       ) ];
 
 use MooseX::Types::Structured qw(Dict Tuple Optional);
-use MooseX::Types::Moose qw/Int Str ArrayRef HashRef Undef/;
+use MooseX::Types::Moose qw/Int Num Str ArrayRef HashRef Undef/;
+use ElasticSearchX::Model::Document::Types qw(:all);
 
 subtype Stat, as Dict [ mode => Int, uid => Int, gid => Int, size => Int, mtime => Int ];
 
+subtype Module, as ArrayRef [ Type [ 'MetaCPAN::Document::Module' ] ];
+coerce Module, from ArrayRef, via { [ map { ref $_ eq 'HASH' ? MetaCPAN::Document::Module->new($_) : $_ } @$_ ] };
+coerce Module, from HashRef, via { [ MetaCPAN::Document::Module->new($_) ] };
+
 subtype Resources,
   as Dict [
         license => Optional [ ArrayRef [Str] ],
@@ -38,27 +44,4 @@ coerce Logger, from ArrayRef, via {
     return MetaCPAN::Role::Common::_build_logger($_);
 };
 
-class_type ES, { class => 'ElasticSearch' };
-coerce ES, from Str, via {
-    my $server = $_;
-    $server = "127.0.0.1$server" if ( $server =~ /^:/ );
-    return
-      ElasticSearch->new( servers   => $server,
-                          transport => 'http',
-                          timeout   => 30, );
-};
-
-coerce ES, from HashRef, via {
-    return ElasticSearch->new(%$_);
-};
-
-coerce ES, from ArrayRef, via {
-    my @servers = @$_;
-    @servers = map { /^:/ ? "127.0.0.1$_" : $_ } @servers;
-    return
-      ElasticSearch->new( servers   => \@servers,
-                          transport => 'http',
-                          timeout   => 30, );
-};
-
 1;
diff --git a/t/document/file.t b/t/document/file.t
@@ -131,13 +131,14 @@ END
                                      release      => 'release',
                                      distribution => 'foo',
                                      name         => 'module.pm',
-                                     module => 'Number::Phone::NANP::AS',
+                                     module => [{ name => 'Number::Phone::NANP::AS', version => 1.1 }],
                                      content_cb   => sub { \$content } );
 
-    is( $file->sloc, 8 );
-    is( $file->slop, 3 );
+    is( $file->sloc, 8, '8 lines of code' );
+    is( $file->slop, 3, '3 lines of pod' );
     is( $file->indexed, 0, 'not indexed' );
-    is_deeply( $file->pod_lines, [ [ 18, 5 ] ] );
+    is_deeply( $file->pod_lines, [ [ 18, 5 ] ], 'correct pod_lines' );
+    is( $file->module->[0]->version_numified, 1.1, 'numified version has been calculated');
 }
 
 done_testing;
diff --git a/t/document/module.t b/t/document/module.t
diff --git a/t/script/release/amon2.t b/t/script/release/amon2.t

Original file line number	Diff line number	Diff line change
`@@ -5,6 +5,7 @@ use ElasticSearch;`
`5`	`5`	`use Log::Contextual qw( set_logger :dlog );`
`6`	`6`	`use Log::Log4perl ':easy';`
`7`	`7`	`use MetaCPAN::Types qw(:all);`
	`8`	`+use ElasticSearchX::Model::Document::Types qw(:all);`
`8`	`9`	`use MetaCPAN::Model;`
`9`	`10`
`10`	`11`	`has 'cpan' => ( is => 'rw',`
`@@ -72,7 +73,7 @@ sub _build_cpan {`
`72`	`73`	`}`
`73`	`74`
`74`	`75`	`sub remote {`
`75`		`- shift->es->transport->servers->[0];`
	`76`	`+ shift->es->transport->default_servers->[0];`
`76`	`77`	`}`
`77`	`78`
`78`	`79`	`sub run { }`