The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!perl -w

use strict;
use FindBin qw($Bin);
use File::Spec::Functions qw(catdir catfile);
use Test::More;
use HTML::Mason::Interp;
my $base_key = 'OOTester';
my $comp = '/dhandler';

##############################################################################
# Figure out if the current configuration can handle OO callbacks.
BEGIN {
    plan skip_all => 'Object-oriented callbacks require Perl 5.6.0 or later'
      if $] < 5.006;

    plan skip_all => 'Attribute::Handlers and Class::ISA required for' .
      ' object-oriented callbacks'
      unless eval { require Attribute::Handlers }
      and eval { require Class::ISA };

    plan tests => 16;
}

##############################################################################
# Set up the callback class.
##############################################################################
package Params::Callback::TestObjects;

use strict;
use base 'Params::Callback';
__PACKAGE__->register_subclass( class_key => $base_key);
use Params::CallbackRequest::Exceptions abbr => [qw(throw_cb_exec)];

sub simple : Callback {
    my $self = shift;
    main::isa_ok($self, 'Params::Callback');
    main::isa_ok($self, __PACKAGE__);
    my $params = $self->params;
    $params->{result} = 'Simple Success';
}

sub lowerit : PostCallback {
    my $self = shift;
    my $params = $self->params;
    if ($params->{do_lower}) {
        main::isa_ok($self, 'Params::Callback');
        main::isa_ok($self, __PACKAGE__);
        $params->{result} = lc $params->{result};
    }
}

1;
##############################################################################
# Set up another callback class to test the default class key.
package Params::Callback::TestKey;
use strict;
use base 'Params::Callback';
__PACKAGE__->register_subclass;

sub my_key : Callback {
    my $self = shift;
    main::is($self->pkg_key, __PACKAGE__, "Check package key" );
    main::is($self->class_key, __PACKAGE__, "Check class key" );
}

##############################################################################
# Back in the real world...
##############################################################################
package main;
use strict;
use_ok('MasonX::Interp::WithCallbacks');

##############################################################################
# Set up a functional callback we can use.
sub another {
    my $cb = shift;
    main::isa_ok($cb, 'Params::Callback');
    my $params = $cb->params;
    $params->{result} = 'Another Success';
}

##############################################################################
# And a functional request callback.
sub presto {
    my $cb = shift;
    main::isa_ok($cb, 'Params::Callback');
    my $params = $cb->params;
    $params->{result} = 'PRESTO' if $params->{do_presto};
}

##############################################################################
# Construct the combined callback exec object.
my $outbuf;
ok( my $interp = MasonX::Interp::WithCallbacks->new
    (comp_root  => catdir($Bin, qw(htdocs)),
     out_method => \$outbuf,
     callbacks => [{ pkg_key => 'foo',
                      cb_key => 'another',
                      cb => \&another}],
      cb_classes => 'ALL',
      pre_callbacks => [\&presto] ),
    "Construct combined CBExec object" );

##############################################################################
# Make sure the functional callback works.
$interp->exec($comp, 'foo|another_cb' => 1);
is( $outbuf, 'Another Success', "Check functional result" );
$outbuf = '';

##############################################################################
# Make sure OO callback works.
$interp->exec($comp, "$base_key|simple_cb" => 1);
is( $outbuf, 'Simple Success', "Check OO result" );
$outbuf = '';

##############################################################################
# Make sure that functional and OO request callbacks execute, too.
$interp->exec($comp,
              do_lower => 1,
              do_presto => 1);
is( $outbuf, 'presto', "Check request result" );
$outbuf = '';

##############################################################################
# Make sure that the default class key is the class name.
$interp->exec($comp, "Params::Callback::TestKey|my_key_cb" => 1);
$outbuf = '';

1;
__END__