The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package CLIDTestClass::Log::Basic;

use strict;
use warnings;
use Test::Classy::Base;
use Try::Tiny;

sub initialize {
  my $class = shift;
  try   { require IO::Capture::Stderr }
  catch { $class->skip_this_class('this test requires IO::Capture') };
}

sub no_args : Test {
  my $class = shift;

  my $ret = $class->dispatch();

  is $ret => '', $class->message("don't log unless verbose");
}

sub verbose : Test(4) {
  my $class = shift;

  my $ret = $class->dispatch(qw/-v/);

  unlike $ret => qr/\[debug\] debug/, $class->message("no debug log");
  like   $ret => qr/\[info\] info/, $class->message("log info");
  like   $ret => qr/\[warn\] warn/, $class->message("log warn");
  like   $ret => qr/\[error\] error/, $class->message("log error");
}

sub debug : Test(4) {
  my $class = shift;

  my $ret = $class->dispatch(qw/--debug/);

  like $ret => qr/\[debug\] debug/, $class->message("debug log");
  like $ret => qr/\[info\] info/, $class->message("log info");
  like $ret => qr/\[warn\] warn/, $class->message("log warn");
  like $ret => qr/\[error\] error/, $class->message("log error");
}

sub logfilter : Test(4) {
  my $class = shift;

  my $ret = $class->dispatch("--logfilter=info,error");

  unlike $ret => qr/\[debug\] debug/, $class->message("no debug log");
  like $ret => qr/\[info\] info/, $class->message("log info");
  unlike $ret => qr/\[warn\] warn/, $class->message("no log warn");
  like $ret => qr/\[error\] error/, $class->message("log error");
}

sub dispatch {
  my $class = shift;

  local @ARGV = @_;

  my $capture = IO::Capture::Stderr->new;

  my $ret;
  $capture->start;
  try   { $ret = CLIDTest::Log::DumpMe->run_directly }
  catch { $ret = $_ || 'Obscure error' };
  $capture->stop;

  my $log = join "\n", $capture->read;

  return $ret eq 'ok' ? $log : $ret;
}

1;