lib/Mouse.pm

   1 #!perl
   2 package Mouse;
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.01';
   7
   8 use Sub::Exporter;
   9 use Carp 'confess';
  10 use Scalar::Util 'blessed';
  11
  12 use Mouse::Attribute;
  13 use Mouse::Class;
  14 use Mouse::Object;
  15 use Mouse::TypeRegistry;
  16
  17 do {
  18     my $CALLER;
  19
  20     my %exports = (
  21         meta => sub {
  22             my $meta = Mouse::Class->initialize($CALLER);
  23             return sub { $meta };
  24         },
  25
  26         extends => sub {
  27             my $caller = $CALLER;
  28             return sub {
  29                 $caller->meta->superclasses(@_);
  30             };
  31         },
  32
  33         has => sub {
  34             return sub {
  35                 my $package = caller;
  36                 my $names = shift;
  37                 $names = [$names] if !ref($names);
  38
  39                 for my $name (@$names) {
  40                     Mouse::Attribute->create($package, $name, @_);
  41                 }
  42             };
  43         },
  44
  45         confess => sub {
  46             return \&Carp::confess;
  47         },
  48
  49         blessed => sub {
  50             return \&Scalar::Util::blessed;
  51         },
  52     );
  53
  54     my $exporter = Sub::Exporter::build_exporter({
  55         exports => \%exports,
  56         groups  => { default => [':all'] },
  57     });
  58
  59     sub import {
  60         $CALLER = caller;
  61
  62         strict->import;
  63         warnings->import;
  64
  65         no strict 'refs';
  66         @{ $CALLER . '::ISA' } = 'Mouse::Object';
  67
  68         goto $exporter;
  69     }
  70
  71     sub unimport {
  72         my $caller = caller;
  73
  74         no strict 'refs';
  75         for my $keyword (keys %exports) {
  76             next if $keyword eq 'meta'; # we don't delete this one
  77             delete ${ $caller . '::' }{$keyword};
  78         }
  79     }
  80 };
  81
  82 sub load_class {
  83     my $class = shift;
  84
  85     (my $file = "$class.pm") =~ s{::}{/}g;
  86
  87     eval { CORE::require($file) };
  88     confess "Could not load class ($class) because : $@"
  89         if $@
  90         && $@ !~ /^Can't locate .*? at /;
  91
  92     return 1;
  93 }
  94
  95 1;
  96
  97 __END__
  98
  99 =head1 NAME
 100
 101 Mouse - miniature Moose near the speed of light
 102
 103 =head1 VERSION
 104
 105 Version 0.01 released ???
 106
 107 =head1 SYNOPSIS
 108
 109     package Point;
 110     use Mouse;
 111
 112     has x => (
 113         is => 'rw',
 114     );
 115
 116     has y => (
 117         is        => 'rw',
 118         default   => 0,
 119         predicate => 'has_y',
 120         clearer   => 'clear_y',
 121     );
 122
 123 =head1 DESCRIPTION
 124
 125 Moose.
 126
 127 =head1 INTERFACE
 128
 129 =head2 meta -> Mouse::Class
 130
 131 Returns this class' metaclass instance.
 132
 133 =head2 extends superclasses
 134
 135 Sets this class' superclasses.
 136
 137 =head2 has (name|names) => parameters
 138
 139 Adds an attribute (or if passed an arrayref of names, multiple attributes) to
 140 this class.
 141
 142 =head2 confess error -> BOOM
 143
 144 L<Carp/confess> for your convenience.
 145
 146 =head2 blessed value -> ClassName | undef
 147
 148 L<Scalar::Util/blessed> for your convenience.
 149
 150 =head1 MISC
 151
 152 =head2 import
 153
 154 Importing Mouse will set your class' superclass list to L<Mouse::Object>.
 155 You may use L</extends> to replace the superclass list.
 156
 157 =head2 unimport
 158
 159 Please unimport Mouse so that if someone calls one of the keywords (such as
 160 L</extends>) it will break loudly instead breaking subtly.
 161
 162 =head1 FUNCTIONS
 163
 164 =head2 load_class Class::Name
 165
 166 This will load a given Class::Name> (or die if it's not loadable).
 167 This function can be used in place of tricks like
 168 C<eval "use $module"> or using C<require>.
 169
 170 =head1 AUTHOR
 171
 172 Shawn M Moore, C<< <sartak at gmail.com> >>
 173
 174 =head1 BUGS
 175
 176 No known bugs.
 177
 178 Please report any bugs through RT: email
 179 C<bug-mouse at rt.cpan.org>, or browse
 180 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Mouse>.
 181
 182 =head1 COPYRIGHT AND LICENSE
 183
 184 Copyright 2008 Shawn M Moore.
 185
 186 This program is free software; you can redistribute it and/or modify it
 187 under the same terms as Perl itself.
 188
 189 =cut
 190