Revision history for Perl extension Moose
+0.16
+ ~~ NOTE:
+ ~~ some speed improvements in this release,
+ ~~ this is only the begining, so stay tuned
+
+ * Moose::Object
+ - BUILDALL and DEMOLISHALL no longer get
+ called unless they actually need to be.
+ This gave us a signifigant speed boost
+ for the cases when there is no BUILD or
+ DEMOLISH method present.
+
+ * Moose::Util::TypeConstraints
+ * Moose::Meta::TypeConstraint
+ - added an 'optimize_as' option to the
+ type constraint, which allows for a
+ hand optimized version of the type
+ constraint to be used when possible.
+ - Any internally created type constraints
+ now provide an optimized version as well.
+
0.15 Sun. Nov. 5, 2006
++ NOTE ++
This version of Moose *must* have Class::MOP 0.36 in order
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+my $num_iterations = shift || 100;
+
+{
+ package Foo;
+ use Moose;
+
+ has 'default' => (is => 'rw', default => 10);
+ has 'default_sub' => (is => 'rw', default => sub { [] });
+ has 'lazy' => (is => 'rw', default => 10, lazy => 1);
+ has 'required' => (is => 'rw', required => 1);
+ has 'weak_ref' => (is => 'rw', weak_ref => 1);
+ has 'type_constraint' => (is => 'rw', isa => 'ArrayRef');
+}
+
+foreach (0 .. $num_iterations) {
+ my $foo = Foo->new(
+ required => 'BAR',
+ type_constraint => [],
+ weak_ref => {},
+ );
+}
\ No newline at end of file
has 'baz' => (is => 'rw');
has 'bar' => (is => 'rw', isa => 'Foo');
- #has 'boo' => (is => 'rw', isa => type 'CustomFoo' => where { blessed($_) && $_->isa('Foo') });
}
my $foo = Foo->new;
},
'w_constraint' => sub {
$foo->bar($foo);
- },
- #'w_custom_constraint' => sub {
- # $foo->boo($foo);
- #},
+ },
}
);
use strict;
use warnings;
-our $VERSION = '0.15';
+our $VERSION = '0.16';
use Scalar::Util 'blessed', 'reftype';
use Carp 'confess';
subtype $class
=> as 'Object'
=> where { $_->isa($class) }
+ => optimize_as { blessed($_[0]) && $_[0]->isa($class) }
unless find_type_constraint($class);
my $meta;
use Carp 'confess';
use Scalar::Util 'weaken', 'blessed', 'reftype';
-our $VERSION = '0.08';
+our $VERSION = '0.09';
use Moose::Meta::Method::Overriden;
return $map;
}
-#sub find_method_by_name {
-# my ($self, $method_name) = @_;
-# (defined $method_name && $method_name)
-# || confess "You must define a method name to find";
-# # keep a record of what we have seen
-# # here, this will handle all the
-# # inheritence issues because we are
-# # using the &class_precedence_list
-# my %seen_class;
-# foreach my $class ($self->class_precedence_list()) {
-# next if $seen_class{$class};
-# $seen_class{$class}++;
-# # fetch the meta-class ...
-# my $meta = $self->initialize($class);
-# return $meta->get_method($method_name)
-# if $meta->has_method($method_name);
-# }
-#}
-
### ---------------------------------------------
sub add_attribute {
use Carp 'confess';
-our $VERSION = '0.01';
+our $VERSION = '0.02';
use base 'Moose::Meta::Method',
'Class::MOP::Method::Accessor';
return $sub;
}
+## normal method generators
+
+*generate_reader_method = \&generate_reader_method_inline;
+*generate_writer_method = \&generate_writer_method_inline;
+*generate_accessor_method = \&generate_accessor_method_inline;
+
## ... private helpers
sub _inline_check_constraint {
=over 4
+=item B<generate_accessor_method>
+
+=item B<generate_reader_method>
+
+=item B<generate_writer_method>
+
=item B<generate_accessor_method_inline>
=item B<generate_reader_method_inline>
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.06';
+our $VERSION = '0.07';
use Moose::Meta::TypeConstraint::Union;
accessor => '_compiled_type_constraint'
));
+__PACKAGE__->meta->add_attribute('hand_optimized_type_constraint' => (
+ init_arg => 'optimized',
+ accessor => 'hand_optimized_type_constraint',
+ predicate => 'has_hand_optimized_type_constraint',
+));
+
sub new {
my $class = shift;
my $self = $class->meta->new_object(@_);
my @parents;
my $current = $self->parent;
while (defined $current) {
- unshift @parents => $current;
+ push @parents => $current;
$current = $current->parent;
}
return @parents;
sub compile_type_constraint {
my $self = shift;
+
+ if ($self->has_hand_optimized_type_constraint) {
+ my $type_constraint = $self->hand_optimized_type_constraint;
+ $self->_compiled_type_constraint(sub {
+ return undef unless $type_constraint->($_[0]);
+ return 1;
+ });
+ return;
+ }
+
my $check = $self->constraint;
(defined $check)
|| confess "Could not compile type constraint '" . $self->name . "' because no constraint check";
# we have a subtype ...
# so we gather all the parents in order
# and grab their constraints ...
- my @parents = map { $_->constraint } $self->_collect_all_parents;
+ my @parents;
+ foreach my $parent ($self->_collect_all_parents) {
+ if ($parent->has_hand_optimized_type_constraint) {
+ unshift @parents => $parent->hand_optimized_type_constraint;
+ last;
+ }
+ else {
+ unshift @parents => $parent->constraint;
+ }
+ }
+
# then we compile them to run without
# having to recurse as we did before
$self->_compiled_type_constraint(subname $self->name => sub {
}
return undef unless $check->($_[0]);
1;
- });
-
+ });
}
else {
# we have a type ....
=item B<coercion>
+=item B<hand_optimized_type_constraint>
+
+=item B<has_hand_optimized_type_constraint>
+
=back
=over 4
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
-=cut
\ No newline at end of file
+=cut
use Carp 'confess';
-our $VERSION = '0.06';
+our $VERSION = '0.07';
sub new {
my $class = shift;
}
sub BUILDALL {
+ return unless $_[0]->can('BUILD');
my ($self, $params) = @_;
foreach my $method (reverse $self->meta->find_all_methods_by_name('BUILD')) {
$method->{code}->($self, $params);
}
sub DEMOLISHALL {
+ return unless $_[0]->can('DEMOLISH');
my $self = shift;
foreach my $method ($self->meta->find_all_methods_by_name('DEMOLISH')) {
$method->{code}->($self);
use Sub::Exporter;
-our $VERSION = '0.05';
+our $VERSION = '0.06';
use Moose ();
subtype $role
=> as 'Role'
=> where { $_->does($role) }
+ => optimize_as { blessed($_[0]) && $_[0]->can('does') && $_[0]->does($role) }
unless find_type_constraint($role);
my $meta;
use B 'svref_2object';
use Sub::Exporter;
-our $VERSION = '0.09';
+our $VERSION = '0.10';
use Moose::Meta::TypeConstraint;
use Moose::Meta::TypeCoercion;
my @exports = qw/
- type subtype as where message
+ type subtype as where message optimize_as
coerce from via
enum
find_type_constraint
Data::Dumper::Dumper(\%TYPES);
}
- sub _create_type_constraint ($$$;$) {
- my ($name, $parent, $check, $message) = @_;
+ sub _create_type_constraint ($$$;$$) {
+ my $name = shift;
+ my $parent = shift;
+ my $check = shift;;
+
+ my ($message, $optimized);
+ for (@_) {
+ $message = $_->{message} if exists $_->{message};
+ $optimized = $_->{optimized} if exists $_->{optimized};
+ }
+
my $pkg_defined_in = scalar(caller(1));
($TYPES{$name}->[0] eq $pkg_defined_in)
|| confess "The type constraint '$name' has already been created "
parent => $parent,
constraint => $check,
message => $message,
+ optimized => $optimized,
);
$TYPES{$name} = [ $pkg_defined_in, $constraint ] if defined $name;
return $constraint;
_create_type_constraint($name, undef, $check);
}
-sub subtype ($$;$$) {
- unshift @_ => undef if scalar @_ <= 2;
+sub subtype ($$;$$$) {
+ unshift @_ => undef if scalar @_ <= 2;
goto &_create_type_constraint;
}
sub from ($) { $_[0] }
sub where (&) { $_[0] }
sub via (&) { $_[0] }
-sub message (&) { $_[0] }
+
+sub message (&) { +{ message => $_[0] } }
+sub optimize_as (&) { +{ optimized => $_[0] } }
sub enum ($;@) {
my ($type_name, @values) = @_;
subtype 'Undef' => as 'Item' => where { !defined($_) };
subtype 'Defined' => as 'Item' => where { defined($_) };
-subtype 'Bool' => as 'Item' => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' };
-
-subtype 'Value' => as 'Defined' => where { !ref($_) };
-subtype 'Ref' => as 'Defined' => where { ref($_) };
+subtype 'Bool'
+ => as 'Item'
+ => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' };
-subtype 'Str' => as 'Value' => where { 1 };
-
-subtype 'Num' => as 'Value' => where { Scalar::Util::looks_like_number($_) };
-subtype 'Int' => as 'Num' => where { "$_" =~ /^-?[0-9]+$/ };
-
-subtype 'ScalarRef' => as 'Ref' => where { ref($_) eq 'SCALAR' };
-subtype 'ArrayRef' => as 'Ref' => where { ref($_) eq 'ARRAY' };
-subtype 'HashRef' => as 'Ref' => where { ref($_) eq 'HASH' };
-subtype 'CodeRef' => as 'Ref' => where { ref($_) eq 'CODE' };
-subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' };
-subtype 'GlobRef' => as 'Ref' => where { ref($_) eq 'GLOB' };
+subtype 'Value'
+ => as 'Defined'
+ => where { !ref($_) }
+ => optimize_as { defined($_[0]) && !ref($_[0]) };
+
+subtype 'Ref'
+ => as 'Defined'
+ => where { ref($_) }
+ => optimize_as { ref($_[0]) };
+
+subtype 'Str'
+ => as 'Value'
+ => where { 1 }
+ => optimize_as { defined($_[0]) && !ref($_[0]) };
+
+subtype 'Num'
+ => as 'Value'
+ => where { Scalar::Util::looks_like_number($_) }
+ => optimize_as { !ref($_[0]) && Scalar::Util::looks_like_number($_[0]) };
+
+subtype 'Int'
+ => as 'Num'
+ => where { "$_" =~ /^-?[0-9]+$/ }
+ => optimize_as { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ };
+
+subtype 'ScalarRef' => as 'Ref' => where { ref($_) eq 'SCALAR' } => optimize_as { ref($_[0]) eq 'SCALAR' };
+subtype 'ArrayRef' => as 'Ref' => where { ref($_) eq 'ARRAY' } => optimize_as { ref($_[0]) eq 'ARRAY' };
+subtype 'HashRef' => as 'Ref' => where { ref($_) eq 'HASH' } => optimize_as { ref($_[0]) eq 'HASH' };
+subtype 'CodeRef' => as 'Ref' => where { ref($_) eq 'CODE' } => optimize_as { ref($_[0]) eq 'CODE' };
+subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' } => optimize_as { ref($_[0]) eq 'Regexp' };
+subtype 'GlobRef' => as 'Ref' => where { ref($_) eq 'GLOB' } => optimize_as { ref($_[0]) eq 'GLOB' };
# NOTE:
# scalar filehandles are GLOB refs,
# but a GLOB ref is not always a filehandle
-subtype 'FileHandle' => as 'GlobRef' => where { Scalar::Util::openhandle($_) };
+subtype 'FileHandle'
+ => as 'GlobRef'
+ => where { Scalar::Util::openhandle($_) }
+ => optimize_as { ref($_[0]) eq 'GLOB' && Scalar::Util::openhandle($_[0]) };
# NOTE:
# blessed(qr/.../) returns true,.. how odd
-subtype 'Object' => as 'Ref' => where { blessed($_) && blessed($_) ne 'Regexp' };
+subtype 'Object'
+ => as 'Ref'
+ => where { blessed($_) && blessed($_) ne 'Regexp' }
+ => optimize_as { blessed($_[0]) && blessed($_[0]) ne 'Regexp' };
-subtype 'Role' => as 'Object' => where { $_->can('does') };
+subtype 'Role'
+ => as 'Object'
+ => where { $_->can('does') }
+ => optimize_as { blessed($_[0]) && $_[0]->can('does') };
1;
This is just sugar for the type constraint construction syntax.
+=item B<optimize_as>
+
=back
=head2 Type Coercion Constructors
projects / gitmo/Moose.git / commitdiff