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