The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#########################

use Test::More tests => 75;

#########################

# use
# exports explode and notify (and nothing else) by default
{
    package t::Carp::Notify::a;

    ::use_ok( 'Carp::Notify' );

    my %symtable = %t::Carp::Notify::a::;
    delete $symtable{BEGIN};
    delete $symtable{TODO};

    ::is_deeply(
        \%symtable,
        {
            explode => *t::Carp::Notify::a::explode,
            notify => *t::Carp::Notify::a::notify,
        },
        '...::a symbol table',
    );

    ::cmp_ok(
        \&t::Carp::Notify::a::explode,
        '==',
        \&Carp::Notify::explode,
        '...::a explode came from where we expect',
    );
    ::cmp_ok(
        \&t::Carp::Notify::a::notify,
        '==',
        \&Carp::Notify::notify,
        '...::a notify came from where we expect',
    );
}

# exports even if passed nothing, e.g. qw()
# this contrary to normal conventions, but is the original module behaviour
{
    package t::Carp::Notify::b;

    ::use_ok( 'Carp::Notify', qw() );

    my %symtable = %t::Carp::Notify::b::;
    delete $symtable{BEGIN};
    delete $symtable{TODO};

    # this shows what the module should be doing
    TODO: {
        local $TODO;
        $TODO = 'preserving backwards compatibility... for now';

        ::is_deeply(
            \%symtable,
            {},
            '...::b symbol table (as it should be)',
        );
    }

    # the following tests show what it's historically done
    ::is_deeply(
        \%symtable,
        {
            explode => *t::Carp::Notify::b::explode,
            notify => *t::Carp::Notify::b::notify,
        },
        '...::b symbol table',
    );

    ::cmp_ok(
        \&t::Carp::Notify::b::explode,
        '==',
        \&Carp::Notify::explode,
        '...::b explode came from where we expect',
    );
    ::cmp_ok(
        \&t::Carp::Notify::b::notify,
        '==',
        \&Carp::Notify::notify,
        '...::b notify came from where we expect',
    );
}

