#!perl -w

# $Id: 01basic.t 682 2004-09-28 05:59:10Z david $

use strict;
use Test::More tests => 73;

BEGIN { use_ok('Params::CallbackRequest') }

my $key = 'myCallbackTester';
my $cbs = [];

##############################################################################
# Set up callback functions.
##############################################################################
# Simple callback.
sub simple {
    my $cb = shift;
    isa_ok( $cb, 'Params::Callback' );
    isa_ok( $cb->cb_request, 'Params::CallbackRequest' );
    my $params = $cb->params;
    $params->{result} = 'Success';
}

push @$cbs, { pkg_key => $key,
              cb_key  => 'simple',
              cb      => \&simple
            };

##############################################################################
# Array value callback.
sub array_count {
    my $cb = shift;
    isa_ok( $cb, 'Params::Callback' );
    my $params = $cb->params;
    my $val = $cb->value;
    # For some reason, if I don't eval this, then the code in the rest of
    # the function doesn't run!
    eval { isa_ok( $val, 'ARRAY' ) };
    $params->{result} = scalar @$val;
}

push @$cbs, { pkg_key => $key,
              cb_key  => 'array_count',
              cb      => \&array_count
            };

##############################################################################
# Hash value callback.
sub hash_check {
    my $cb = shift;
    isa_ok( $cb, 'Params::Callback');
    my $params = $cb->params;
    my $val = $cb->value;
    # For some reason, if I don't eval this, then the code in the rest of
    # the function doesn't run!
    eval { isa_ok( $val, 'HASH' ) };
    $params->{result} = "$val"
}

push @$cbs, { pkg_key => $key,
              cb_key  => 'hash_check',
              cb      => \&hash_check
            };

##############################################################################
# Code value callback.
sub code_check {
    my $cb = shift;
    isa_ok( $cb, 'Params::Callback');
    my $params = $cb->params;
    my $val = $cb->value;
    # For some reason, if I don't eval this, then the code in the rest of
    # the function doesn't run!
    eval { isa_ok( $val, 'CODE' ) };
    $params->{result} = $val->();
}

push @$cbs, { pkg_key => $key,
              cb_key  => 'code_check',
              cb      => \&code_check
            };

##############################################################################
# Count the number of times the callback executes.
sub count {
    my $cb = shift;
    isa_ok( $cb, 'Params::Callback');
    my $params = $cb->params;
    $params->{result}++;
}

push @$cbs, { pkg_key => $key,
              cb_key  => 'count',
              cb      => \&count
            };

##############################################################################
# Abort callbacks.
sub test_abort {
    my $cb = shift;
    isa_ok( $cb, 'Params::Callback');
    my $params = $cb->params;
    $params->{result} = 'aborted';
    $cb->abort(1);
}

push @$cbs, { pkg_key => $key,
              cb_key  => 'test_abort',
              cb      => \&test_abort
            };

##############################################################################
# Check the aborted value.
sub test_aborted {
    my $cb = shift;
    isa_ok( $cb, 'Params::Callback');
    my $params = $cb->params;
    my $val = $cb->value;
    eval { $cb->abort(1) } if $val;
    $params->{result} = $cb->aborted($@) ? 'yes' : 'no';
}

push @$cbs, { pkg_key => $key,
              cb_key  => 'test_aborted',
              cb      => \&test_aborted
            };

##############################################################################
# We'll use this callback just to grab the value of the "submit" parameter.
sub submit {
    my $cb = shift;
    isa_ok( $cb, 'Params::Callback');
    my $params = $cb->params;
    $params->{result} = $params->{submit};
}

push @$cbs, { pkg_key => $key,
              cb_key  => 'submit',
              cb      => \&submit
            };

##############################################################################
# We'll use these callbacks to test notes().
sub add_note {
    my $cb = shift;
    $cb->notes($cb->value, $cb->params->{note});
}

sub get_note {
    my $cb = shift;
    $cb->params->{result} = $cb->notes($cb->value);
}

