examples/LazyClass.pod

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