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

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

our $VERSION = '0.01';
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.01 released 10 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 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.

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
	6	our $VERSION = '0.01';
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
dca275b5	142	Version 0.01 released 10 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
	187	over 99%. Even the error messages are taken from Moose.
	188
	189	The idea is that, if you need the extra power, you should be able to run
	190	C<s/Mouse/Moose/g> on your codebase and have nothing break.
	191
	192	Mouse also has the blessings of Moose's author, stevan.
	193
	194	=head2 MISSING FEATURES
	195
	196	=head3 Method modifiers
	197
dca275b5	198	Fixing this one next, with a reimplementation of L<Class::Method::Modifiers>.
0fff36e6	199
	200	=head3 Roles
	201
	202	Fixing this one slightly less soon. stevan has suggested an implementation
	203	strategy. Mouse currently mostly ignores methods.
	204
	205	=head3 Complex types
	206
	207	User-defined type constraints and parameterized types may be implemented. Type
	208	coercions probably not (patches welcome).
	209
	210	=head3 Bootstrapped meta world
	211
	212	Very handy for extensions to the MOP. Not pressing, but would be nice to have.
	213
	214	=head3 Modification of attribute metaclass
	215
	216	When you declare an attribute with L</has>, you get the inlined accessors
	217	installed immediately. Modifying the attribute metaclass, even if possible,
	218	does nothing.
	219
	220	=head3 Lots more..
	221
	222	MouseX?
	223
	224	=head1 KEYWORDS
c3398f5b	225
306290e8	226	=head2 meta -> Mouse::Meta::Class
c3398f5b	227
	228	Returns this class' metaclass instance.
	229
	230	=head2 extends superclasses
	231
	232	Sets this class' superclasses.
	233
	234	=head2 has (name\|names) => parameters
	235
	236	Adds an attribute (or if passed an arrayref of names, multiple attributes) to
0fff36e6	237	this class. Options:
	238
	239	=over 4
	240
	241	=item is => ro\|rw
	242
	243	If specified, inlines a read-only/read-write accessor with the same name as
	244	the attribute.
	245
	246	=item isa => TypeConstraint
	247
	248	Provides basic type checking in the constructor and accessor. Basic types such
	249	as C<Int>, C<ArrayRef>, C<Defined> are supported. Any unknown type is taken to
	250	be a class check (e.g. isa => 'DateTime' would accept only L<DateTime>
	251	objects).
	252
	253	=item required => 0\|1
	254
	255	Whether this attribute is required to have a value. If the attribute is lazy or
	256	has a builder, then providing a value for the attribute in the constructor is
	257	optional.
	258
	259	=item init_arg => Str
	260
	261	Allows you to use a different key name in the constructor.
	262
	263	=item default => Value \| CodeRef
	264
	265	Sets the default value of the attribute. If the default is a coderef, it will
	266	be invoked to get the default value. Due to quirks of Perl, any bare reference
	267	is forbidden, you must wrap the reference in a coderef. Otherwise, all
	268	instances will share the same reference.
	269
	270	=item lazy => 0\|1
	271
	272	If specified, the default is calculated on demand instead of in the
	273	constructor.
	274
	275	=item predicate => Str
	276
	277	Lets you specify a method name for installing a predicate method, which checks
	278	that the attribute has a value. It will not invoke a lazy default or builder
	279	method.
	280
	281	=item clearer => Str
	282
	283	Lets you specify a method name for installing a clearer method, which clears
	284	the attribute's value from the instance. On the next read, lazy or builder will
	285	be invoked.
	286
	287	=item handles => HashRef\|ArrayRef
	288
	289	Lets you specify methods to delegate to the attribute. ArrayRef forwards the
	290	given method names to method calls on the attribute. HashRef maps local method
	291	names to remote method names called on the attribute. Other forms of
	292	L</handles>, such as regular expression and coderef, are not yet supported.
	293
	294	=item weak_ref => 0\|1
	295
	296	Lets you automatically weaken any reference stored in the attribute.
	297
	298	=item trigger => Coderef
	299
	300	Any time the attribute's value is set (either through the accessor or the
301	constructor), the trigger is called on it. The trigger receives as arguments
302	the instance, the new value, and the attribute instance.
303
304	=item builder => Str
305
306	Defines a method name to be called to provide the default value of the
307	attribute. C<< builder => 'build_foo' >> is mostly equivalent to
308	C<< default => sub { $_[0]->build_foo } >>.
309
310	=item auto_deref => 0\|1
311
312	Allows you to automatically dereference ArrayRef and HashRef attributes in list
313	context. In scalar context, the reference is returned (NOT the list length or
314	bucket status). You must specify an appropriate type constraint to use
315	auto_deref.
316
317	=back
c3398f5b	318
	319	=head2 confess error -> BOOM
	320
	321	L<Carp/confess> for your convenience.
	322
	323	=head2 blessed value -> ClassName \| undef
	324
	325	L<Scalar::Util/blessed> for your convenience.
	326
	327	=head1 MISC
	328
	329	=head2 import
	330
6caea456	331	Importing Mouse will default your class' superclass list to L<Mouse::Object>.
c3398f5b	332	You may use L</extends> to replace the superclass list.
	333
	334	=head2 unimport
	335
0fff36e6	336	Please unimport Mouse (C<no Mouse>) so that if someone calls one of the
0fff36e6	337	keywords (such as L</extends>) it will break loudly instead breaking subtly.
c3398f5b	338
	339	=head1 FUNCTIONS
	340
	341	=head2 load_class Class::Name
	342
6caea456	343	This will load a given C<Class::Name> (or die if it's not loadable).
c3398f5b	344	This function can be used in place of tricks like
	345	C<eval "use $module"> or using C<require>.
	346
262801ef	347	=head2 is_class_loaded Class::Name -> Bool
	348
	349	Returns whether this class is actually loaded or not. It uses a heuristic which
	350	involves checking for the existence of C<$VERSION>, C<@ISA>, and any
	351	locally-defined method.
	352
c3398f5b	353	=head1 AUTHOR
	354
	355	Shawn M Moore, C<< <sartak at gmail.com> >>
	356
0fff36e6	357	with plenty of code borrowed from L<Class::MOP> and L<Moose>
0fff36e6	358
c3398f5b	359	=head1 BUGS
	360
	361	No known bugs.
	362
	363	Please report any bugs through RT: email
	364	C<bug-mouse at rt.cpan.org>, or browse
	365	L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Mouse>.
	366
	367	=head1 COPYRIGHT AND LICENSE
	368
	369	Copyright 2008 Shawn M Moore.
	370
	371	This program is free software; you can redistribute it and/or modify it
	372	under the same terms as Perl itself.
	373
	374	=cut
	375