lib/Moose.pm

   1
   2 package Moose;
   3
   4 use strict;
   5 use warnings;
   6
   7 our $VERSION = '0.01';
   8
   9 use Scalar::Util 'blessed', 'reftype';
  10 use Carp         'confess';
  11 use Sub::Name    'subname';
  12
  13 use Moose::Meta::Class;
  14 use Moose::Meta::Attribute;
  15
  16 use Moose::Object;
  17 use Moose::Util::TypeConstraints ':no_export';
  18
  19 sub import {
  20         shift;
  21         my $pkg = caller();
  22
  23         Moose::Util::TypeConstraints->import($pkg);
  24
  25         my $meta;
  26         if ($pkg->can('meta')) {
  27                 $meta = $pkg->meta();
  28                 (blessed($meta) && $meta->isa('Class::MOP::Class'))
  29                         || confess "Whoops, not møøsey enough";
  30         }
  31         else {
  32                 $meta = Moose::Meta::Class->initialize($pkg => (
  33                         ':attribute_metaclass' => 'Moose::Meta::Attribute'
  34                 ));
  35                 $meta->add_method('meta' => sub {
  36                         # re-initialize so it inherits properly
  37                         Moose::Meta::Class->initialize($pkg => (
  38                                 ':attribute_metaclass' => 'Moose::Meta::Attribute'
  39                         ));
  40                 })
  41         }
  42
  43         # NOTE:
  44         # &alias_method will install the method, but it
  45         # will not name it with
  46
  47         # handle superclasses
  48         $meta->alias_method('extends' => subname 'Moose::extends' => sub { $meta->superclasses(@_) });
  49
  50         # handle attributes
  51         $meta->alias_method('has' => subname 'Moose::has' => sub {
  52                 my ($name, %options) = @_;
  53                 if (exists $options{is}) {
  54                         if ($options{is} eq 'ro') {
  55                                 $options{reader} = $name;
  56                         }
  57                         elsif ($options{is} eq 'rw') {
  58                                 $options{accessor} = $name;
  59                         }
  60                 }
  61                 if (exists $options{isa}) {
  62                         if (reftype($options{isa}) && reftype($options{isa}) eq 'CODE') {
  63                                 $options{type_constraint} = $options{isa};
  64                         }
  65                         else {
  66                                 $options{type_constraint} = Moose::Util::TypeConstraints::subtype(
  67                                         Object => Moose::Util::TypeConstraints::where { $_->isa($options{isa}) }
  68                                 );
  69                         }
  70                 }
  71                 $meta->add_attribute($name, %options)
  72         });
  73
  74         # handle method modifers
  75         $meta->alias_method('before' => subname 'Moose::before' => sub {
  76                 my $code = pop @_;
  77                 $meta->add_before_method_modifier($_, $code) for @_;
  78         });
  79         $meta->alias_method('after'  => subname 'Moose::after' => sub {
  80                 my $code = pop @_;
  81                 $meta->add_after_method_modifier($_, $code)  for @_;
  82         });
  83         $meta->alias_method('around' => subname 'Moose::around' => sub {
  84                 my $code = pop @_;
  85                 $meta->add_around_method_modifier($_, $code)  for @_;
  86         });
  87
  88         # make sure they inherit from Moose::Object
  89         $meta->superclasses('Moose::Object')
  90                 unless $meta->superclasses();
  91
  92         # we recommend using these things
  93         # so export them for them
  94         $meta->alias_method('confess' => \&confess);
  95         $meta->alias_method('blessed' => \&blessed);
  96 }
  97
  98 1;
  99
 100 __END__
 101
 102 =pod
 103
 104 =head1 NAME
 105
 106 Moose - Moose, it's the new Camel
 107
 108 =head1 SYNOPSIS
 109
 110   package Point;
 111   use Moose;
 112
 113   has 'x' => (isa => Int(), is => 'rw');
 114   has 'y' => (isa => Int(), is => 'rw');
 115
 116   sub clear {
 117       my $self = shift;
 118       $self->x(0);
 119       $self->y(0);
 120   }
 121
 122   package Point3D;
 123   use Moose;
 124
 125   extends 'Point';
 126
 127   has 'z' => (isa => Int());
 128
 129   after 'clear' => sub {
 130       my $self = shift;
 131       $self->{z} = 0;
 132   };
 133
 134 =head1 CAVEAT
 135
 136 This is a B<very> early release of this module, it still needs
 137 some fine tuning and B<lots> more documentation. I am adopting
 138 the I<release early and release often> approach with this module,
 139 so keep an eye on your favorite CPAN mirror!
 140
 141 =head1 DESCRIPTION
 142
 143 Moose is an extension of the Perl 5 object system.
 144
 145 =head2 Another object system!?!?
 146
 147 Yes, I know there has been an explosion recently of new ways to
 148 build object's in Perl 5, most of them based on inside-out objects,
 149 and other such things. Moose is different because it is not a new
 150 object system for Perl 5, but instead an extension of the existing
 151 object system.
 152
 153 Moose is built on top of L<Class::MOP>, which is a metaclass system
 154 for Perl 5. This means that Moose not only makes building normal
 155 Perl 5 objects better, but is also provides brings with it the power
 156 of metaclass programming.
 157
 158 =head2 What does Moose stand for??
 159
 160 Moose doesn't stand for one thing in particular, however, if you
 161 want, here are a few of my favorites, feel free to contribute
 162 more :)
 163
 164 =over 4
 165
 166 =item Makes Other Object Systems Envious
 167
 168 =item Makes Object Orientation So Easy
 169
 170 =back
 171
 172 =head1 BUGS
 173
 174 All complex software has bugs lurking in it, and this module is no
 175 exception. If you find a bug please either email me, or add the bug
 176 to cpan-RT.
 177
 178 =head1 AUTHOR
 179
 180 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 181
 182 =head1 COPYRIGHT AND LICENSE
 183
 184 Copyright 2006 by Infinity Interactive, Inc.
 185
 186 L<http://www.iinteractive.com>
 187
 188 This library is free software; you can redistribute it and/or modify
 189 it under the same terms as Perl itself.
 190
 191 =cut