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 (map { $_->{attribute} } $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   sub meta {
  81       LazyClass->initialize($_[0] => (
  82           ':attribute_metaclass' => 'LazyClass::Attribute'
  83       ));
  84   }
  85
  86   BinaryTree->meta->add_attribute('$:node' => (
  87       accessor => 'node',
  88       init_arg => ':node'
  89   ));
  90
  91   BinaryTree->meta->add_attribute('$:left' => (
  92       reader  => 'left',
  93       default => sub { BinaryTree->new() }
  94   ));
  95
  96   BinaryTree->meta->add_attribute('$:right' => (
  97       reader  => 'right',
  98       default => sub { BinaryTree->new() }
  99   ));
 100
 101   sub new {
 102       my $class = shift;
 103       bless $class->meta->construct_instance(@_) => $class;
 104   }
 105
 106   # ... later in code
 107
 108   my $btree = BinaryTree->new();
 109   # ... $btree is an empty hash, no keys are initialized yet
 110
 111 =head1 DESCRIPTION
 112
 113 This is an example metclass in which all attributes are created
 114 lazily. This means that no entries are made in the instance HASH
 115 until the last possible moment.
 116
 117 The example above of a binary tree is a good use for such a
 118 metaclass because it allows the class to be space efficient
 119 without complicating the programing of it. This would also be
 120 ideal for a class which has a large amount of attributes,
 121 several of which are optional.
 122
 123 =head1 AUTHOR
 124
 125 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 126
 127 =head1 COPYRIGHT AND LICENSE
 128
 129 Copyright 2006 by Infinity Interactive, Inc.
 130
 131 L<http://www.iinteractive.com>
 132
 133 This library is free software; you can redistribute it and/or modify
 134 it under the same terms as Perl itself.
 135
 136 =cut