# exports croak, carp, make_storable, and make_unstorable when asked
# make the explode and notify tests pass on TODOs
{
    package t::Carp::Notify::c;

    ::use_ok( 'Carp::Notify', qw(croak) );

    my %symtable = %t::Carp::Notify::c::;
    delete $symtable{BEGIN};
    delete $symtable{TODO};

    # this shows what the module should be doing
    TODO: {
        local $TODO;
        $TODO = 'preserving backwards compatibility... for now';

        ::is_deeply(
            \%symtable,
            {
                'croak' => *t::Carp::Notify::c::croak,
            },
            '...::c symbol table (as it should be)',
        );
    }

    # tests demonstrating backwards compatibility with broken behavior
    ::is_deeply(
        \%symtable,
        {
            explode => *t::Carp::Notify::c::explode,
            notify => *t::Carp::Notify::c::notify,
            'croak' => *t::Carp::Notify::c::croak,
        },
        '...::c symbol table',
    );

    ::cmp_ok(
        \&t::Carp::Notify::c::explode,
        '==',
        \&Carp::Notify::explode,
        '...::c explode came from where we expect',
    );
    ::cmp_ok(
        \&t::Carp::Notify::c::notify,
        '==',
        \&Carp::Notify::notify,
        '...::c notify came from where we expect',
    );

    # this test will remain
    ::cmp_ok(
        \&t::Carp::Notify::c::croak,
        '==',
        \&Carp::Notify::explode,
        '...::c croak came from where we expect',
    );
}
{
    package t::Carp::Notify::d;

    ::use_ok( 'Carp::Notify', qw(carp) );

    my %symtable = %t::Carp::Notify::d::;
    delete $symtable{BEGIN};
    delete $symtable{TODO};

    # this shows what the module should be doing
    TODO: {
        local $TODO;
        $TODO = 'preserving backwards compatibility... for now';

        ::is_deeply(
            \%symtable,
            {
                'carp' => *t::Carp::Notify::d::carp,
            },
            '...::d symbol table (as it should be)',
        );
    }

    # tests demonstrating backwards compatibility with broken behavior
    ::is_deeply(
        \%symtable,
        {
            explode => *t::Carp::Notify::d::explode,
            notify => *t::Carp::Notify::d::notify,
            'carp' => *t::Carp::Notify::d::carp,
        },
        '...::d symbol table',
    );

    ::cmp_ok(
        \&t::Carp::Notify::d::explode,
        '==',
        \&Carp::Notify::explode,
        '...::d explode came from where we expect',
    );
    ::cmp_ok(
        \&t::Carp::Notify::d::notify,
        '==',
        \&Carp::Notify::notify,
        '...::d notify came from where we expect',
    );

    # this test will remain
    ::cmp_ok(
        \&t::Carp::Notify::d::carp,
        '==',
        \&Carp::Notify::notify,
        '...::d carp came from where we expect',
    );
}
{
    package t::Carp::Notify::e;

    ::use_ok( 'Carp::Notify', qw(make_storable) );

    my %symtable = %t::Carp::Notify::e::;
    delete $symtable{BEGIN};
    delete $symtable{TODO};

    # this shows what the module should be doing
    TODO: {
        local $TODO;
        $TODO = 'preserving backwards compatibility... for now';

        ::is_deeply(
            \%symtable,
            {
                make_storable => *t::Carp::Notify::e::make_storable,
            },
            '...::e symbol table (as it should be)',
        );
    }

    # tests demonstrating backwards compatibility with broken behavior
    ::is_deeply(
        \%symtable,
        {
            explode => *t::Carp::Notify::e::explode,
            notify => *t::Carp::Notify::e::notify,
            make_storable => *t::Carp::Notify::e::make_storable,
        },
        '...::e symbol table',
    );

    ::cmp_ok(
        \&t::Carp::Notify::e::explode,
        '==',
        \&Carp::Notify::explode,
        '...::e explode came from where we expect',
    );
    ::cmp_ok(
        \&t::Carp::Notify::e::notify,
        '==',
        \&Carp::Notify::notify,
        '...::e notify came from where we expect',
    );

    # this test will remain
    ::cmp_ok(
        \&t::Carp::Notify::e::make_storable,
        '==',
        \&Carp::Notify::make_storable,
        '...::e make_storable came from where we expect',
    );
}
{
    package t::Carp::Notify::f;

    ::use_ok( 'Carp::Notify', qw(make_unstorable) );

    my %symtable = %t::Carp::Notify::f::;
    delete $symtable{BEGIN};
    delete $symtable{TODO};

    # this shows what the module should be doing
    TODO: {
        local $TODO;
        $TODO = 'preserving backwards compatibility... for now';

        ::is_deeply(
            \%symtable,
            {
                make_unstorable => *t::Carp::Notify::f::make_unstorable,
            },
            '...::f symbol table (as it should be)',
        );
    }

    # tests demonstrating backwards compatibility with broken behavior
    ::is_deeply(
        \%symtable,
        {
            explode => *t::Carp::Notify::f::explode,
            notify => *t::Carp::Notify::f::notify,
            make_unstorable => *t::Carp::Notify::f::make_unstorable,
        },
        '...::f symbol table',
    );

    ::cmp_ok(
        \&t::Carp::Notify::f::explode,
        '==',
        \&Carp::Notify::explode,
        '...::f explode came from where we expect',
    );
    ::cmp_ok(
        \&t::Carp::Notify::f::notify,
        '==',
        \&Carp::Notify::notify,
        '...::f notify came from where we expect',
    );

    # this test will remain
    ::cmp_ok(
        \&t::Carp::Notify::f::make_unstorable,
        '==',
        \&Carp::Notify::make_unstorable,
        '...::f make_unstorable came from where we expect',
    );
}
{
    package t::Carp::Notify::g;

    ::use_ok( 'Carp::Notify', qw(croak carp make_storable make_unstorable) );

    my %symtable = %t::Carp::Notify::g::;
    delete $symtable{BEGIN};
    delete $symtable{TODO};

    # this shows what the module should be doing
    TODO: {
        local $TODO;
        $TODO = 'preserving backwards compatibility... for now';

        ::is_deeply(
            \%symtable,
            {
                'croak' => *t::Carp::Notify::g::croak,
                'carp' => *t::Carp::Notify::g::carp,
                make_storable => *t::Carp::Notify::e::make_storable,
                make_unstorable => *t::Carp::Notify::g::make_unstorable,
            },
            '...::g symbol table (as it should be)',
        );
    }

    # tests demonstrating backwards compatibility with broken behavior
    ::is_deeply(
        \%symtable,
        {
            explode => *t::Carp::Notify::g::explode,
            notify => *t::Carp::Notify::g::notify,
            'croak' => *t::Carp::Notify::g::croak,
            'carp' => *t::Carp::Notify::g::carp,
            make_storable => *t::Carp::Notify::g::make_storable,
            make_unstorable => *t::Carp::Notify::g::make_unstorable,
        },
        '...::g symbol table',
    );

    ::cmp_ok(
        \&t::Carp::Notify::g::explode,
        '==',
        \&Carp::Notify::explode,
        '...::g explode came from where we expect',
    );
    ::cmp_ok(
        \&t::Carp::Notify::g::notify,
        '==',
        \&Carp::Notify::notify,
        '...::g notify came from where we expect',
    );

    # these tests will remain
    ::cmp_ok(
        \&t::Carp::Notify::g::croak,
        '==',
        \&Carp::Notify::explode,
        '...::g croak came from where we expect',
    );
    ::cmp_ok(
        \&t::Carp::Notify::g::carp,
        '==',
        \&Carp::Notify::notify,
        '...::g carp came from where we expect',
    );
    ::cmp_ok(
        \&t::Carp::Notify::g::make_storable,
        '==',
        \&Carp::Notify::make_storable,
        '...::g make_storable came from where we expect',
    );
    ::cmp_ok(
        \&t::Carp::Notify::g::make_unstorable,
        '==',
        \&Carp::Notify::make_unstorable,
        '...::g make_unstorable came from where we expect',
    );
}

