lib/Moose.pm

   1
   2 use lib '/Users/stevan/CPAN/Class-MOP/Class-MOP/lib';
   3
   4 package Moose;
   5
   6 use strict;
   7 use warnings;
   8
   9 our $VERSION = '0.01';
  10
  11 use Scalar::Util 'blessed';
  12 use Carp         'confess';
  13
  14 use Moose::Meta::Class;
  15 use Moose::Meta::Attribute;
  16
  17 use Moose::Object;
  18
  19 sub import {
  20         shift;
  21         my $pkg = caller();
  22
  23         my $meta;
  24         if ($pkg->can('meta')) {
  25                 $meta = $pkg->meta();
  26                 (blessed($meta) && $meta->isa('Class::MOP::Class'))
  27                         || confess "Whoops, not møøsey enough";
  28         }
  29         else {
  30                 $meta = Moose::Meta::Class->initialize($pkg => (
  31                         ':attribute_metaclass' => 'Moose::Meta::Attribute'
  32                 ));
  33         }
  34
  35         # handle attributes
  36         $meta->alias_method('has' => sub { $meta->add_attribute(@_) });
  37
  38         # handle method modifers
  39         $meta->alias_method('before' => sub {
  40                 my $code = pop @_;
  41                 $meta->add_before_method_modifier($_, $code) for @_;
  42         });
  43         $meta->alias_method('after'  => sub {
  44                 my $code = pop @_;
  45                 $meta->add_after_method_modifier($_, $code)  for @_;
  46         });
  47         $meta->alias_method('around' => sub {
  48                 my $code = pop @_;
  49                 $meta->add_around_method_modifier($_, $code)  for @_;
  50         });
  51
  52         # make sure they inherit from Moose::Object
  53         $meta->superclasses('Moose::Object')
  54                 unless $meta->superclasses();
  55
  56         # we recommend using these things
  57         # so export them for them
  58         $meta->alias_method('confess' => \&confess);
  59         $meta->alias_method('blessed' => \&blessed);
  60 }
  61
  62 1;
  63
  64 __END__
  65
  66 =pod
  67
  68 =head1 NAME
  69
  70 Moose -
  71
  72 =head1 SYNOPSIS
  73
  74   package Point;
  75   use Moose;
  76
  77   has '$.x' => (reader   => 'x');
  78   has '$.y' => (accessor => 'y');
  79
  80   sub clear {
  81       my $self = shift;
  82       $self->{'$.x'} = 0;
  83       $self->y(0);
  84   }
  85
  86   package Point3D;
  87   use Moose;
  88
  89   use base 'Point';
  90
  91   has '$:z';
  92
  93   after 'clear' => sub {
  94       my $self = shift;
  95       $self->{'$:z'} = 0;
  96   };
  97
  98 =head1 DESCRIPTION
  99
 100 =head1 OTHER NAMES
 101
 102 Makes Other Object Systems Envious
 103
 104 Most Other Objects Suck Eggs
 105
 106 Makes Object Orientation So Easy
 107
 108 Metacircular Object Oriented Systems Environment
 109
 110 =head1 BUGS
 111
 112 All complex software has bugs lurking in it, and this module is no
 113 exception. If you find a bug please either email me, or add the bug
 114 to cpan-RT.
 115
 116 =head1 CODE COVERAGE
 117
 118 I use L<Devel::Cover> to test the code coverage of my tests, below is the
 119 L<Devel::Cover> report on this module's test suite.
 120
 121 =head1 ACKNOWLEDGEMENTS
 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