view release on metacpan or  search on metacpan

t/01-class_constructor.t  view on Meta::CPAN

sub bam { $_[0]->{bam} = $_[1] if defined $_[1]; return $_[0]->{bam} }

Test_Class2->mk_constructor(
    Name      => 'create',
    Auto_Init => [ qw / baz bam / ],
);

Test_Class2->mk_constructor(
    Name      => 'boom',
    Auto_Init => 'baz',
);

package main;

$tc = Test_Class2->create(
    baz => 'testbaz',
    bam => 'testbam',
);

is(ref $tc, 'Test_Class2', 'class2 - object created');
is($tc->baz, 'testbaz', 'class2 - attr1');
is($tc->bam, 'testbam', 'class2 - attr2');

my $tc2 = Test_Class2->boom(
    baz => 'testbaz',
);

is(ref $tc, 'Test_Class2', 'object created');

eval {
    $tc2 = Test_Class2->boom(
        baz => 'testbaz',
        bam => 'testbam',
    );
};

ok($@ =~ /can\'t\s+autoinitialize/i, 'auto init');


package Test_Class3;
use base qw/ Class::Constructor /;

sub baz { $_[0]->{baz} = $_[1] if defined $_[1]; return $_[0]->{baz} }
sub bam { $_[0]->{bam} = $_[1] if defined $_[1]; return $_[0]->{bam} }

Test_Class3->mk_constructor(
    Auto_Init   => 'baz',
    Init_Method => '_init',
);

sub _init { 1 };

package main;

$tc = Test_Class3->new(
    baz => 'testbaz',
    bam => 'testbam',
);

is(ref $tc, 'Test_Class3', 'class 3 - object created');
ok(!defined $tc->bam,      'class 3 - initialization blocked');

ok($@ =~ /can\'t\s+autoinitialize/i, 'auto init');

package Test_Class4;
use base qw/ Class::Constructor /;

Test_Class4->mk_constructor(
    Init_Method => '_init_1',
    Init_Methods => [ '_init_2', '_init_3' ],
);

sub _init_1 {
    my $self = shift;
    $self->{_state} = 'init1';
}
sub _init_2 {
    my $self = shift;
    $self->{_state} .= '.init2';
}
sub _init_3 {
    my $self = shift;
    $self->{_state} .= '.init3';
}
sub get_state {
    my $self = shift;
    return $self->{_state};
}

package main;

$tc = Test_Class4->new;

is($tc->get_state,'init1.init2.init3', 'initialization methods');


package Subclass_Test;
use base qw/ Class::Constructor /;

sub baz { $_[0]->{baz} = $_[1] if defined $_[1]; return $_[0]->{baz} }
sub bam { $_[0]->{bam} = $_[1] if defined $_[1]; return $_[0]->{bam} }
sub type { $_[0]->{type} = $_[1] if defined $_[1]; return $_[0]->{type} }

Subclass_Test->mk_constructor(
    Name           => 'create',
    Subclass_Param => 'Type',
    Auto_Init      => [ qw/ baz bam type / ],
);

sub set_bam {
    my $self = shift;
    $self->bam('no');
};

sub set_baz {
    my $self = shift;
    $self->baz('no');
};

package main;