Merge pull request #497 from CPAN-API/topic/permalinks

improve link choices for in-dist modules/pod
metacpan · Jun 20, 2016 · 8469888 · 8469888
2 parents b67d768 + 90c992f
commit 8469888
Show file tree

Hide file tree

Showing 2 changed files with 82 additions and 63 deletions.
diff --git a/lib/MetaCPAN/Document/File/Set.pm b/lib/MetaCPAN/Document/File/Set.pm
@@ -95,6 +95,46 @@ sub find_provided_by {
     )->size(999)->all;
 }
 
+sub documented_modules {
+    my ( $self, $release ) = @_;
+    return $self->filter(
+        {
+            and => [
+                { term => { release => $release->{name} } },
+                { term => { author  => $release->{author} } },
+                {
+                    or => [
+                        {
+                            and => [
+                                {
+                                    exists => {
+                                        field => 'module.name',
+                                    }
+                                },
+                                {
+                                    term => {
+                                        'module.indexed' => 1
+                                    }
+                                },
+                            ]
+                        },
+                        {
+                            and => [
+                                {
+                                    exists => {
+                                        field => 'pod.analyzed',
+                                    }
+                                },
+                                { term => { indexed => 1 } },
+                            ]
+                        },
+                    ]
+                },
+            ],
+        }
+    )->size(999);
+}
+
 # filter find_provided_by results for indexed/authorized modules
 # and return a list of package names
 sub find_module_names_provided_by {

diff --git a/lib/MetaCPAN/Server/Controller/Source.pm b/lib/MetaCPAN/Server/Controller/Source.pm
@@ -32,69 +32,9 @@ sub get : Chained('index') : PathPart('') : Args {
         $c->res->body( $res->[2]->[0] );
     }
     else {
-        my $permalinks = $c->req->query_params->{permalinks};
-        my $links      = {};
-        my $modules    = $c->model('CPAN::File')->raw->filter(
-            {
-                and => [
-                    { term => { release => $release } },
-                    { term => { author  => $author } },
-                    {
-                        or => [
-                            {
-                                and => [
-                                    {
-                                        exists => {
-                                            field => 'module.name',
-                                        }
-                                    },
-                                    {
-                                        term => {
-                                            'module.indexed' => 1
-                                        }
-                                    },
-                                ]
-                            },
-                            {
-                                and => [
-                                    {
-                                        exists => {
-                                            field => 'pod.analyzed',
-                                        }
-                                    },
-                                    { term => { indexed => 1 } },
-                                ]
-                            },
-                        ]
-                    },
-                ],
-            }
-            )->fields( [qw( module.name path documentation distribution )] )
-            ->size(5000)->all->{hits}->{hits};
-        for my $file ( map { $_->{fields} } @$modules ) {
-            my $name = $file->{documentation} or next;
-            my ($module)
-                = grep { $_->{name} eq $name } @{ $file->{module} };
-
-            if ($permalinks) {
-                $links->{$name}
-                    = 'release/'
-                    . ( ( $module && $module->{associated_pod} )
-                        || "$author/$release/$file->{path}" );
-            }
-            elsif ( !$module ) {
-                $links->{$name}
-                    = "distribution/$file->{distribution}/$file->{path}";
-            }
-            elsif ( !$module->{authorized} || !$module->{indexed} ) {
-                $links->{$name} = 'release/' . (
-                    $module->{associated_pod}
-
-                        || "$author/$release/$file->{path}"
-                );
-            }
-        }
-        $c->stash->{link_mappings} = $links;
+        $c->stash->{link_mappings}
+            = $self->find_dist_links( $c, $author, $release,
+            !!$c->req->query_params->{permalinks} );
 
         $c->stash->{path} = $file;
 
@@ -112,6 +52,45 @@ sub get : Chained('index') : PathPart('') : Args {
     }
 }
 
+sub find_dist_links {
+    my ( $self, $c, $author, $release, $permalinks ) = @_;
+    my $module_query
+        = $c->model('CPAN::File')
+        ->documented_modules( { name => $release, author => $author } )
+        ->source( [qw(name module path documentation distribution)] );
+    my @modules = $module_query->all;
+
+    my $links = {};
+
+    for my $file (@modules) {
+        next
+            unless $file->has_documentation;
+        my $name = $file->documentation;
+        my ($module)
+            = grep { $_->name eq $name } @{ $file->module };
+        if ( $module && $module->authorized && $module->indexed ) {
+            if ($permalinks) {
+                $links->{$name} = join '/',
+                    'release', $author, $release, $file->path;
+            }
+            else {
+                $links->{$name} = $name;
+            }
+        }
+        next
+            if exists $links->{$name};
+        if ($permalinks) {
+            $links->{$name} = join '/',
+                'release', $author, $release, $file->path;
+        }
+        else {
+            $links->{$name} = join '/',
+                'distribution', $file->distribution, $file->path;
+        }
+    }
+    return $links;
+}
+
 sub module : Chained('index') : PathPart('') : Args(1) {
     my ( $self, $c, $module ) = @_;
     $module = $c->model('CPAN::File')->find($module)