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 { $meta->add_before_method_modifier(@_) });
  39         $meta->alias_method('after'  => sub { $meta->add_after_method_modifier(@_)  });
  40         $meta->alias_method('around' => sub { $meta->add_around_method_modifier(@_) });
  41
  42         $meta->superclasses('Moose::Object')
  43                 unless $meta->superclasses();
  44
  45         $meta->alias_method('confess' => \&confess);
  46         $meta->alias_method('blessed' => \&blessed);
  47 }
  48
  49 1;
  50
  51 __END__
  52
  53 =pod
  54
  55 =head1 NAME
  56
  57 Moose -
  58
  59 =head1 SYNOPSIS
  60
  61   package Point;
  62   use Moose;
  63
  64   has '$.x' => (reader   => 'x');
  65   has '$.y' => (accessor => 'y');
  66
  67   sub clear {
  68       my $self = shift;
  69       $self->{'$.x'} = 0;
  70       $self->y(0);
  71   }
  72
  73   package Point3D;
  74   use Moose;
  75
  76   use base 'Point';
  77
  78   has '$:z';
  79
  80   after 'clear' => sub {
  81       my $self = shift;
  82       $self->{'$:z'} = 0;
  83   };
  84
  85 =head1 DESCRIPTION
  86
  87 =head1 OTHER NAMES
  88
  89 Makes Other Object Systems Envious
  90
  91 Most Other Objects Suck Eggs
  92
  93 Makes Object Orientation So Easy
  94
  95 Metacircular Object Oriented Systems Environment
  96
  97 =head1 BUGS
  98
  99 All complex software has bugs lurking in it, and this module is no
 100 exception. If you find a bug please either email me, or add the bug
 101 to cpan-RT.
 102
 103 =head1 CODE COVERAGE
 104
 105 I use L<Devel::Cover> to test the code coverage of my tests, below is the
 106 L<Devel::Cover> report on this module's test suite.
 107
 108 =head1 ACKNOWLEDGEMENTS
 109
 110 =head1 AUTHOR
 111
 112 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 113
 114 =head1 COPYRIGHT AND LICENSE
 115
 116 Copyright 2006 by Infinity Interactive, Inc.
 117
 118 L<http://www.iinteractive.com>
 119
 120 This library is free software; you can redistribute it and/or modify
 121 it under the same terms as Perl itself.
 122
 123 =cut