# adds variables to the storable list on import
# store_vars
# make_storable
# make_unstorable
#
# in v1.10 make_storable and make_unstorable operate on a differnt data
# storage variable than store_vars (and the add via import mechanism) use
#
# retrieving $, @, %, and & variables from multiple packages
{
    package t::Carp::Notify::h;

    use vars qw(
        $var_1
        @var_1
        %var_1
    );

    $var_1 = 'contents of $var_1';
    @var_1 = qw(contents of @var_1);
    %var_1 = ( contents => 'of', '%var_1' => 'value' );

    sub func_1 {
        return 'func_1 return value';
    }

    sub get_store_vars {
        # work around the caller(1)[0] in store_vars to find the package
        return Carp::Notify::store_vars();
    }

    ::use_ok('Carp::Notify', qw($var_1 @var_1 %var_1 &func_1));

    my $store_return = get_store_vars();

    ::ok( $store_return, 'store_vars returned a value' );

    ::like(
        $store_return,
        qr/\$t::Carp::Notify::h::var_1 : contents of \$var_1/,
        'store_vars returns $var_1 contents'
    );
    ::like(
        $store_return,
        qr/\@t::Carp::Notify::h::var_1 : \(contents of \@var_1\)/,
        'store_vars returns @var_1 contents'
    );
    ::like(
        $store_return,
        qr/\%t::Carp::Notify::h::var_1 :\s+(contents => of\s+\%var_1 => value|\%var_1 => value\s+contents => of)/s,
        'store_vars returns %var_1 contents'
    );
    ::like(
        $store_return,
        qr/\&t::Carp::Notify::h::func_1 : func_1 return value/,
        'store_vars returns &func_1 return value'
    );

    # store_vars modifies the list of "stored" variables to make them
    # unsuitable for repeated calls to store_vars, this will be
    # considered to be a bug in the future
    $store_return = get_store_vars();

    TODO: {
        local $TODO;
        $TODO = 'preserving backwards compatibility... for now';

        ::like(
            $store_return,
            qr/\$t::Carp::Notify::h::var_1 : contents of \$var_1/,
            'store_vars returns $var_1 contents'
        );
        ::like(
            $store_return,
            qr/\@t::Carp::Notify::h::var_1 : \(contents of \@var_1\)/,
            'store_vars returns @var_1 contents'
        );
        ::like(
            $store_return,
            qr/\%t::Carp::Notify::h::var_1 :\s+(contents => of\s+\%var_1 => value|\%var_1 => value\s+contents => of)/s,
            'store_vars returns %var_1 contents'
        );
        ::like(
            $store_return,
            qr/\&t::Carp::Notify::h::func_1 : func_1 return value/,
            'store_vars returns &func_1 return value'
        );
    }

    ::is( $store_return, '' );
}
{
    package t::Carp::Notify::i;

    use vars qw(
        $var_1
        @var_1
        %var_1
        $var_2
        @var_2
        %var_2
    );

    $var_1 = 'contents of $var_1';
    @var_1 = qw(contents of @var_1);
    %var_1 = ( contents => 'of', '%var_1' => 'value' );
    $var_2 = 'contents of $var_2';
    @var_2 = qw(contents of @var_2);
    %var_2 = ( contents => 'of', '%var_2' => 'value' );

    sub func_1 {
        return 'func_1 return value';
    }

    sub func_2 {
        return 'func_2 return value';
    }

    sub get_store_vars {
        # work around the caller(1)[0] in store_vars to find the package
        return Carp::Notify::store_vars();
    }

    ::use_ok('Carp::Notify', qw($var_1 @var_1 %var_1 &func_1));

    ::ok(
        Carp::Notify::make_storable(
            qw(
                $t::Carp::Notify::h::var_2
                @t::Carp::Notify::h::var_2
                %t::Carp::Notify::h::var_2
                &t::Carp::Notify::h::func_2
            ),
        ),
        'make_storable returns true'
    );

    ::ok(
        Carp::Notify::make_unstorable(
            qw(
                $t::Carp::Notify::h::var_1
                @t::Carp::Notify::h::var_1
                %t::Carp::Notify::h::var_1
                &t::Carp::Notify::h::func_1
            ),
        ),
        'make_unstorable returns true'
    );

    $store_return = get_store_vars();

    ::ok( $store_return, 'store_vars returned a value' );

    # if it worked properly...
    TODO: {
        local $TODO;
        $TODO = 'preserving backwards compatibility... for now';

        ::like(
            $store_return,
            qr/\$t::Carp::Notify::i::var_2 : contents of \$var_2/,
            'store_vars returns $var_2 contents'
        );
        ::like(
            $store_return,
            qr/\@t::Carp::Notify::i::var_2 : \(contents of \@var_2\)/,
            'store_vars returns @var_2 contents'
        );
        ::like(
            $store_return,
            qr/\%t::Carp::Notify::i::var_2 :\s+(contents => of\s+\%var_2 => value|\%var_2 => value\s+contents => of)/s,
            'store_vars returns %var_2 contents'
        );
        ::like(
            $store_return,
            qr/\&t::Carp::Notify::i::func_2 : func_2 return value/,
            'store_vars returns &func_2 return value'
        );
    }

    # v1.10 broken behavior
    ::like(
        $store_return,
        qr/\$t::Carp::Notify::i::var_1 : contents of \$var_1/,
        'store_vars STILL returns $var_1 contents'
    );
    ::like(
        $store_return,
        qr/\@t::Carp::Notify::i::var_1 : \(contents of \@var_1\)/,
        'store_vars STILL returns @var_1 contents'
    );
    ::like(
        $store_return,
        qr/\%t::Carp::Notify::i::var_1 :\s+(contents => of\s+\%var_1 => value|\%var_1 => value\s+contents => of)/s,
        'store_vars STILL returns %var_1 contents'
    );
    ::like(
        $store_return,
        qr/\&t::Carp::Notify::i::func_1 : func_1 return value/,
        'store_vars STILL returns &func_1 return value'
    );
}

