lib/Class/MOP/Attribute.pm

   1
   2 package Class::MOP::Attribute;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Carp 'confess';
   8
   9 our $VERSION = '0.01';
  10
  11 sub new {
  12     my $class   = shift;
  13     my $name    = shift;
  14     my %options = @_;
  15
  16     (defined $name && $name ne '')
  17         || confess "You must provide a name for the attribute";
  18
  19     bless {
  20         name     => $name,
  21         accessor => $options{accessor},
  22         reader   => $options{reader},
  23         writer   => $options{writer},
  24         init_arg => $options{init_arg},
  25         default  => $options{default}
  26     } => $class;
  27 }
  28
  29 sub name         { (shift)->{name}             }
  30
  31 sub has_accessor { (shift)->{accessor} ? 1 : 0 }
  32 sub accessor     { (shift)->{accessor}         }
  33
  34 sub has_reader   { (shift)->{reader}   ? 1 : 0 }
  35 sub reader       { (shift)->{reader}           }
  36
  37 sub has_writer   { (shift)->{writer}   ? 1 : 0 }
  38 sub writer       { (shift)->{writer}           }
  39
  40 sub has_init_arg { (shift)->{init_arg} ? 1 : 0 }
  41 sub init_arg     { (shift)->{init_arg}         }
  42
  43 sub has_default  { (shift)->{default}  ? 1 : 0 }
  44 sub default      { (shift)->{default}          }
  45
  46 sub generate_accessor {
  47     my $self = shift;
  48     # ...
  49 }
  50
  51 1;
  52
  53 __END__
  54
  55 =pod
  56
  57 =head1 NAME
  58
  59 Class::MOP::Attribute - Attribute Meta Object
  60
  61 =head1 SYNOPSIS
  62
  63   Class::MOP::Attribute->new('$foo' => (
  64       accessor => 'foo',        # dual purpose get/set accessor
  65       init_arg => '-foo',       # class->new will look for a -foo key
  66       default  => 'BAR IS BAZ!' # if no -foo key is provided, use this
  67   ));
  68
  69   Class::MOP::Attribute->new('$.bar' => (
  70       reader   => 'bar',        # getter
  71       writer   => 'set_bar',    # setter
  72       init_arg => '-bar',       # class->new will look for a -bar key
  73       # no default value means it is undef
  74   ));
  75
  76 =head1 DESCRIPTION
  77
  78 The Attribute Protocol is almost entirely an invention of this module. This is
  79 because Perl 5 does not have consistent notion of what is an attribute
  80 of a class. There are so many ways in which this is done, and very few
  81 (if any) are discoverable by this module.
  82
  83 So, all that said, this module attempts to inject some order into this
  84 chaos, by introducing a more consistent approach.
  85
  86 =head1 METHODS
  87
  88 =head2 Creation
  89
  90 =over 4
  91
  92 =item B<new ($name, %accessor_description, $class_initialization_arg, $default_value)>
  93
  94 =back
  95
  96 =head2 Informational
  97
  98 =over 4
  99
 100 =item B<name>
 101
 102 =item B<accessor>
 103
 104 =item B<reader>
 105
 106 =item B<writer>
 107
 108 =item B<init_arg>
 109
 110 =item B<default>
 111
 112 =back
 113
 114 =head2 Informational predicates
 115
 116 =over 4
 117
 118 =item B<has_accessor>
 119
 120 Returns true if this attribute uses a get/set accessor, and false
 121 otherwise
 122
 123 =item B<has_reader>
 124
 125 Returns true if this attribute has a reader, and false otherwise
 126
 127 =item B<has_writer>
 128
 129 Returns true if this attribute has a writer, and false otherwise
 130
 131 =item B<has_init_arg>
 132
 133 Returns true if this attribute has a class intialization argument, and
 134 false otherwise
 135
 136 =item B<has_default>
 137
 138 Returns true if this attribute has a default value, and false
 139 otherwise.
 140
 141 =back
 142
 143 =head2 Attribute Accessor generation
 144
 145 =over 4
 146
 147 =item B<generate_accessor>
 148
 149 This allows the attribute to generate code for it's own accessor
 150 methods. This is mostly part of an internal protocol between the class
 151 and it's own attributes, see the C<create_all_accessors> method above.
 152
 153 =back
 154
 155 =head1 AUTHOR
 156
 157 Stevan Little E<gt>stevan@iinteractive.comE<lt>
 158
 159 =head1 COPYRIGHT AND LICENSE
 160
 161 Copyright 2006 by Infinity Interactive, Inc.
 162
 163 L<http://www.iinteractive.com>
 164
 165 This library is free software; you can redistribute it and/or modify
 166 it under the same terms as Perl itself.
 167
 168 =cut