Frost

 view release on metacpan or  search on metacpan

lib/Frost.pm  view on Meta::CPAN

=head2 Thou shalt honor immutability

While applying L<Moose>' tests for Frost it appeared, that reblessing an
object - i.e. because of applying a role at run-time - creates mutable
objects blessed in an anonymous class. This destroys the silence/evoke
mechanism, which depends on the real classname.

So reblessing as well as make_mutable is VERBOTEN.

=head2 Thou shalt not weaken thy reference

Due to Frost's proxy algorithm there is no need for weak references.
See L</MOTIVATION>.

=head2 Thou shalt not create or load objects without an id and thy asylum

To create a new frostable object you must always say:

   my $foo = Foo->new ( id => 'a_unique_id', asylum => $asylum, an_attr => ..., another_attr => ... );

lib/Frost/Meta/Instance.pm  view on Meta::CPAN

##	= Class::MOP::Instance
##
##	sub initialize_all_slots
##	sub deinitialize_all_slots

sub is_slot_initialized
{
	die "mutable is VERBOTEN";
}

sub weaken_slot_value
{
	my ( $self, $instance, $slot_name )	= @_;

	die "weak refs for '$slot_name' are VERBOTEN (mutable)";
}

sub strengthen_slot_value
{
	my ( $self, $instance, $slot_name )	= @_;

lib/Frost/Meta/Instance.pm  view on Meta::CPAN

	"$invar\->_forget ( \"$slot\" )";
}

sub inline_is_slot_initialized
{
	my ( $self, $invar, $slot ) = @_;

	"$invar\->_exists ( \"$slot\" )"
}

sub inline_weaken_slot_value
{
	my ( $self, $invar, $slot ) = @_;

	die "weak refs for '$slot' are VERBOTEN (immutable)";
}

sub inline_strengthen_slot_value
{
	my ( $self, $invar, $slot ) = @_;

lib/Frost/Meta/Instance.pm  view on Meta::CPAN

=head2 get_slot_value

=head2 set_slot_value

=head2 initialize_slot

=head2 deinitialize_slot

=head2 is_slot_initialized

=head2 weaken_slot_value

=head2 strengthen_slot_value

=head2 rebless_instance_structure

=head2 inline_slot_access

=head2 inline_get_slot_value

=head2 inline_set_slot_value

=head2 inline_deinitialize_slot

=head2 inline_is_slot_initialized

=head2 inline_weaken_slot_value

=head2 inline_strengthen_slot_value

=head2 inline_rebless_instance_structure

=for comment PRIVATE METHODS

=for comment CALLBACKS

=for comment IMMUTABLE

t/000_moose_recipes/moose_cookbook_basics_recipe3.t  view on Meta::CPAN

my $left = $root->left;
isa_ok($left, 'BinaryTree');

is($root->left, $left, '... got the same node (and it is $left)');
ok($root->has_left, '... we have a left node now');

ok($left->has_parent, '... lefts has a parent');
is($left->parent, $root, '... lefts parent is the root');

ok(isweak($left->{parent}), '... parent is a weakened ref');

ok(!$left->has_left, '... $left no left node yet');
ok(!$left->has_right, '... $left no right node yet');

is($left->node, undef, '... left has got no node value');

lives_ok {
    $left->node('left')
} '... assign to lefts node';

t/000_moose_recipes/moose_cookbook_basics_recipe3.t  view on Meta::CPAN

} '... assign to rights node';

is($right->node, 'right', '... left now has a node value');

is($root->right, $right, '... got the same node (and it is $right)');
ok($root->has_right, '... we have a right node now');

ok($right->has_parent, '... rights has a parent');
is($right->parent, $root, '... rights parent is the root');

ok(isweak($right->{parent}), '... parent is a weakened ref');

# make a left node of the left node

my $left_left = $left->left;
isa_ok($left_left, 'BinaryTree');

ok($left_left->has_parent, '... left does have a parent');

is($left_left->parent, $left, '... got a parent node (and it is $left)');
ok($left->has_left, '... we have a left node now');
is($left->left, $left_left, '... got a left node (and it is $left_left)');

ok(isweak($left_left->{parent}), '... parent is a weakened ref');

# make a right node of the left node

my $left_right = BinaryTree->new;
isa_ok($left_right, 'BinaryTree');

lives_ok {
    $left->right($left_right)
} '... assign to rights node';

ok($left_right->has_parent, '... left does have a parent');

is($left_right->parent, $left, '... got a parent node (and it is $left)');
ok($left->has_right, '... we have a left node now');
is($left->right, $left_right, '... got a left node (and it is $left_left)');

ok(isweak($left_right->{parent}), '... parent is a weakened ref');

# and check the error

dies_ok {
    $left_right->right($left_left)
} '... cant assign a node which already has a parent';
}


done_testing;

t/000_moose_recipes/moose_cookbook_meta_recipe7.t  view on Meta::CPAN

    BEGIN { extends 'Moose::Meta::Instance' }
}



# =begin testing SETUP
{

  package My::Meta::Instance;

  use Scalar::Util qw( weaken );
  use Symbol qw( gensym );

  use Moose;
  extends 'Moose::Meta::Instance';

  sub create_instance {
      my $self = shift;
      my $sym = gensym();
      bless $sym, $self->_class_name;
  }

t/000_moose_recipes/moose_cookbook_meta_recipe7.t  view on Meta::CPAN

  sub deinitialize_slot {
      my ( $self, $instance, $slot_name ) = @_;
      delete *$instance->{$slot_name};;
  }

  sub is_slot_initialized {
      my ( $self, $instance, $slot_name, $value ) = @_;
      exists *$instance->{$slot_name};;
  }

  sub weaken_slot_value {
      my ( $self, $instance, $slot_name ) = @_;
      weaken *$instance->{$slot_name};;
  }

  sub inline_create_instance {
      my ( $self, $class_variable ) = @_;
      return 'do { my $sym = Symbol::gensym(); bless $sym, ' . $class_variable . ' }';
  }

  sub inline_slot_access {
      my ( $self, $instance, $slot_name ) = @_;
      return '*{' . $instance . '}->{' . $slot_name . '}';