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