Merge branch 'refactor/Role-Common' into indexing

MetaCPAN::Role::Logger is needed to test MetaCPAN::Model::Tarball alone.
metacpan · Feb 16, 2015 · 2ab33ac · 2ab33ac
2 parents 5fa1b4f + bd8ed9b
commit 2ab33ac
Show file tree

Hide file tree

Showing 22 changed files with 97 additions and 76 deletions.
diff --git a/lib/MetaCPAN/Role/Logger.pm b/lib/MetaCPAN/Role/Logger.pm
@@ -0,0 +1,72 @@
+package MetaCPAN::Role::Logger;
+
+use v5.10;
+use Moose::Role;
+use MetaCPAN::Types qw(:all);
+use Log::Contextual qw( set_logger );
+use Log::Log4perl ':easy';
+use Path::Class ();
+
+has level => (
+    is            => 'ro',
+    isa           => 'Str',
+    required      => 1,
+    trigger       => \&set_level,
+    documentation => 'Log level',
+);
+
+has logger => (
+    is        => 'ro',
+    required  => 1,
+    isa       => Logger,
+    coerce    => 1,
+    predicate => 'has_logger',
+    traits    => ['NoGetopt'],
+);
+
+sub set_level {
+    my $self = shift;
+    $self->logger->level(
+        Log::Log4perl::Level::to_priority( uc( $self->level ) ) );
+}
+
+# NOTE: This makes the test suite print "mapping" regardless of which
+# script class is actually running (the category only gets set once)
+# but Log::Contextual gets mad if you call set_logger more than once.
+sub set_logger_once {
+    state $logger_set = 0;
+    return if $logger_set;
+
+    my $self = shift;
+
+    set_logger $self->logger;
+
+    $logger_set = 1;
+
+    return;
+}
+
+# XXX NOT A MOOSE BUILDER
+# XXX This doesn't belong here.
+sub _build_logger {
+    my ($config) = @_;
+    my $log = Log::Log4perl->get_logger( $ARGV[0] );
+    foreach my $c (@$config) {
+        my $layout = Log::Log4perl::Layout::PatternLayout->new( $c->{layout}
+                || "%d %p{1} %c: %m{chomp}%n" );
+
+        if ( $c->{class} =~ /Appender::File$/ && $c->{filename} ) {
+
+            # Create the log file's parent directory if necessary.
+            Path::Class::File->new( $c->{filename} )->parent->mkpath;
+        }
+
+        my $app = Log::Log4perl::Appender->new( $c->{class}, %$c );
+
+        $app->layout($layout);
+        $log->add_appender($app);
+    }
+    return $log;
+}
+
+1;
diff --git a/lib/MetaCPAN/Role/Common.pm → lib/MetaCPAN/Role/Script.pm b/lib/MetaCPAN/Role/Common.pm → lib/MetaCPAN/Role/Script.pm
@@ -1,18 +1,18 @@
-package MetaCPAN::Role::Common;
+package MetaCPAN::Role::Script;
 
 use strict;
 use warnings;
 
 use ElasticSearch;
 use ElasticSearchX::Model::Document::Types qw(:all);
 use FindBin;
-use Log::Contextual qw( set_logger :dlog );
-use Log::Log4perl ':easy';
+use Log::Contextual qw( :dlog );
 use MetaCPAN::Model;
 use MetaCPAN::Types qw(:all);
 use Moose::Role;
 use MooseX::Types::Path::Class qw(:all);