sub list_notes {
    my $cb = shift;
    my $params = $cb->params;
    my $notes = $cb->notes;
    for my $k (sort keys %$notes) {
        $params->{result} .= "$k => $notes->{$k}\n";
    }
}

sub clear {
    my $cb = shift;
    $cb->cb_request->clear_notes;
}

push @$cbs, { pkg_key => $key,
              cb_key  => 'add_note',
              cb      => \&add_note
            },
            { pkg_key => $key,
              cb_key  => 'get_note',
              cb      => \&get_note
            },
            { pkg_key => $key,
              cb_key  => 'list_notes',
              cb      => \&list_notes
            },
            { pkg_key => $key,
              cb_key  => 'clear',
              cb      => \&clear
            };

##############################################################################
# We'll use this callback to change the result to uppercase.
sub upper {
    my $cb = shift;
    my $params = $cb->params;
    if ($params->{do_upper}) {
        isa_ok( $cb, 'Params::Callback');
        $params->{result} = uc $params->{result};
    }
}

##############################################################################
# We'll use this callback to flip the characters of the "submit" parameter.
# The value of the "submit" parameter won't be "racecar!"
sub flip {
    my $cb = shift;
    my $params = $cb->params;
    if ($params->{do_flip}) {
        isa_ok( $cb, 'Params::Callback');
        $params->{submit} = reverse $params->{submit};
    }
}

##############################################################################
# Construct the CallbackRequest object.
##############################################################################

ok( my $cb_request = Params::CallbackRequest->new
    ( callbacks      => $cbs,
      post_callbacks => [\&upper],
      pre_callbacks  => [\&flip] ),
    "Construct CBExec object" );
isa_ok($cb_request, 'Params::CallbackRequest' );

# Check its accessor methods.
is( $cb_request->default_priority, 5, "Check default priority" );
is ( $cb_request->default_pkg_key, 'DEFAULT', "Check default package name" );

##############################################################################
# Test the callbacks themselves.
##############################################################################
# Try a Simple callback.
my %params = ( "$key|simple_cb" => 1 );
ok( $cb_request->request(\%params), "Execute simple callback" );
is( $params{result}, 'Success', "Check simple result" );

##############################################################################
# Test an array reference value.
%params = (  "$key|array_count_cb" => [1,2,3,4,5] );
ok( $cb_request->request(\%params), "Execute array count callback" );
is( $params{result}, 5, "Check array count result" );

##############################################################################
# Test a hash reference.
%params = (  "$key|hash_check_cb" => { one => 1 } );
ok( $cb_request->request(\%params), "Execute hash check callback" );
is( $params{result}, $params{"$key|hash_check_cb"},
    "Check hash check result" );

##############################################################################
# Test a code reference.
%params = (  "$key|code_check_cb" => sub { 'yes!' } );
ok( $cb_request->request(\%params), "Execute code callback" );
is( $params{result}, 'yes!', "Check code result" );

##############################################################################
# Make sure that two similar callbacks set up like image callbacks are getting
# properly executed.
%params = ( "$key|simple_cb.x" => 18,
            "$key|simple_cb.y" => 24 );
ok( $cb_request->request(\%params), "Execute image button callback" );
is( $params{result}, 'Success', "Check image button result" );

##############################################################################
# Make sure that the image button parameters cause the callback to be called
# only once.
%params = ( "$key|count_cb.x" => 18,
            "$key|count_cb.y" => 24 );
ok( $cb_request->request(\%params), "Execute image button count callback" );
is( $params{result}, 1, "Check image button count result" );

##############################################################################
# Just like the above, but make sure that different priorities execute
# at different times.
%params = ( "$key|count_cb1.x" => 18,
            "$key|count_cb1.y" => 24,
            "$key|count_cb2.x" => 18,
            "$key|count_cb2.y" => 24 );
ok( $cb_request->request(\%params), "Execute image button priority callback" );
is( $params{result}, 2, "Check image button priority result" );

##############################################################################
# Test the abort functionality. The abort callback's higher priority should
# cause it to prevent simple from being called.
%params = ( "$key|simple_cb" => 1,
            "$key|test_abort_cb0" => 1 );
