Basset
view release on metacpan or search on metacpan
lib/Basset/Object.pm view on Meta::CPAN
);
$user is a Basset::User object. Use for objects that are supposed to be used in multiple applications. This allows you to swap
out particular objects for different (but similar!) ones by just changing the conf file, not all your code.
=cut
=pod
=begin btest(factory)
package Basset::Test::Testing::__PACKAGE__::factory::Subclass;
our @ISA = qw(__PACKAGE__);
package __PACKAGE__;
my $oldtypes = __PACKAGE__->types();
$test->ok($oldtypes, "Saved old types");
my $newtypes = {%$oldtypes, 'factory_test_type' => '__PACKAGE__'};
$test->is(__PACKAGE__->types($newtypes), $newtypes, "Set new types");
$test->is(__PACKAGE__->pkg_for_type('factory_test_type'), '__PACKAGE__', 'can get class for type');
my $o = __PACKAGE__->new();
$test->ok($o, "Created new object");
my $o2 = __PACKAGE__->factory('type' => 'factory_test_type');
$test->ok($o2, "Factoried new object");
$test->ok($o2->isa('__PACKAGE__'), "Factory object isa class object");
$test->is(__PACKAGE__->types($oldtypes), $oldtypes, "reset old types");
=end btest(factory)
=cut
sub factory {
my $class = shift;
my %init = @_;
if ($init{'type'}) {
my $abstype = $init{'type'};
delete $init{'type'};
my $typeClass = $class->pkg_for_type($abstype) or return;
return $typeClass->new(%init) || $class->error($typeClass->errvals);
}
else {
return $class->new(@_);
};
}
=pod
=item copy
Copies the object. B<Be warned>! Copy does a B<deep> copy of the object. So any objects/references/etc
pointed to by the original object will also be copied.
You may optionally pass in a different object/structure and copy that instead.
my $backupBoard = $game->copy($game->board);
=cut
=pod
=begin btest(copy)
package Basset::Test::Testing::__PACKAGE__::copy::subclass;
our @ISA = qw(__PACKAGE__);
Basset::Test::Testing::__PACKAGE__::copy::subclass->add_attr('attr1');
Basset::Test::Testing::__PACKAGE__::copy::subclass->add_attr('attr2');
Basset::Test::Testing::__PACKAGE__::copy::subclass->add_attr('attr3');
package __PACKAGE__;
my $o = __PACKAGE__->new();
$test->ok($o, "Instantiated object");
my $o2 = $o->copy;
$test->ok($o2, "Copied object");
$test->is(length $o->dump, length $o2->dump, "dumps are same size");
my $o3 = Basset::Test::Testing::__PACKAGE__::copy::subclass->new(
'attr1' => 'first attribute',
'attr2' => 'second attribute',
'attr3' => 'third attribute'
);
$test->ok($o3, "Instantiated sub-object");
$test->is($o3->attr1, 'first attribute', 'Subobject attr1 matches');
$test->is($o3->attr2, 'second attribute', 'Subobject attr2 matches');
$test->is($o3->attr3, 'third attribute', 'Subobject attr3 matches');
my $o4 = $o3->copy;
$test->ok($o4, "Copied sub-object");
$test->is($o4->attr1, 'first attribute', 'Copied subobject attr1 matches');
$test->is($o4->attr2, 'second attribute', 'Copied subobject attr2 matches');
$test->is($o4->attr3, 'third attribute', 'Copied subobject attr3 matches');
$test->is(length $o3->dump, length $o4->dump, "Sub object dumps are same size");
my $array = ['a', 2, {'foo' => 'bar'}];
$test->ok($array, "Got array");
my $array2 = __PACKAGE__->copy($array);
$test->ok($array2, "Copied array");
$test->is($array->[0], $array2->[0], "First element matches");
$test->is($array->[1], $array2->[1], "Second element matches");
$test->is($array->[2]->{'foo'}, $array2->[2]->{'foo'}, "Third element matches");
=end btest(copy)
=cut
sub copy {
( run in 0.614 second using v1.01-cache-2.11-cpan-c966e8aa7e8 )