#!/usr/bin/env perl

use 5.008001;

use strict;
use warnings;

use Getopt::Long 2.33;
use Pod::Usage;
use Scalar::Util qw{ looks_like_number };
use Test2::V0;
use Test2::Tools::EventDumper;
use Test2::Tools::LoadModule;

our $VERSION = '0.003';

my %opt;

GetOptions( \%opt,
    qw{ context! diagnostic|skip=s@ import=s@ name=s version=s },
    help => sub { pod2usage( { -verbose => 2 } ) },
)
    and @ARGV
    and $ARGV[0] =~ m/ \A [[:alpha:]] /smx
    or pod2usage( { -verbose => 0 } );

my ( $code, $tplt );
my ( $sub_name, @arg ) = @ARGV;
if ( $opt{context} ) {
    require Test2::API;
    require Test2::API::Context;
    my $method = Test2::API::Context->can( $sub_name )
	or pod2usage( {
	-message	=> "Test2::API::Context->$sub_name() not found",
	-verbose	=> 0,
    } );
    $tplt = "# \$ctx->%s( %s );\n";
    $code = sub {
	my @arg = @_;
	my $released;
	my $ctx = Test2::API::context(
	    on_release	=> sub { $released = 1 },
	);
	my $code = __PACKAGE__->can( "_call__context__$sub_name" ) ||
	    \&_call__context__;
	$code->( $method, $ctx, @arg );
	$released
	    or $ctx->release();
    };
} elsif ( $code = Test2::Tools::LoadModule->can( $sub_name ) ) {
    defined $arg[0]
	or die "Module name required\n";
    $opt{import}
	and @{ $opt{import} } = grep { $_ ne '[]' } @{ $opt{import} };
    push @arg, $opt{$_} for qw{ version import };
} else {
    $code = __PACKAGE__->can( $sub_name )
	or pod2usage( {
	    -message	=> "$sub_name() not found",
	    -verbose	=> 0,
	} );
}

$tplt ||= "# %s %s;\n";

push @arg, $opt{name};
$opt{diagnostic}
    and push @arg, @{ $opt{diagnostic} };

pop @arg while @arg && ! defined $arg[-1];

printf $tplt, $sub_name, join ', ', map { _quote_value( $_ ) } @arg;

my $events = intercept {
    SKIP: {
	$code->( @arg );
    }
};

print dump_events $events;

sub _call__context__ {
    my ( $method, $ctx, @arg ) = @_;
    $method->( $ctx, @arg );
    return;
}

sub _call__context__ok {
    my ( $method, $ctx, @arg ) = @_;
    my @slurp = splice @arg, 2;;
    push @arg, \@slurp;
    $method->( $ctx, @arg );
    return;
}

sub _quote_value {
    my ( $value ) = @_;
    defined $value
	or return 'undef';
    looks_like_number( $value )
	and return $value;
    return "'$value'";
}

__END__

=head1 TITLE

events - Execute load_module_*() and dump the generated events.

=head1 SYNOPSIS

 events load_module_ok Bad::Module -diag Fubar
 events ok 1 "I'm OK, you're OK"
 events -help
 events -version

=head1 OPTIONS

=head2 -context

If this Boolean option is asserted, the first argument is interpreted as
the name of a method attached to a context object. The context will be
acquired, the method executed, and the context released.

Subsequent arguments are passed verbatim to the method, followed by the
L<-name|/-name> and L<-diagnostic|/-diagnostic> options in that order.

The context's C<ok()> method is special-cased to handle the fact that it
takes diagnostics as an array reference rather than an array. Any other
methods that take structured arguments (e.g. C<send_ev2()> will flunk.

=head2 -diagnostic

 -diagnostic 'This is a diagnostic'

This option specifies a diagnostic. It can be specified more than once.

=head2 -help

This option displays the documentation for this script. The script then
exits.

=head2 -import

This option specifies an explicit import. It can be specified more than
once. A value of C<'[]'> specifies an empty array reference as the
argument.

=head2 -name

This option specifies the name argument.

=head2 -skip

 -skip 17

This option specifies the number of skipped tests for
C<load_module_or_skip()>. This is actually a synonym for
L<-diagnostic|/-diagnostic>, since the two arguments are handled the
same way.

=head2 -version

This option specifies a version number for the module.

=head1 DETAILS

This Perl script executes a test subroutine and dumps the events
generated by it. B<Note> that test diagnostics will not appear in the
dump if they are attached as C<info>. It is specialized for use with
L<Test2::Tools::LoadModule|Test2::Tools::LoadModule>, but can handle any
L<Test2::V0|Test2::V0> routine that generates events.

The command-line arguments are the subroutine to call, and any required
arguments of that subroutine. We assume that any subroutine we are
interested in takes an optional name and optional diagnostics, provided
by the L<-name|/-name> and L<-diagnostic|/-diagnostic> options,
respectively.

If the subroutine was found in
L<Test2::Tools::LoadModule|Test2::Tools::LoadModule>, we assume it
requires one additional mandatory argument (the module name), followed
by the L<-version|/-version>, L<-import|/-import>, L<-name|/-name>, and
L<-diagnostic|/-diagnostic> options in that order. Otherwise we assume
it takes all command-line arguments as specified, followed by the
L<-name|/-name> and L<-diagnostic|/-diagnostic> options in that order.

=over

=item The subroutine to execute

This must be C<load_module_ok>, C<load_module_or_skip>,
C<load_module_or_skip_all>, C<require_ok>, or C<use_ok>.

=item The name of the module to load

=back

The subsequent subroutine arguments are specified by options. In order,
they are

=over

=item L<-version|/-version>

=item L<-import|/-import>

=item L<-name|/-name>

=item L<-diagnostic|/-diagnostic> or L<-skip|/-skip>.

=back

=head1 AUTHOR

Thomas R. Wyant, III F<wyant at cpan dot org>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2020 by Thomas R. Wyant, III

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl 5.10.0. For more details, see the full text
of the licenses in the directory LICENSES.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=cut

# ex: set textwidth=72 :