is( $cb_request->request(\%params), 1, "Execute abort callback" );
is( $params{result}, 'aborted', "Check abort result" );

##############################################################################
# Test the aborted method.
%params = ( "$key|test_aborted_cb" => 1 );
is( $cb_request->request(\%params), $cb_request, "Execute aborted callback" );
is( $params{result}, 'yes', "Check aborted result" );

##############################################################################
# Test notes.
my $note_key = 'myNote';
my $note = 'Test note';
%params = ("$key|add_note_cb1" => $note_key, # Executes first.
           note                => $note,
           "$key|get_note_cb"  => $note_key);
is( $cb_request->request(\%params), $cb_request, "Add and get note" );
is( $params{result}, $note, "Check note result" );

# Make sure the note isn't available on the next request.
%params = ( "$key|get_note_cb"  => $note_key );
is( $cb_request->request(\%params), $cb_request, "Get no note" );
is( $params{result}, undef, "Check no note result" );

# Tell the callback request object to leave the notes and try again.
ok( $cb_request = Params::CallbackRequest->new
    ( callbacks      => $cbs,
      leave_notes    => 1,
      post_callbacks => [\&upper],
      pre_callbacks  => [\&flip] ),
    "Construct a new CBExec object" );

%params = ("$key|add_note_cb1" => $note_key, # Executes first.
           note                => $note,
           "$key|get_note_cb"  => $note_key);
is( $cb_request->request(\%params), $cb_request, "Add and get note again" );
is( $params{result}, $note, "Check note result" );

# Make sure the note isn't available on the next request.
%params = ( "$key|get_note_cb"  => $note_key );
is( $cb_request->request(\%params), $cb_request, "Get persistent note" );
is( $params{result}, $note, "Check presistent note result" );

# Add another note.
%params = ("$key|add_note_cb1"  => $note_key . 1, # Executes first.
           note                 => $note . 1,
           "$key|list_notes_cb" => 1);
is( $cb_request->request(\%params), $cb_request, "Add another note" );
is( $params{result}, "$note_key => $note\n${note_key}1 => ${note}1\n",
    "Check multiple note result" );

# And finally, clear the notes out.
%params = ( "$key|clear_cb1" => 1, # Executes first.
           "$key|list_notes_cb" => 1);
is( $cb_request->request(\%params), $cb_request, "Clear notes" );
is( $params{result}, undef, "Check cleared note result" );

##############################################################################
# Test the pre-execution callbacks.
my $string = 'yowza';
%params = ( "$key|submit_cb" => 1,
            submit           => $string,
            do_flip          => 1 );
ok( $cb_request->request(\%params), "Execute pre callback" );
is( $params{result}, reverse($string), "Check pre result" );


##############################################################################
# Test the post-execution callbacks.
%params = ( "$key|simple_cb" => 1,
            do_upper => 1 );
ok( $cb_request->request(\%params), "Execute post callback" );
is( $params{result}, 'SUCCESS', "Check post result" );

##############################################################################
# Now make sure that a callback with a value executes.
ok( my $new_cb_request = Params::CallbackRequest->new( callbacks    => $cbs,
                                                       ignore_nulls => 1),
    "Create new CBExec that ignores nulls" );
%params = ( "$key|simple_cb" => 1);
ok( $new_cb_request->request(\%params), "Execute simple callback" );
is( $params{result}, 'Success', "Check simple result" );

# And try it with a null value.
%params = ( "$key|simple_cb" => '');
ok( $new_cb_request->request(\%params), "Execute null simple callback" );
is( $params{result}, undef, "Check null simple result" );

# And with undef.
%params = ( "$key|simple_cb" => undef);
ok( $new_cb_request->request(\%params), "Execute undef simple callback" );
is( $params{result}, undef, "Check undef simple result" );

# But 0 should succeed.
%params = ( "$key|simple_cb" => 0);
ok( $new_cb_request->request(\%params), "Execute 0 simple callback" );
is( $params{result}, 'Success', "Check 0 simple result" );



1;
__END__