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';
  10 use Carp         'confess';
  11
  12 use Class::MOP;
  13 use Moose::Object;
  14
  15 sub import {
  16         shift;
  17         my $pkg = caller();
  18
  19         my $meta;
  20         if ($pkg->can('meta')) {
  21                 $meta = $pkg->meta();
  22                 (blessed($meta) && $meta->isa('Class::MOP::Class'))
  23                         || confess "Whoops, not møøsey enough";
  24         }
  25         else {
  26                 $meta = Class::MOP::Class->initialize($pkg);
  27         }
  28
  29         $meta->alias_method('has' => sub {
  30                 my ($name, %options) = @_;
  31                 my ($init_arg) = ($name =~ /^[\$\@\%][\.\:](.*)$/);
  32                 $meta->add_attribute($name => (
  33                         init_arg => $init_arg,
  34                         %options,
  35                 ));
  36         });
  37
  38         $meta->alias_method('before' => sub {
  39                 my $code = pop @_;
  40                 $meta->add_before_method_modifier($_, $code) for @_;
  41         });
  42
  43         $meta->alias_method('after'  => sub {
  44                 my $code = pop @_;
  45                 $meta->add_after_method_modifier($_, $code)  for @_;
  46         });
  47
  48         $meta->alias_method('around' => sub { $meta->add_around_method_modifier(@_) });
  49
  50         $meta->superclasses('Moose::Object')
  51                 unless $meta->superclasses();
  52
  53         $meta->alias_method('confess' => \&confess);
  54         $meta->alias_method('blessed' => \&blessed);
  55 }
  56
  57 1;
  58
  59 __END__
  60
  61 =pod
  62
  63 =head1 NAME
  64
  65 Moose -
  66
  67 =head1 SYNOPSIS
  68
  69   package Point;
  70   use Moose;
  71
  72   has '$.x' => (reader   => 'x');
  73   has '$.y' => (accessor => 'y');
  74
  75   sub clear {
  76       my $self = shift;
  77       $self->{'$.x'} = 0;
  78       $self->y(0);
  79   }
  80
  81   package Point3D;
  82   use Moose;
  83
  84   use base 'Point';
  85
  86   has '$:z';
  87
  88   after 'clear' => sub {
  89       my $self = shift;
  90       $self->{'$:z'} = 0;
  91   };
  92
  93 =head1 DESCRIPTION
  94
  95 =head1 OTHER NAMES
  96
  97 Makes Other Object Systems Envious
  98
  99 Most Other Objects Suck Eggs
 100
 101 Makes Object Orientation So Easy
 102
 103 Metacircular Object Oriented Systems Environment
 104
 105 =head1 BUGS
 106
 107 All complex software has bugs lurking in it, and this module is no
 108 exception. If you find a bug please either email me, or add the bug
 109 to cpan-RT.
 110
 111 =head1 CODE COVERAGE
 112
 113 I use L<Devel::Cover> to test the code coverage of my tests, below is the
 114 L<Devel::Cover> report on this module's test suite.
 115
 116 =head1 ACKNOWLEDGEMENTS
 117
 118 =head1 AUTHOR
 119
 120 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 121
 122 =head1 COPYRIGHT AND LICENSE
 123
 124 Copyright 2006 by Infinity Interactive, Inc.
 125
 126 L<http://www.iinteractive.com>
 127
 128 This library is free software; you can redistribute it and/or modify
 129 it under the same terms as Perl itself.
 130
 131 =cut