# today
{
    my $t1 = time;
    my ($sec1, $min1, $hour1, $mday1, $mon1, $year1, $wday1, $yday1, $isdst1) = localtime();
    my $c_n_today = Carp::Notify::today();
    my ($sec2, $min2, $hour2, $mday2, $mon2, $year2, $wday2, $yday2, $isdst2) = localtime();
    my $t2 = time;

    ok(
        # note that the numbers in the returned string are validated as being
        # zero-padded by this regex, so it won't be repeated later
        $c_n_today =~ /^(\w\w\w), (\d\d) (\w\w\w) (\d\d\d\d) (\d\d):(\d\d):(\d\d) ([+-])(\d\d\d\d)$/,
        'Carp::Notify::today matches basic pattern',
    );

    my(
        $c_n_dow,
        $c_n_mday,
        $c_n_mon,
        $c_n_yr,
        $c_n_hh,
        $c_n_mm,
        $c_n_ss,
        $c_n_off_dir,
        $c_n_off_amt,
    ) = ( $1, $2, $3, $4, $5, $6, $7, $8, $9 );

    # see which localtime capture is free of boundary wraps when compared to
    # the timestamp that Carp::Notify::today used
    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
    my $time_check_skip = 0;

    if( $t1 == $t2 ) {
        # it doesn't matter which one we use since we know that my time info
        # and Carp::Notify:today's time info came for the same second, so we
        # can be sure that there aren't any messy boundary conditions to
        # worry about.
        ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst)
            = ($sec1, $min1, $hour1, $mday1, $mon1, $year1, $wday1, $yday1, $isdst1);
    }
    elsif( $sec1 == $c_n_ss ) {
        ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst)
            = ($sec1, $min1, $hour1, $mday1, $mon1, $year1, $wday1, $yday1, $isdst1);
    }
    elsif( $sec2 == $c_n_ss ) {
        ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst)
            = ($sec2, $min2, $hour2, $mday2, $mon2, $year2, $wday2, $yday2, $isdst2);
    }
    else {
        # this must be a REALLY slow system for BOTH of my localtime data
        # captures to be in different seconds than the time that
        # Carp::Notify::today used...
        # OR maybe there's just something odd going on with the system clock.
        $time_check_skip = 1;
    }

    SKIP: {
        ::skip 'System time moving too fast', 8 if $time_check_skip;
        ::cmp_ok( $sec, '==', $c_n_ss, 'Carp::Notify::today, seconds match' );
        ::cmp_ok( $min, '==', $c_n_mm, 'Carp::Notify::today, minutes match' );
        ::cmp_ok( $hour, '==', $c_n_hh, 'Carp::Notify::today, hours match' );
        ::cmp_ok( $mday, '==', $c_n_mday, 'Carp::Notify::today, mday matches' );
        ::is(
            $mon,
            {
                Jan => 0, Feb => 1, Mar => 2, Apr => 3,
                May => 4, Jun => 5, Jul => 6, Aug => 7,
                Sep => 8, Oct => 9, Nov => 10, Dec => 11,
            }->{$c_n_mon},
            'Carp::Notify::today, month matches',
        );

        # correct year calculation
        ::cmp_ok(
            $year,
            '==',
            $c_n_yr - 1900,
            'Carp::Notify::today, year matches',
        );

        ::is(
            $wday,
            {
                Sun => 0, Mon => 1, Tue => 2, Wed => 3,
                Thu => 4, Fri => 5, Sat => 6,
            }->{$c_n_dow},
            'Carp::Notify::today, dow matches',
        );
    }

    SKIP: {
        ::skip 'GMT offset checking not (yet) implemented', 1 if 1;
    }
}

