[gitmo/Mouse.git] / lib / Mouse.pm

#!perl
package Mouse;
use strict;
use warnings;

our $VERSION = '0.02';
use 5.006;

use Sub::Exporter;
use Carp 'confess';
use Scalar::Util 'blessed';

use Mouse::Meta::Attribute;
use Mouse::Meta::Class;
use Mouse::Object;
use Mouse::TypeRegistry;

do {
    my $CALLER;

    my %exports = (
        meta => sub {
            my $meta = Mouse::Meta::Class->initialize($CALLER);
            return sub { $meta };
        },

        extends => sub {
            my $caller = $CALLER;
            return sub {
                $caller->meta->superclasses(@_);
            };
        },

        has => sub {
            return sub {
                my $package = caller;
                my $names = shift;
                $names = [$names] if !ref($names);

                for my $name (@$names) {
                    Mouse::Meta::Attribute->create($package, $name, @_);
                }
            };
        },

        confess => sub {
            return \&confess;
        },

        blessed => sub {
            return \&blessed;
        },
    );

    my $exporter = Sub::Exporter::build_exporter({
        exports => \%exports,
        groups  => { default => [':all'] },
    });

    sub import {
        $CALLER = caller;

        strict->import;
        warnings->import;

        my $meta = Mouse::Meta::Class->initialize($CALLER);
        $meta->superclasses('Mouse::Object')
            unless $meta->superclasses;

        goto $exporter;
    }

    sub unimport {
        my $caller = caller;

        no strict 'refs';
        for my $keyword (keys %exports) {
            next if $keyword eq 'meta'; # we don't delete this one
            delete ${ $caller . '::' }{$keyword};
        }
    }
};

sub load_class {
    my $class = shift;

    if (ref($class) || !defined($class) || !length($class)) {
        my $display = defined($class) ? $class : 'undef';
        confess "Invalid class name ($display)";
    }

    return 1 if is_class_loaded($class);

    (my $file = "$class.pm") =~ s{::}{/}g;

    eval { CORE::require($file) };
    confess "Could not load class ($class) because : $@" if $@;

    return 1;
}

sub is_class_loaded {
    my $class = shift;

    return 0 if ref($class) || !defined($class) || !length($class);

    # walk the symbol table tree to avoid autovififying
    # \*{${main::}{"Foo::"}} == \*main::Foo::

    my $pack = \*::;
    foreach my $part (split('::', $class)) {
        return 0 unless exists ${$$pack}{"${part}::"};
        $pack = \*{${$$pack}{"${part}::"}};
    }

    # check for $VERSION or @ISA
    return 1 if exists ${$$pack}{VERSION}
             && defined *{${$$pack}{VERSION}}{SCALAR};
    return 1 if exists ${$$pack}{ISA}
             && defined *{${$$pack}{ISA}}{ARRAY};

    # check for any method
    foreach ( keys %{$$pack} ) {
        next if substr($_, -2, 2) eq '::';
        return 1 if defined *{${$$pack}{$_}}{CODE};
    }

    # fail
    return 0;
}

1;

__END__

=head1 NAME

Mouse - Moose minus the antlers

=head1 VERSION

Version 0.02 released 11 Jun 08

=head1 SYNOPSIS

    package Point;
    use Mouse; # automatically turns on strict and warnings

    has 'x' => (is => 'rw', isa => 'Int');
    has 'y' => (is => 'rw', isa => 'Int');

    sub clear {
        my $self = shift;
        $self->x(0);
        $self->y(0);
    }

    package Point3D;
    use Mouse;

    extends 'Point';

    has 'z' => (is => 'rw', isa => 'Int');

    # not implemented yet :)
    #after 'clear' => sub {
    #    my $self = shift;
    #    $self->z(0);
    #};

=head1 DESCRIPTION

L<Moose> is wonderful.

Unfortunately, it's a little slow. Though significant progress has been made
over the years, the compile time penalty is a non-starter for some
applications.

Mouse aims to alleviate this by providing a subset of Moose's
functionality, faster. In particular, L<Moose/has> is missing only a few
expert-level features.

=head2 MOOSE COMPAT

Compatibility with Moose has been the utmost concern. Fewer than 1% of the
tests fail when run against Moose instead of Mouse. Mouse code coverage is also
over 99%. Even the error messages are taken from Moose. The Mouse code just
runs the test suite 3x-4x faster.

The idea is that, if you need the extra power, you should be able to run
C<s/Mouse/Moose/g> on your codebase and have nothing break. To that end,
nothingmuch has written L<Squirrel> (part of this distribution) which will act
as Mouse unless Moose is loaded, in which case it will act as Moose.

