view release on metacpan or  search on metacpan

t/core/class.t  view on Meta::CPAN

use Badger::Class
    base     => 'Alice Badger::Base',
    debug    => 0,
    import   => 'class',
    messages => {
        one_louder  => "Well, it's %s louder",
        do_you_wear => "Do you wear %0?",
    };

class->messages( goes_up_to => 'This <1> goes up to <2>' );

package main;
my $nigel = Nigel->new;
is( $nigel->message( one_louder => 'one' ), 
    "Well, it's one louder", "It's One louder"
);
is( $nigel->message( goes_up_to => amp => 'eleven' ), 
    "This amp goes up to eleven", 'Goes up to eleven' 
);


#-----------------------------------------------------------------------
# test classes get autoloaded
#-----------------------------------------------------------------------

use Class::Top;
my $top = Class::Top->new;
my $mid = Class::Middle->new;
my $bot = Class::Bottom->new;

if ($DEBUG) {
    print "HERITAGE: ", join(', ', $top->class->heritage), "\n";
    print "Top ISA: ", join(', ', @Class::Top::ISA), "\n";
    print "Middle ISA: ", join(', ', @Class::Middle::ISA), "\n";
    print "Bottom ISA: ", join(', ', @Class::Bottom::ISA), "\n";
}

is( $bot->bottom, 'on the bottom', 'bot is on the bottom' );
is( $mid->bottom, 'on the bottom', 'mid is on the bottom' );
is( $top->bottom, 'on the bottom', 'top is on the bottom' );
is( $mid->middle, 'in the middle', 'mid is in the middle' );
is( $top->middle, 'in the middle', 'top is in the middle' );
is( $top->top, 'on the top', 'op on the top' );

is( $bot->class->id, 'class.bottom', 'bot id' );
is( $mid->class->id, 'class.middle', 'mid id' );
is( $top->class->id, 'class.top', 'top id' );

#-----------------------------------------------------------------------
# test codec/codecs
#-----------------------------------------------------------------------

package Test::Codec1;
use Badger::Test;
use Badger::Class codec => 'base64';

my $enc = encode('Hello World');
is( $enc, "SGVsbG8gV29ybGQ=\n", 'encoded base64' );

my $dec = decode($enc);
is( $dec, 'Hello World', 'decoded base64' );


#-----------------------------------------------------------------------
# test method() method
#-----------------------------------------------------------------------

package Test::Method1;
use Badger::Class 
    base   => 'Badger::Base',
    import => 'class';

sub init {
    my ($self, $config) = @_;
    $self->{ foo } = $config->{ foo };
    $self->{ bar } = $config->{ bar };
    return $self;
}

class->method( hello => sub { 'hello world' } );
class->methods( goodbye => sub { "see ya!" } );
class->get_methods('foo bar');
class->set_methods('wiz');

package main;

is( Test::Method1->hello, 'hello world', 'method() test' );
is( Test::Method1->goodbye, 'see ya!', 'methods() test' );
my $t1 = Test::Method1->new( foo => 'Hello', bar => 'World' );
is( $t1->foo, 'Hello', 'generated foo get method' );
is( $t1->bar, 'World', 'generated bar get method' );

is( $t1->wiz('waz'), 'waz', 'set wiz' );
is( $t1->wiz, 'waz', 'get wiz' );


#-----------------------------------------------------------------------
# and again via Badger::Class import hooks
#-----------------------------------------------------------------------

package Test::Method2;
use Badger::Class 
    base   => 'Badger::Base',
    import => 'class',
    get_methods => 'ding dong',
    set_methods => 'dang',
    methods     => {
        welcome  => sub { 'Hello World' },
        farewell => 'Goodbye cruel world',
    };

sub init {
    my ($self, $config) = @_;
    $self->{ ding } = $config->{ ding };
    $self->{ dong } = $config->{ dong };
    return $self;
}

package main;

is( Test::Method2->welcome, 'Hello World', 'welcome method' );