The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#-*- mode: perl;-*-

use strict;
# use warnings;

# WARNING: This test will write 7*NUM_ROUNDS events to the Windows NT
# event log.  (We test multiple rounds to verify that we are reading
# the record for that specific round.)

use constant NUM_ROUNDS => 2;

use constant SOURCE     => "Win32EventLogCarp RegTest";
use constant LOG        => "System";

BEGIN {

  eval {
    require Win32::EventLog::Message;
    import Win32::EventLog::Message;
  };

  my $has_it = ($@) ? 0 : 1;

  my $mode   = ($has_it) ? "tests => 12+(25*NUM_ROUNDS)"
    : "skip_all => \"Win32::EventLog::Message not found\"";
  
  eval "use Test::More $mode;";
}

use File::Spec;
use Win32;

my $hnd;
my ($cnt1, $cnt2, $cnt3);

sub open_log {
  $hnd = new Win32::EventLog(LOG, Win32::NodeName);
}

sub close_log {
  if ($hnd) { $hnd->Close; }
  $hnd = undef;
}

sub get_number {
  my $cnt = -1;
  $hnd->GetNumber($cnt);
  return $cnt;
}


sub get_last_event {
  my $event = { };
  if ($hnd->Read(
    EVENTLOG_BACKWARDS_READ() | EVENTLOG_SEQUENTIAL_READ(), 0, $event)) {
    return $event;
  } else {
    diag( "WARNING: Unable to read event log" );
    return;
  }
}


BEGIN {
  ok( Win32::IsWinNT(), "Win32::IsWinNT?" );
  use_ok('Win32::EventLog');

  ok($Win32::EventLog::GetMessageText = 1,
     "Set Win32::EventLog::GetMessageText");

  open_log();

  ok(defined $hnd, "EventLog Handle defined");

  # We need to verify that the just loading Win32::EventLog::Carp does
  # not cause errors or warnings that add tothe event log!

  $cnt1 = get_number();
  ok(defined $cnt1, "Get size of event log");

  use_ok('Win32::EventLog::Carp', { Source => SOURCE, Register => LOG, } );

  ok(!$Win32::EventLog::Carp::LogEvals, "Check LogEvals");
  $Win32::EventLog::Carp::LogEvals = 1;
  ok($Win32::EventLog::Carp::LogEvals,  "Set LogEvals");


  $cnt2 = get_number();
  ok(defined $cnt2, "Get size of event log");

  is($cnt2, $cnt1, "Check against rt.cpan.org issue \x235408");
};


my %Events = ( );

my $time = time();

for my $tag (1..NUM_ROUNDS) {
  $cnt1 = $cnt2;

  Win32::EventLog::Carp::click "test,click,$tag,$time";

  $cnt2 = get_number();
  ok(defined $cnt2, "Get size of event log");
  {
    local $TODO = "log size might be maxed out";
    cmp_ok($cnt2, '>', $cnt1, "Event log grown from click");
  }
  $Events{"click,$tag,$time"} = EVENTLOG_INFORMATION_TYPE;

  $cnt1 = $cnt2;

  warn "test,warn,$tag,$time";

  $cnt2 = get_number();
  ok(defined $cnt2, "Get size of event log");
  {
    local $TODO = "log size might be maxed out";
    cmp_ok($cnt2, '>', $cnt1, "Event log grown from warn");
  }
  $Events{"warn,$tag,$time"} = EVENTLOG_WARNING_TYPE;

  $cnt1 = $cnt2;

  carp "test,carp,$tag,$time";

  $cnt2 = get_number();
  ok(defined $cnt2, "Get size of event log");
  {
    local $TODO = "log size might be maxed out";
    cmp_ok($cnt2, '>', $cnt1, "Event log grown from carp");
  }
  $Events{"carp,$tag,$time"} = EVENTLOG_WARNING_TYPE;

  $cnt1 = $cnt2;

  Win32::EventLog::Carp::cluck "test,cluck,$tag,$time";

  $cnt2 = get_number();
  ok(defined $cnt2, "Get size of event log");
  {
    local $TODO = "log size might be maxed out";
    cmp_ok($cnt2, '>', $cnt1, "Event log grown from cluck");
  }
  $Events{"cluck,$tag,$time"} = EVENTLOG_WARNING_TYPE;

  $cnt1 = $cnt2;
  $Win32::EventLog::Carp::LogEvals = 0;
  ok(!$Win32::EventLog::Carp::LogEvals, "Unset LogEval");
  eval {
    die "test,evaldie,$tag,$time";
  };

  $cnt2 = get_number();
  ok(defined $cnt2, "Get size of event log");
  is($cnt2, $cnt1, "Event log did not grow from eval die");

  $cnt1 = $cnt2;
  $Win32::EventLog::Carp::LogEvals = 1;
  ok($Win32::EventLog::Carp::LogEvals, "Set LogEval");
  eval {
    die "test,die,$tag,$time";
  };

  $cnt2 = get_number();
  ok(defined $cnt2, "Get size of event log");
  {
    local $TODO = "log size might be maxed out";
    cmp_ok($cnt2, '>', $cnt1, "Event log grown from die");
  }
  $Events{"die,$tag,$time"} = EVENTLOG_ERROR_TYPE;

  $cnt1 = $cnt2;
  eval {
    croak "test,croak,$tag,$time";
  };

  $cnt2 = get_number();
  ok(defined $cnt2, "Get size of event log");
  {
    local $TODO = "log size might be maxed out";
    cmp_ok($cnt2, '>', $cnt1, "Event log grown from croak");
  }
  $Events{"croak,$tag,$time"} = EVENTLOG_ERROR_TYPE;

  $cnt1 = $cnt2;
  eval {
    confess "test,confess,$tag,$time";
  };

  $cnt2 = get_number();
  ok(defined $cnt2, "Get size of event log");
  {
    local $TODO = "log size might be maxed out";
    cmp_ok($cnt2, '>', $cnt1, "Event log grown from confess");
  }
  $Events{"confess,$tag,$time"} = EVENTLOG_ERROR_TYPE;
}

# In order to verify all of the events, we read through the event log
# until we've found all the tests that we saved for verification.  We
# do this because another application might have written to the event
# log while the tests were running.

# use YAML 'Dump';

open_log();

{

  ok((keys %Events) == (7*NUM_ROUNDS), "Events stacked to verify");

  my $pathname = File::Spec->rel2abs($0);
  my $filename = $0;
  $filename =~ s/\\/\\\\/g; # escape backslashes


    while ((keys %Events) && (my $event = get_last_event())) {

#    print STDERR YAML->Dump($event);

      my $string = $event->{Strings};

      if ( ($string =~ /$filename\: test\,(\w+)\,(\d+),(\d+) at $filename/) &&
           ($event->{Source} eq SOURCE) ) {
        if( $3 == $time) {
          my $key = "$1,$2,$3";
          is((delete $Events{$key}), $event->{EventType},
             "verified event $key");
        }
      }
      else {
         exists $ENV{PERL_WIN32_EVENTLOG_CARP_TEST_VERBOSE}
            and diag "Ignoring event: $string";
      }
      
  }

  is((keys %Events), 0, "All events verified");
}



END {
  close_log();

  eval {
    Win32::EventLog::Message::UnRegisterSource(
      LOG, SOURCE
    );
  };

}

__END__