Merge pull request #17 from Troglodyne-Internet-Widgets/require-loggers

Load each logger that the configuration names before using it

Makefile.PL

@@ -36,6 +36,7 @@ WriteMakefile(
         "Linux::Perl::inotify" => "0",
         "List::Util" => "0",
         "Log::Dispatch" => "0",
+        "Module::Runtime" => "0",
         "Log::Dispatch::FileRotate" => "0",
         "Log::Dispatch::Screen" => "0",
         "Mojo::File" => "0",
@@ -51,6 +52,7 @@ WriteMakefile(
     TEST_REQUIRES => {
         "File::Temp" => "0",
         "Test2::V0"  => "0",
+        "Test2::Plugin::NoWarnings" => "0",
     },
     test => {TESTS => 't/*.t'}
 );

Readme.md

@@ -23,7 +23,7 @@ Obeys ~/.tpsgi.ini -- this is what will control all the custom aspects mentioned
     custom_log  : Custom location for default (rotated) log
     routers     : Router module(s), separate with comma.  Relative to TPSGI install dir.
     indices     : Dirindex files.  In addition to index.html, index.htm, index.cgi
-    loggers     : Logger module(s), separate with comma
+    loggers     : Logger module(s), separate with comma.  Each is a Log::Dispatch::Output class.  tPSGI loads it by name, so it can live beside a router
     auth        : Authentication module
     domain      : Domain name of the application, used by things like service files
     basedir     : Directory you want to chdir into on startup. Relative to TPSGI install dir.  Default '.'

bin/tpsgi

@@ -23,7 +23,7 @@ tpsgi obeys a config file, ~/.tpsgi.ini which is in Config::Simple (key=value) f
     custom_log  # Custom location for default (rotated) log
     routers     # Router module(s), separate with comma.  Relative to TPSGI install dir.
     indices     # Dirindex files.  In addition to index.html, index.htm, index.cgi
-    loggers     # Logger module(s), separate with comma
+    loggers     # Logger module(s), separate with comma.  Loaded by name, from beside a router or @INC
     auth        # Authentication module
     domain      # Domain name of the application, used by things like service files
     basedir     # Directory you want to chdir into on startup. Relative to TPSGI install dir.  Default '.'

lib/TPSGI.pm

@@ -35,6 +35,7 @@ use File::Copy;
 use Cwd qw{abs_path};
 
 use File::Basename qw{dirname basename};
+use Module::Runtime();
 use Log::Dispatch;
 use Log::Dispatch::Screen;
 use Log::Dispatch::FileRotate;
@@ -92,7 +93,11 @@ sub log {
     my $self = shift;
 
     state $log;
-    return $log if $log;
+    return $log //= $self->_build_log();
+}
+
+sub _build_log {
+    my $self = shift;
 
     my $LOGNAME = $self->{log_name};
     my $LOGDIR  = $self->{log_dir};
@@ -119,11 +124,14 @@ sub log {
         min_level => $LEVEL,
     );
 
-    $log = Log::Dispatch->new();
+    my $log = Log::Dispatch->new();
     $log->add($rotate);
     $log->add($screen);
+
+    # The first line is logged while new() is still loading the routers, so a
+    # logger that an application ships beside its router is not loaded yet.
     foreach my $logger ( @{ $self->{loggers} } ) {
-        $log->add( $logger->new( min_level => $LEVEL, log_dir => $LOGDIR ) );
+        $log->add( Module::Runtime::use_module($logger)->new( min_level => $LEVEL, log_dir => $LOGDIR ) );
     }
 
     $log->info( $self->_log("Opening Log $LOGNAME at $LEVEL level") );

t/loggers.t

@@ -0,0 +1,75 @@
+use strict;
+use warnings;
+
+use Test2::V0;
+use Test2::Plugin::NoWarnings;
+
+use Cwd            qw{abs_path};
+use File::Path     qw{make_path};
+use File::Temp     qw{tempdir};
+use File::Basename qw{dirname};
+
+use lib dirname( abs_path(__FILE__) ) . '/../lib';
+
+use TPSGI;
+
+# A logger named in the configuration is a class that nothing has loaded yet.
+# An application ships it beside its router, and TPSGI logs its first line
+# while it is still loading that router.
+my $dir = tempdir( CLEANUP => 1 );
+my $lib = "$dir/lib";
+make_path("$lib/Test/Logger");
+
+open( my $fh, '>', "$lib/Test/Logger/Capture.pm" ) or die "Cannot write the test logger: $!";
+print $fh <<'LOGGER';
+package Test::Logger::Capture;
+use strict;
+use warnings;
+use parent qw{Log::Dispatch::Output};
+
+our @lines;
+our %given;
+
+sub new {
+    my ( $class, %p ) = @_;
+    %given = %p;
+    my $self = bless {}, $class;
+    $self->_basic_init( name => 'capture', min_level => $p{min_level} );
+    return $self;
+}
+
+sub log_message {
+    my ( $self, %p ) = @_;
+    push( @lines, $p{message} );
+    return;
+}
+
+1;
+LOGGER
+close($fh);
+
+push( @INC, $lib );
+
+my $tpsgi = bless(
+    {
+        log_name => "$dir/tpsgi.log",
+        log_dir  => $dir,
+        verbose  => 0,
+        loggers  => ['Test::Logger::Capture'],
+        ip       => '0.0.0.0',
+    },
+    'TPSGI'
+);
+
+ok( lives { $tpsgi->log }, 'a logger class that nothing loaded is loaded by name' ) or note $@;
+
+no warnings 'once';
+is( $Test::Logger::Capture::given{log_dir},   $dir,   'it is handed the log directory' );
+is( $Test::Logger::Capture::given{min_level}, 'info', 'and the level' );
+like( \@Test::Logger::Capture::lines, [qr/Opening Log/], 'and it receives the lines that the file gets' );
+
+# The name becomes a path to load, so only a module name is one.
+my $refusing = bless( { %$tpsgi, loggers => ['../../etc/passwd'] }, 'TPSGI' );
+like( dies { TPSGI::_build_log($refusing) }, qr/not a module name/, 'a logger that is not a module name is refused' );
+
+done_testing();