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

    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';
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
	153	=head1 VERSION
	154
f8b285d2	155	Version 0.02 released 11 Jun 08
c3398f5b	156
	157	=head1 SYNOPSIS
	158
	159	package Point;
6caea456	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;
c3398f5b	172	use Mouse;
c3398f5b	173
6caea456	174	extends 'Point';
c3398f5b	175
6caea456	176	has 'z' => (is => 'rw', isa => 'Int');
6caea456	177
8517d2ff	178	after 'clear' => sub {
	179	my $self = shift;
	180	$self->z(0);
	181	};
c3398f5b	182
	183	=head1 DESCRIPTION
	184
0fff36e6	185	L<Moose> is wonderful.
c3398f5b	186
0fff36e6	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
8e1a28a8	199	over 99%. Even the error messages are taken from Moose. The Mouse code just
8e1a28a8	200	runs the test suite 3x-4x faster.
0fff36e6	201
0fff36e6	202	The idea is that, if you need the extra power, you should be able to run
8e1a28a8	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.
0fff36e6	206
	207	Mouse also has the blessings of Moose's author, stevan.
	208
	209	=head2 MISSING FEATURES
	210
	211	=head3 Method modifiers
	212
dca275b5	213	Fixing this one next, with a reimplementation of L<Class::Method::Modifiers>.
0fff36e6	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
c3398f5b	240
306290e8	241	=head2 meta -> Mouse::Meta::Class
c3398f5b	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
0fff36e6	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
c3398f5b	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
6caea456	346	Importing Mouse will default your class' superclass list to L<Mouse::Object>.
c3398f5b	347	You may use L</extends> to replace the superclass list.
	348
	349	=head2 unimport
	350
0fff36e6	351	Please unimport Mouse (C<no Mouse>) so that if someone calls one of the
0fff36e6	352	keywords (such as L</extends>) it will break loudly instead breaking subtly.
c3398f5b	353
	354	=head1 FUNCTIONS
	355
	356	=head2 load_class Class::Name
	357
6caea456	358	This will load a given C<Class::Name> (or die if it's not loadable).
c3398f5b	359	This function can be used in place of tricks like
	360	C<eval "use $module"> or using C<require>.
	361
262801ef	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
c3398f5b	368	=head1 AUTHOR
	369
	370	Shawn M Moore, C<< <sartak at gmail.com> >>
	371
0fff36e6	372	with plenty of code borrowed from L<Class::MOP> and L<Moose>
0fff36e6	373
c3398f5b	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