examples/LazyClass.pod

   1
   2 package # hide the package from PAUSE
   3     LazyClass;
   4
   5 use strict;
   6 use warnings;
   7
   8 our $VERSION = '0.02';
   9
  10 use base 'Class::MOP::Class';
  11
  12 sub construct_instance {
  13     my ($class, %params) = @_;
  14     my $instance = {};
  15     foreach my $attr ($class->compute_all_applicable_attributes()) {
  16         # if the attr has an init_arg, use that, otherwise,
  17         # use the attributes name itself as the init_arg
  18         my $init_arg = $attr->has_init_arg() ? $attr->init_arg() : $attr->name;
  19         # try to fetch the init arg from the %params ...
  20         my $val;
  21         $val = $params{$init_arg} if exists $params{$init_arg};
  22         # now add this to the instance structure
  23         # only if we have found a value at all
  24         $instance->{$attr->name} = $val if defined $val;
  25     }
  26     return $instance;
  27 }
  28
  29 package # hide the package from PAUSE
  30     LazyClass::Attribute;
  31
  32 use strict;
  33 use warnings;
  34
  35 our $VERSION = '0.02';
  36
  37 use base 'Class::MOP::Attribute';
  38
  39 sub generate_accessor_method {
  40     my ($self, $attr_name) = @_;
  41     sub {
  42         if (scalar(@_) == 2) {
  43             $_[0]->{$attr_name} = $_[1];
  44         }
  45         else {
  46             if (!exists $_[0]->{$attr_name}) {
  47                 my $attr = $self->associated_class->get_attribute($attr_name);
  48                 $_[0]->{$attr_name} = $attr->has_default ? $attr->default($_[0]) : undef;
  49             }
  50             $_[0]->{$attr_name};
  51         }
  52     };
  53 }
  54
  55 sub generate_reader_method {
  56     my ($self, $attr_name) = @_;
  57     sub {
  58         if (!exists $_[0]->{$attr_name}) {
  59             my $attr = $self->associated_class->get_attribute($attr_name);
  60             $_[0]->{$attr_name} = $attr->has_default ? $attr->default($_[0]) : undef;
  61         }
  62         $_[0]->{$attr_name};
  63     };
  64 }
  65
  66 1;
  67
  68 __END__
  69
  70 =pod
  71
  72 =head1 NAME
  73
  74 LazyClass - An example metaclass with lazy initialization
  75
  76 =head1 SYNOPSIS
  77
  78   package BinaryTree;
  79
  80   use metaclass 'LazyClass' => (
  81       ':attribute_metaclass' => 'LazyClass::Attribute'
  82   );
  83
  84   BinaryTree->meta->add_attribute('$:node' => (
  85       accessor => 'node',
  86       init_arg => ':node'
  87   ));
  88
  89   BinaryTree->meta->add_attribute('$:left' => (
  90       reader  => 'left',
  91       default => sub { BinaryTree->new() }
  92   ));
  93
  94   BinaryTree->meta->add_attribute('$:right' => (
  95       reader  => 'right',
  96       default => sub { BinaryTree->new() }
  97   ));
  98
  99   sub new {
 100       my $class = shift;
 101       bless $class->meta->construct_instance(@_) => $class;
 102   }
 103
 104   # ... later in code
 105
 106   my $btree = BinaryTree->new();
 107   # ... $btree is an empty hash, no keys are initialized yet
 108
 109 =head1 DESCRIPTION
 110
 111 This is an example metclass in which all attributes are created
 112 lazily. This means that no entries are made in the instance HASH
 113 until the last possible moment.
 114
 115 The example above of a binary tree is a good use for such a
 116 metaclass because it allows the class to be space efficient
 117 without complicating the programing of it. This would also be
 118 ideal for a class which has a large amount of attributes,
 119 several of which are optional.
 120
 121 =head1 AUTHOR
 122
 123 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 124
 125 =head1 COPYRIGHT AND LICENSE
 126
 127 Copyright 2006 by Infinity Interactive, Inc.
 128
 129 L<http://www.iinteractive.com>
 130
 131 This library is free software; you can redistribute it and/or modify
 132 it under the same terms as Perl itself.
 133
 134 =cut