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