-use Path::Class ();
+
+with 'MetaCPAN::Role::Logger';
 
 has 'cpan' => (
     is         => 'rw',
@@ -23,14 +23,6 @@ has 'cpan' => (
         'Location of a local CPAN mirror, looks for $ENV{MINICPAN} and ~/CPAN',
 );
 
-has level => (
-    is            => 'ro',
-    isa           => 'Str',
-    required      => 1,
-    trigger       => \&set_level,
-    documentation => 'Log level',
-);
-
 has es => (
     isa           => ES,
     is            => 'ro',
@@ -56,15 +48,6 @@ has port => (
     documentation => 'Port for the proxy, defaults to 5000',
 );
 
-has logger => (
-    is        => 'ro',
-    required  => 1,
-    isa       => Logger,
-    coerce    => 1,
-    predicate => 'has_logger',
-    traits    => ['NoGetopt'],
-);
-
 has home => (
     is      => 'ro',
     isa     => Dir,
@@ -92,39 +75,11 @@ sub index {
     return $self->model->index( $self->_index );
 }
 
-sub set_level {
-    my $self = shift;
-    $self->logger->level(
-        Log::Log4perl::Level::to_priority( uc( $self->level ) ) );
-}
-
 sub _build_model {
     my $self = shift;
     return MetaCPAN::Model->new( es => $self->es );
 }
 
-# NOT A MOOSE BUILDER
-sub _build_logger {
-    my ($config) = @_;
-    my $log = Log::Log4perl->get_logger( $ARGV[0] );
-    foreach my $c (@$config) {
-        my $layout = Log::Log4perl::Layout::PatternLayout->new( $c->{layout}
-                || "%d %p{1} %c: %m{chomp}%n" );
-
-        if ( $c->{class} =~ /Appender::File$/ && $c->{filename} ) {
-
-            # Create the log file's parent directory if necessary.
-            Path::Class::File->new( $c->{filename} )->parent->mkpath;
-        }
-
-        my $app = Log::Log4perl::Appender->new( $c->{class}, %$c );
-
-        $app->layout($layout);
-        $log->add_appender($app);
-    }
-    return $log;
-}
-
 sub file2mod {
     my $self = shift;
     my $name = shift;
@@ -158,13 +113,7 @@ sub run { }
 before run => sub {
     my $self = shift;
 
-    # NOTE: This makes the test suite print "mapping" regardless of which
-    # script class is actually running (the category only gets set once)
-    # but Log::Contextual gets mad if you call set_logger more than once.
-    unless ($MetaCPAN::Role::Common::log) {
-        $MetaCPAN::Role::Common::log = $self->logger;
-        set_logger $self->logger;
-    }
+    $self->set_logger_once;
 
     Dlog_debug {"Connected to $_"} $self->remote;
 };

diff --git a/lib/MetaCPAN/Script/Author.pm b/lib/MetaCPAN/Script/Author.pm
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 
 use Moose;
-with 'MooseX::Getopt', 'MetaCPAN::Role::Common';
+with 'MooseX::Getopt', 'MetaCPAN::Role::Script';
 
 use DateTime::Format::ISO8601 ();
 use Email::Valid              ();

diff --git a/lib/MetaCPAN/Script/Backpan.pm b/lib/MetaCPAN/Script/Backpan.pm
@@ -6,7 +6,7 @@ use warnings;
 use BackPAN::Index;
 use Moose;
 
-with 'MetaCPAN::Role::Common', 'MooseX::Getopt::Dashes';
+with 'MetaCPAN::Role::Script', 'MooseX::Getopt::Dashes';
 
 sub run {
     my $self = shift;

diff --git a/lib/MetaCPAN/Script/Backup.pm b/lib/MetaCPAN/Script/Backup.pm
@@ -14,7 +14,7 @@ use Moose;
 use MooseX::Types::Path::Class qw(:all);
 use Try::Tiny;
 
-with 'MetaCPAN::Role::Common', 'MooseX::Getopt::Dashes';
+with 'MetaCPAN::Role::Script', 'MooseX::Getopt::Dashes';
 
 has batch_size => (
     is      => 'ro',

diff --git a/lib/MetaCPAN/Script/CPANTesters.pm b/lib/MetaCPAN/Script/CPANTesters.pm
@@ -12,7 +12,7 @@ use LWP::UserAgent ();
 use Log::Contextual qw( :log :dlog );
 use Moose;
 
-with 'MetaCPAN::Role::Common', 'MooseX::Getopt';
+with 'MetaCPAN::Role::Script', 'MooseX::Getopt';
 
 has db => (
     is      => 'ro',

diff --git a/lib/MetaCPAN/Script/Check.pm b/lib/MetaCPAN/Script/Check.pm
@@ -8,7 +8,7 @@ use File::Spec::Functions qw(catfile);
 use Log::Contextual qw( :log );
 use Moose;
 
-with 'MetaCPAN::Role::Common', 'MooseX::Getopt';
+with 'MetaCPAN::Role::Script', 'MooseX::Getopt';
 
 has modules => (
     is            => 'ro',

diff --git a/lib/MetaCPAN/Script/First.pm b/lib/MetaCPAN/Script/First.pm
@@ -6,7 +6,7 @@ use warnings;
 use Log::Contextual qw( :log );
 use Moose;
 
-with 'MetaCPAN::Role::Common', 'MooseX::Getopt';
+with 'MetaCPAN::Role::Script', 'MooseX::Getopt';
 
 has distribution => (
     is            => 'rw',

diff --git a/lib/MetaCPAN/Script/Latest.pm b/lib/MetaCPAN/Script/Latest.pm
@@ -10,7 +10,7 @@ use Parse::CPAN::Packages::Fast;
 use Regexp::Common qw(time);
 use Time::Local;
 
-with 'MetaCPAN::Role::Common', 'MooseX::Getopt';
+with 'MetaCPAN::Role::Script', 'MooseX::Getopt';
 
 has dry_run => (
     is      => 'ro',

diff --git a/lib/MetaCPAN/Script/Mapping.pm b/lib/MetaCPAN/Script/Mapping.pm
@@ -6,7 +6,7 @@ use warnings;
 use Log::Contextual qw( :log );
 use Moose;
 
-with 'MetaCPAN::Role::Common', 'MooseX::Getopt';
+with 'MetaCPAN::Role::Script', 'MooseX::Getopt';
 
 has delete => (
     is            => 'ro',

diff --git a/lib/MetaCPAN/Script/Mirrors.pm b/lib/MetaCPAN/Script/Mirrors.pm
@@ -9,7 +9,7 @@ use Log::Contextual qw( :log :dlog );
 use MetaCPAN::Document::Mirror;
 use Moose;
 
-with 'MetaCPAN::Role::Common', 'MooseX::Getopt';
+with 'MetaCPAN::Role::Script', 'MooseX::Getopt';
 
 sub run {
     my $self = shift;

diff --git a/lib/MetaCPAN/Script/Pagerank.pm b/lib/MetaCPAN/Script/Pagerank.pm
@@ -7,7 +7,7 @@ use Graph::Centrality::Pagerank;
 use Log::Contextual qw( :log );
 use Moose;
 
-with 'MetaCPAN::Role::Common', 'MooseX::Getopt';
+with 'MetaCPAN::Role::Script', 'MooseX::Getopt';
 
 sub run {
     my $self = shift;

diff --git a/lib/MetaCPAN/Script/PerlMongers.pm b/lib/MetaCPAN/Script/PerlMongers.pm
@@ -11,7 +11,7 @@ use WWW::Mechanize::Cached;
 use WWW::Mechanize;
 use XML::Simple;
 
-with 'MetaCPAN::Role::Common';
+with 'MetaCPAN::Role::Script';
 
 sub index_perlmongers {
 

diff --git a/lib/MetaCPAN/Script/Query.pm b/lib/MetaCPAN/Script/Query.pm
@@ -9,7 +9,7 @@ use Moose;
 use MooseX::Aliases;
 use YAML::Syck qw(Dump);
 
-with 'MetaCPAN::Role::Common', 'MooseX::Getopt';
+with 'MetaCPAN::Role::Script', 'MooseX::Getopt';
 
 $YAML::Syck::SortKeys = $YAML::Syck::Headless = $YAML::Syck::ImplicitTyping
     = $YAML::Syck::UseCode = 1;

diff --git a/lib/MetaCPAN/Script/Ratings.pm b/lib/MetaCPAN/Script/Ratings.pm
@@ -10,7 +10,7 @@ use Log::Contextual qw( :log :dlog );
 use Moose;
 use Parse::CSV ();
 
-with 'MetaCPAN::Role::Common', 'MooseX::Getopt';
+with 'MetaCPAN::Role::Script', 'MooseX::Getopt';
 
 has ratings => (
     is      => 'ro',

diff --git a/lib/MetaCPAN/Script/ReindexDist.pm b/lib/MetaCPAN/Script/ReindexDist.pm
@@ -7,7 +7,7 @@ use warnings;
 
 use Moose;
 
-with 'MetaCPAN::Role::Common', 'MooseX::Getopt';
+with 'MetaCPAN::Role::Script', 'MooseX::Getopt';
 
 has distribution => (
     is         => 'ro',

diff --git a/lib/MetaCPAN/Script/Release.pm b/lib/MetaCPAN/Script/Release.pm
@@ -28,7 +28,7 @@ use PAUSE::Permissions;
 use PerlIO::gzip;
 use Try::Tiny;
 
-with 'MetaCPAN::Role::Common', 'MooseX::Getopt';
+with 'MetaCPAN::Role::Script', 'MooseX::Getopt';
 
 has latest => (
     is            => 'ro',

diff --git a/lib/MetaCPAN/Script/Restart.pm b/lib/MetaCPAN/Script/Restart.pm
@@ -5,7 +5,7 @@ use warnings;
 
 use Moose;
 
-with 'MetaCPAN::Role::Common', 'MooseX::Getopt';
+with 'MetaCPAN::Role::Script', 'MooseX::Getopt';
 
 sub run {
     shift->es->restart(

diff --git a/lib/MetaCPAN/Script/Session.pm b/lib/MetaCPAN/Script/Session.pm
@@ -6,7 +6,7 @@ use warnings;
 use DateTime;
 use Moose;
 
-with 'MetaCPAN::Role::Common', 'MooseX::Getopt';
+with 'MetaCPAN::Role::Script', 'MooseX::Getopt';
 
 sub run {
     my $self = shift;

diff --git a/lib/MetaCPAN/Script/Tickets.pm b/lib/MetaCPAN/Script/Tickets.pm
@@ -14,7 +14,7 @@ use Moose;
 use Parse::CSV;
 use Pithub;
 
-with 'MetaCPAN::Role::Common', 'MooseX::Getopt';
+with 'MetaCPAN::Role::Script', 'MooseX::Getopt';
 
 has rt_summary_url => (
     is       => 'ro',

diff --git a/lib/MetaCPAN/Script/Watcher.pm b/lib/MetaCPAN/Script/Watcher.pm
@@ -9,7 +9,7 @@ use Log::Contextual qw( :log );
 use MetaCPAN::Util;
 use Moose;
 
-with 'MetaCPAN::Role::Common', 'MooseX::Getopt';
+with 'MetaCPAN::Role::Script', 'MooseX::Getopt';
 
 has backpan => (
     is            => 'ro',

diff --git a/lib/MetaCPAN/Types/Internal.pm b/lib/MetaCPAN/Types/Internal.pm
@@ -148,7 +148,7 @@ coerce HashRef, from 'CPAN::Meta', via {
 
 class_type Logger, { class => 'Log::Log4perl::Logger' };
 coerce Logger, from ArrayRef, via {
-    return MetaCPAN::Role::Common::_build_logger($_);
+    return MetaCPAN::Role::Logger::_build_logger($_);
 };
 
 MooseX::Getopt::OptionTypeMap->add_option_type_to_map(