Mouse also has the blessings of Moose's author, stevan.

=head2 MISSING FEATURES

=head3 Method modifiers

Fixing this one next, with a reimplementation of L<Class::Method::Modifiers>.

=head3 Roles

Fixing this one slightly less soon. stevan has suggested an implementation
strategy. Mouse currently mostly ignores methods.

=head3 Complex types

User-defined type constraints and parameterized types may be implemented. Type
coercions probably not (patches welcome).

=head3 Bootstrapped meta world

Very handy for extensions to the MOP. Not pressing, but would be nice to have.

=head3 Modification of attribute metaclass

When you declare an attribute with L</has>, you get the inlined accessors
installed immediately. Modifying the attribute metaclass, even if possible,
does nothing.

=head3 Lots more..

MouseX?

=head1 KEYWORDS

=head2 meta -> Mouse::Meta::Class

Returns this class' metaclass instance.

=head2 extends superclasses

Sets this class' superclasses.

=head2 has (name|names) => parameters

Adds an attribute (or if passed an arrayref of names, multiple attributes) to
this class. Options:

=over 4

=item is => ro|rw

If specified, inlines a read-only/read-write accessor with the same name as
the attribute.

=item isa => TypeConstraint

Provides basic type checking in the constructor and accessor. Basic types such
as C<Int>, C<ArrayRef>, C<Defined> are supported. Any unknown type is taken to
be a class check (e.g. isa => 'DateTime' would accept only L<DateTime>
objects).

=item required => 0|1

Whether this attribute is required to have a value. If the attribute is lazy or
has a builder, then providing a value for the attribute in the constructor is
optional.

=item init_arg => Str

Allows you to use a different key name in the constructor.

=item default => Value | CodeRef

Sets the default value of the attribute. If the default is a coderef, it will
be invoked to get the default value. Due to quirks of Perl, any bare reference
is forbidden, you must wrap the reference in a coderef. Otherwise, all
instances will share the same reference.

=item lazy => 0|1

If specified, the default is calculated on demand instead of in the
constructor.

=item predicate => Str

Lets you specify a method name for installing a predicate method, which checks
that the attribute has a value. It will not invoke a lazy default or builder
method.

=item clearer => Str

Lets you specify a method name for installing a clearer method, which clears
the attribute's value from the instance. On the next read, lazy or builder will
be invoked.

=item handles => HashRef|ArrayRef

Lets you specify methods to delegate to the attribute. ArrayRef forwards the
given method names to method calls on the attribute. HashRef maps local method
names to remote method names called on the attribute. Other forms of
L</handles>, such as regular expression and coderef, are not yet supported.

=item weak_ref => 0|1

Lets you automatically weaken any reference stored in the attribute.

=item trigger => Coderef

Any time the attribute's value is set (either through the accessor or the
constructor), the trigger is called on it. The trigger receives as arguments
the instance, the new value, and the attribute instance.

=item builder => Str

Defines a method name to be called to provide the default value of the
attribute. C<< builder => 'build_foo' >> is mostly equivalent to
C<< default => sub { $_[0]->build_foo } >>.

=item auto_deref => 0|1

Allows you to automatically dereference ArrayRef and HashRef attributes in list
context. In scalar context, the reference is returned (NOT the list length or
bucket status). You must specify an appropriate type constraint to use
auto_deref.

=back

=head2 confess error -> BOOM

L<Carp/confess> for your convenience.

=head2 blessed value -> ClassName | undef

L<Scalar::Util/blessed> for your convenience.

=head1 MISC

=head2 import

Importing Mouse will default your class' superclass list to L<Mouse::Object>.
You may use L</extends> to replace the superclass list.

=head2 unimport

Please unimport Mouse (C<no Mouse>) so that if someone calls one of the
keywords (such as L</extends>) it will break loudly instead breaking subtly.

=head1 FUNCTIONS

=head2 load_class Class::Name

This will load a given C<Class::Name> (or die if it's not loadable).
This function can be used in place of tricks like
C<eval "use $module"> or using C<require>.

=head2 is_class_loaded Class::Name -> Bool

Returns whether this class is actually loaded or not. It uses a heuristic which
involves checking for the existence of C<$VERSION>, C<@ISA>, and any
locally-defined method.

=head1 AUTHOR

Shawn M Moore, C<< <sartak at gmail.com> >>

with plenty of code borrowed from L<Class::MOP> and L<Moose>

=head1 BUGS

No known bugs.

Please report any bugs through RT: email
C<bug-mouse at rt.cpan.org>, or browse
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Mouse>.

=head1 COPYRIGHT AND LICENSE

Copyright 2008 Shawn M Moore.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

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