lib/Mouse.pm

   1 #!perl
   2 package Mouse;
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.02';
   7 use 5.006;
   8
   9 use Sub::Exporter;
  10 use Carp 'confess';
  11 use Scalar::Util 'blessed';
  12 use Class::Method::Modifiers ();
  13
  14 use Mouse::Meta::Attribute;
  15 use Mouse::Meta::Class;
  16 use Mouse::Object;
  17 use Mouse::TypeRegistry;
  18
  19 do {
  20     my $CALLER;
  21
  22     my %exports = (
  23         meta => sub {
  24             my $meta = Mouse::Meta::Class->initialize($CALLER);
  25             return sub { $meta };
  26         },
  27
  28         extends => sub {
  29             my $caller = $CALLER;
  30             return sub {
  31                 $caller->meta->superclasses(@_);
  32             };
  33         },
  34
  35         has => sub {
  36             return sub {
  37                 my $package = caller;
  38                 my $names = shift;
  39                 $names = [$names] if !ref($names);
  40
  41                 for my $name (@$names) {
  42                     Mouse::Meta::Attribute->create($package, $name, @_);
  43                 }
  44             };
  45         },
  46
  47         confess => sub {
  48             return \&confess;
  49         },
  50
  51         blessed => sub {
  52             return \&blessed;
  53         },
  54
  55         before => sub {
  56             return \&Class::Method::Modifiers::before;
  57         },
  58
  59         after => sub {
  60             return \&Class::Method::Modifiers::after;
  61         },
  62
  63         around => sub {
  64             return \&Class::Method::Modifiers::around;
  65         },
  66     );
  67
  68     my $exporter = Sub::Exporter::build_exporter({
  69         exports => \%exports,
  70         groups  => { default => [':all'] },
  71     });
  72
  73     sub import {
  74         $CALLER = caller;
  75
  76         strict->import;
  77         warnings->import;
  78
  79         my $meta = Mouse::Meta::Class->initialize($CALLER);
  80         $meta->superclasses('Mouse::Object')
  81             unless $meta->superclasses;
  82
  83         goto $exporter;
  84     }
  85
  86     sub unimport {
  87         my $caller = caller;
  88
  89         no strict 'refs';
  90         for my $keyword (keys %exports) {
  91             next if $keyword eq 'meta'; # we don't delete this one
  92             delete ${ $caller . '::' }{$keyword};
  93         }
  94     }
  95 };
  96
  97 sub load_class {
  98     my $class = shift;
  99
 100     if (ref($class) || !defined($class) || !length($class)) {
 101         my $display = defined($class) ? $class : 'undef';
 102         confess "Invalid class name ($display)";
 103     }
 104
 105     return 1 if is_class_loaded($class);
 106
 107     (my $file = "$class.pm") =~ s{::}{/}g;
 108
 109     eval { CORE::require($file) };
 110     confess "Could not load class ($class) because : $@" if $@;
 111
 112     return 1;
 113 }
 114
 115 sub is_class_loaded {
 116     my $class = shift;
 117
 118     return 0 if ref($class) || !defined($class) || !length($class);
 119
 120     # walk the symbol table tree to avoid autovififying
 121     # \*{${main::}{"Foo::"}} == \*main::Foo::
 122
 123     my $pack = \*::;
 124     foreach my $part (split('::', $class)) {
 125         return 0 unless exists ${$$pack}{"${part}::"};
 126         $pack = \*{${$$pack}{"${part}::"}};
 127     }
 128
 129     # check for $VERSION or @ISA
 130     return 1 if exists ${$$pack}{VERSION}
 131              && defined *{${$$pack}{VERSION}}{SCALAR};
 132     return 1 if exists ${$$pack}{ISA}
 133              && defined *{${$$pack}{ISA}}{ARRAY};
 134
 135     # check for any method
 136     foreach ( keys %{$$pack} ) {
 137         next if substr($_, -2, 2) eq '::';
 138         return 1 if defined *{${$$pack}{$_}}{CODE};
 139     }
 140
 141     # fail
 142     return 0;
 143 }
 144
 145 1;
 146
 147 __END__
 148
 149 =head1 NAME
 150
 151 Mouse - Moose minus the antlers
 152
 153 =head1 VERSION
 154
 155 Version 0.02 released 11 Jun 08
 156
 157 =head1 SYNOPSIS
 158
 159     package Point;
 160     use Mouse; # automatically turns on strict and warnings
 161
 162     has 'x' => (is => 'rw', isa => 'Int');
 163     has 'y' => (is => 'rw', isa => 'Int');
 164
 165     sub clear {
 166         my $self = shift;
 167         $self->x(0);
 168         $self->y(0);
 169     }
 170
 171     package Point3D;
 172     use Mouse;
 173
 174     extends 'Point';
 175
 176     has 'z' => (is => 'rw', isa => 'Int');
 177
 178     after 'clear' => sub {
 179         my $self = shift;
 180         $self->z(0);
 181     };
 182
 183 =head1 DESCRIPTION
 184
 185 L<Moose> is wonderful.
 186
 187 Unfortunately, it's a little slow. Though significant progress has been made
 188 over the years, the compile time penalty is a non-starter for some
 189 applications.
 190
 191 Mouse aims to alleviate this by providing a subset of Moose's
 192 functionality, faster. In particular, L<Moose/has> is missing only a few
 193 expert-level features.
 194
 195 =head2 MOOSE COMPAT
 196
 197 Compatibility with Moose has been the utmost concern. Fewer than 1% of the
 198 tests fail when run against Moose instead of Mouse. Mouse code coverage is also
 199 over 99%. Even the error messages are taken from Moose. The Mouse code just
 200 runs the test suite 3x-4x faster.
 201
 202 The idea is that, if you need the extra power, you should be able to run
 203 C<s/Mouse/Moose/g> on your codebase and have nothing break. To that end,
 204 nothingmuch has written L<Squirrel> (part of this distribution) which will act
 205 as Mouse unless Moose is loaded, in which case it will act as Moose.
 206
 207 Mouse also has the blessings of Moose's author, stevan.
 208
 209 =head2 MISSING FEATURES
 210
 211 =head3 Method modifiers
 212
 213 Fixing this one next, with a reimplementation of L<Class::Method::Modifiers>.
 214
 215 =head3 Roles
 216
 217 Fixing this one slightly less soon. stevan has suggested an implementation
 218 strategy. Mouse currently mostly ignores methods.
 219
 220 =head3 Complex types
 221
 222 User-defined type constraints and parameterized types may be implemented. Type
 223 coercions probably not (patches welcome).
 224
 225 =head3 Bootstrapped meta world
 226
 227 Very handy for extensions to the MOP. Not pressing, but would be nice to have.
 228
 229 =head3 Modification of attribute metaclass
 230
 231 When you declare an attribute with L</has>, you get the inlined accessors
 232 installed immediately. Modifying the attribute metaclass, even if possible,
 233 does nothing.
 234
 235 =head3 Lots more..
 236
 237 MouseX?
 238
 239 =head1 KEYWORDS
 240
 241 =head2 meta -> Mouse::Meta::Class
 242
 243 Returns this class' metaclass instance.
 244
 245 =head2 extends superclasses
 246
 247 Sets this class' superclasses.
 248
 249 =head2 has (name|names) => parameters
 250
 251 Adds an attribute (or if passed an arrayref of names, multiple attributes) to
 252 this class. Options:
 253
 254 =over 4
 255
 256 =item is => ro|rw
 257
 258 If specified, inlines a read-only/read-write accessor with the same name as
 259 the attribute.
 260
 261 =item isa => TypeConstraint
 262
 263 Provides basic type checking in the constructor and accessor. Basic types such
 264 as C<Int>, C<ArrayRef>, C<Defined> are supported. Any unknown type is taken to
 265 be a class check (e.g. isa => 'DateTime' would accept only L<DateTime>
 266 objects).
 267
 268 =item required => 0|1
 269
 270 Whether this attribute is required to have a value. If the attribute is lazy or
 271 has a builder, then providing a value for the attribute in the constructor is
 272 optional.
 273
 274 =item init_arg => Str
 275
 276 Allows you to use a different key name in the constructor.
 277
 278 =item default => Value | CodeRef
 279
 280 Sets the default value of the attribute. If the default is a coderef, it will
 281 be invoked to get the default value. Due to quirks of Perl, any bare reference
 282 is forbidden, you must wrap the reference in a coderef. Otherwise, all
 283 instances will share the same reference.
 284
 285 =item lazy => 0|1
 286
 287 If specified, the default is calculated on demand instead of in the
 288 constructor.
 289
 290 =item predicate => Str
 291
 292 Lets you specify a method name for installing a predicate method, which checks
 293 that the attribute has a value. It will not invoke a lazy default or builder
 294 method.
 295
 296 =item clearer => Str
 297
 298 Lets you specify a method name for installing a clearer method, which clears
 299 the attribute's value from the instance. On the next read, lazy or builder will
 300 be invoked.
 301
 302 =item handles => HashRef|ArrayRef
 303
 304 Lets you specify methods to delegate to the attribute. ArrayRef forwards the
 305 given method names to method calls on the attribute. HashRef maps local method
 306 names to remote method names called on the attribute. Other forms of
 307 L</handles>, such as regular expression and coderef, are not yet supported.
 308
 309 =item weak_ref => 0|1
 310
 311 Lets you automatically weaken any reference stored in the attribute.
 312
 313 =item trigger => Coderef
 314
 315 Any time the attribute's value is set (either through the accessor or the
 316 constructor), the trigger is called on it. The trigger receives as arguments
 317 the instance, the new value, and the attribute instance.
 318
 319 =item builder => Str
 320
 321 Defines a method name to be called to provide the default value of the
 322 attribute. C<< builder => 'build_foo' >> is mostly equivalent to
 323 C<< default => sub { $_[0]->build_foo } >>.
 324
 325 =item auto_deref => 0|1
 326
 327 Allows you to automatically dereference ArrayRef and HashRef attributes in list
 328 context. In scalar context, the reference is returned (NOT the list length or
 329 bucket status). You must specify an appropriate type constraint to use
 330 auto_deref.
 331
 332 =back
 333
 334 =head2 confess error -> BOOM
 335
 336 L<Carp/confess> for your convenience.
 337
 338 =head2 blessed value -> ClassName | undef
 339
 340 L<Scalar::Util/blessed> for your convenience.
 341
 342 =head1 MISC
 343
 344 =head2 import
 345
 346 Importing Mouse will default your class' superclass list to L<Mouse::Object>.
 347 You may use L</extends> to replace the superclass list.
 348
 349 =head2 unimport
 350
 351 Please unimport Mouse (C<no Mouse>) so that if someone calls one of the
 352 keywords (such as L</extends>) it will break loudly instead breaking subtly.
 353
 354 =head1 FUNCTIONS
 355
 356 =head2 load_class Class::Name
 357
 358 This will load a given C<Class::Name> (or die if it's not loadable).
 359 This function can be used in place of tricks like
 360 C<eval "use $module"> or using C<require>.
 361
 362 =head2 is_class_loaded Class::Name -> Bool
 363
 364 Returns whether this class is actually loaded or not. It uses a heuristic which
 365 involves checking for the existence of C<$VERSION>, C<@ISA>, and any
 366 locally-defined method.
 367
 368 =head1 AUTHOR
 369
 370 Shawn M Moore, C<< <sartak at gmail.com> >>
 371
 372 with plenty of code borrowed from L<Class::MOP> and L<Moose>
 373
 374 =head1 BUGS
 375
 376 No known bugs.
 377
 378 Please report any bugs through RT: email
 379 C<bug-mouse at rt.cpan.org>, or browse
 380 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Mouse>.
 381
 382 =head1 COPYRIGHT AND LICENSE
 383
 384 Copyright 2008 Shawn M Moore.
 385
 386 This program is free software; you can redistribute it and/or modify it
 387 under the same terms as Perl itself.
 388
 389 =cut
 390