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 =head1 AUTHOR
  79
  80 Stevan Little E<gt>stevan@iinteractive.comE<lt>
  81
  82 =head1 COPYRIGHT AND LICENSE
  83
  84 Copyright 2006 by Infinity Interactive, Inc.
  85
  86 L<http://www.iinteractive.com>
  87
  88 This library is free software; you can redistribute it and/or modify
  89 it under the same terms as Perl itself.
  90
  91 =cut