# setting defaults on use
#   there isn't a clean way to test this, as they are stuffed into
#   a lexical and not directly exposed by any functions
# "settables" are:
#   smtp
#   domain
#   port
#   email_it
#   email
#   return
#   subject
#   log_it
#   log_file
#   log_explode
#   explode_log
#   log_notify
#   notify_log
#   store_vars
#   stack_trace
#   store_env
#   die_to_stdout
#   die_everywhere
#   die_quietly
#   error_function
#   death_function
#   death_message

# store_env
{
    # this seems a bit silly to test as it's completely reimplementing the current code...

    my $c_n_env_str = Carp::Notify::store_env();

    my $env_str = join(
        '',
        map {
            "\t$_ : $ENV{$_}\n"
        }
        sort keys %ENV
    );

    ::is(
        $c_n_env_str,
        $env_str,
        'Carp::Notify::store_env returned the expected string',
    )
}

# stack_trace
# this seems non-trivial to test properly; lots of string building

# log_it
# this writes to the filesystem (filename overridable on use)
# also supports

# simple_smtp_mailer
# this connects to port 25 on some server...

# error
# this invokes the first arg as a callback, even allowing soft refs

# notify/explode
# notify is implemented as a non-fatal explode
# explode expects to send mail, etc depending on defaults

# email_it
# send email, not easy to test