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

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

our $VERSION = '0.04';
use 5.006;

use Sub::Exporter;
use Carp 'confess';
use Scalar::Util 'blessed';
use Class::Method::Modifiers ();

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;
        },

        before => sub {
            return \&Class::Method::Modifiers::before;
        },

        after => sub {
            return \&Class::Method::Modifiers::after;
        },

        around => sub {
            return \&Class::Method::Modifiers::around;
        },
    );

    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 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');

    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 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 before (method|methods) => Code

Installs a "before" method modifier. See L<Moose/before> or
L<Class::Method::Modifiers/before>.

=head2 after (method|methods) => Code

Installs an "after" method modifier. See L<Moose/after> or
L<Class::Method::Modifiers/after>.

=head2 around (method|methods) => Code

Installs an "around" method modifier. See L<Moose/around> or
L<Class::Method::Modifiers/around>.

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