lib/Class/MOP/Instance.pm

   1
   2 package Class::MOP::Instance;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Carp         'confess';
   8 use Scalar::Util 'blessed', 'reftype', 'weaken';
   9
  10 our $VERSION = '0.01';
  11
  12 sub meta {
  13     require Class::MOP::Class;
  14     Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
  15 }
  16
  17 sub new {
  18     my $class = shift;
  19     my $meta  = shift;
  20     bless {
  21         instance => (bless {} => $meta->name)
  22     } => $class;
  23 }
  24
  25 sub add_slot {
  26     my ($self, $slot_name, $value) = @_;
  27     return $self->{instance}->{$slot_name} = $value;
  28 }
  29
  30 sub has_slot {
  31     my ($self, $slot_name) = @_;
  32     exists $self->{instance}->{$slot_name} ? 1 : 0;
  33 }
  34
  35 sub get_slot_value {
  36     my ($self, $instance, $slot_name) = @_;
  37     return $instance->{$slot_name};
  38 }
  39
  40 sub set_slot_value {
  41     my ($self, $instance, $slot_name, $value) = @_;
  42     $instance->{$slot_name} = $value;
  43 }
  44
  45 sub has_slot_value {
  46     my ($self, $instance, $slot_name) = @_;
  47     defined $instance->{$slot_name} ? 1 : 0;
  48 }
  49
  50 sub get_instance { (shift)->{instance} }
  51
  52 1;
  53
  54 __END__
  55
  56 =pod
  57
  58 =head1 NAME
  59
  60 Class::MOP::Instance - Instance Meta Object
  61
  62 =head1 SYNOPSIS
  63
  64 =head1 DESCRIPTION
  65
  66 =head1 METHODS
  67
  68 =over 4
  69
  70 =item B<new>
  71
  72 =item B<add_slot>
  73
  74 =item B<has_slot>
  75
  76 =item B<get_slot_value>
  77
  78 =item B<set_slot_value>
  79
  80 =item B<has_slot_value>
  81
  82 =item B<get_instance>
  83
  84 =back
  85
  86 =head2 Introspection
  87
  88 =over 4
  89
  90 =item B<meta>
  91
  92 This will return a B<Class::MOP::Class> instance which is related
  93 to this class.
  94
  95 =back
  96
  97 =head1 AUTHOR
  98
  99 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 100
 101 =head1 COPYRIGHT AND LICENSE
 102
 103 Copyright 2006 by Infinity Interactive, Inc.
 104
 105 L<http://www.iinteractive.com>
 106
 107 This library is free software; you can redistribute it and/or modify
 108 it under the same terms as Perl itself.
 109
 110 =cut