-# auto-generated shipit config file.\r
-steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist\r
-\r
-git.tagpattern = %v\r
-git.push_to = origin\r
-\r
-CheckChangeLog.files = Changes\r
+# auto-generated shipit config file.
+steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist
+
+git.tagpattern = %v
+git.push_to = origin
+
+CheckChangeLog.files = Changes
use 5.006;
use base 'Exporter';
-our $VERSION = '0.32';
+our $VERSION = '0.33';
sub moose_version(){ 0.90 } # which Mouse is a subset of
-package Mouse::Meta::Method;\r
-use strict;\r
-use warnings;\r
-\r
-use overload\r
- '&{}' => 'body',\r
- fallback => 1,\r
-;\r
-\r
-sub new{\r
- my($class, %args) = @_;\r
-\r
- return bless \%args, $class;\r
-}\r
-\r
-sub body { $_[0]->{body} }\r
-sub name { $_[0]->{name} }\r
-sub package{ $_[0]->{name} }\r
-\r
-\r
-1;\r
-\r
-__END__\r
+package Mouse::Meta::Method;
+use strict;
+use warnings;
+
+use overload
+ '&{}' => 'body',
+ fallback => 1,
+;
+
+sub new{
+ my($class, %args) = @_;
+
+ return bless \%args, $class;
+}
+
+sub body { $_[0]->{body} }
+sub name { $_[0]->{name} }
+sub package{ $_[0]->{name} }
+
+
+1;
+
+__END__
foreach my $handle_name (keys %handles) {
my $method_to_call = $handles{$handle_name};
- my $code = sub {\r
- my $instance = shift;\r
- my $proxy = $instance->$reader();\r
-\r
- my $error = !defined($proxy) ? ' is not defined'\r
- : ref($proxy) && !blessed($proxy) ? qq{ is not an object (got '$proxy')}\r
- : undef;\r
+ my $code = sub {
+ my $instance = shift;
+ my $proxy = $instance->$reader();
+
+ my $error = !defined($proxy) ? ' is not defined'
+ : ref($proxy) && !blessed($proxy) ? qq{ is not an object (got '$proxy')}
+ : undef;
if ($error) {
- $instance->meta->throw_error(\r
- "Cannot delegate $handle_name to $method_to_call because "\r
- . "the value of "\r
- . $attribute->name\r
+ $instance->meta->throw_error(
+ "Cannot delegate $handle_name to $method_to_call because "
+ . "the value of "
+ . $attribute->name
. $error
- );\r
- }\r
- $proxy->$method_to_call(@_);\r
+ );
+ }
+ $proxy->$method_to_call(@_);
};
$class->add_method($handle_name => $code);
}
sub initialize {
my($class, $package_name, @args) = @_;
- ($package_name && !ref($package_name))\r
- || $class->throw_error("You must pass a package name and it cannot be blessed");\r
+ ($package_name && !ref($package_name))
+ || $class->throw_error("You must pass a package name and it cannot be blessed");
return $METACLASS_CACHE{$package_name}
||= $class->_new(package => $package_name, @args);
*{ $pkg . '::' . $name } = $code;
}
-sub _code_is_mine { # taken from Class::MOP::Class\r
- my ( $self, $code ) = @_;\r
-\r
- my ( $code_package, $code_name ) = get_code_info($code);\r
-\r
- return $code_package && $code_package eq $self->name\r
- || ( $code_package eq 'constant' && $code_name eq '__ANON__' );\r
+sub _code_is_mine { # taken from Class::MOP::Class
+ my ( $self, $code ) = @_;
+
+ my ( $code_package, $code_name ) = get_code_info($code);
+
+ return $code_package && $code_package eq $self->name
+ || ( $code_package eq 'constant' && $code_name eq '__ANON__' );
}
sub has_method {
return undef;
}
-sub get_method_list {\r
+sub get_method_list {
my($self) = @_;
-\r
- return grep { $self->has_method($_) } keys %{ $self->namespace };\r
+
+ return grep { $self->has_method($_) } keys %{ $self->namespace };
}
{
# anonymous but immortal
if(!$mortal){
- # something like Super::Class|Super::Class::2=Role|Role::1\r
- $cache_key = join '=' => (\r
- join('|', @{$options{superclasses} || []}),\r
- join('|', sort @{$options{roles} || []}),\r
+ # something like Super::Class|Super::Class::2=Role|Role::1
+ $cache_key = join '=' => (
+ join('|', @{$options{superclasses} || []}),
+ join('|', sort @{$options{roles} || []}),
);
return $IMMORTALS{$cache_key} if exists $IMMORTALS{$cache_key};
}
my($class, $message, %args) = @_;
local $Carp::CarpLevel = $Carp::CarpLevel + 1 + ($args{depth} || 0);
- local $Carp::MaxArgNums = 20; # default is 8, usually we use named args which gets messier though\r
+ local $Carp::MaxArgNums = 20; # default is 8, usually we use named args which gets messier though
if(exists $args{longmess} && !$args{longmess}){ # intentionaly longmess => 0
Carp::croak($message);
my $attr = $role->get_attribute($attr_name);
my $c = $attr_provided{$attr_name};
if($c && $c != $attr){
- $class->throw_error("We have encountered an attribute conflict with '$attr_name' "\r
+ $class->throw_error("We have encountered an attribute conflict with '$attr_name' "
. "during composition. This is fatal error and cannot be disambiguated.")
}
else{
my $override = $role->get_override_method_modifier($method_name);
my $c = $override_provided{$method_name};
if($c && $c != $override){
- $class->throw_error( "We have encountered an 'override' method conflict with '$method_name' during "\r
- . "composition (Two 'override' methods of the same name encountered). "\r
+ $class->throw_error( "We have encountered an 'override' method conflict with '$method_name' during "
+ . "composition (Two 'override' methods of the same name encountered). "
. "This is fatal error.")
}
else{
if($self->has_method($method_name)){
# This error happens in the override keyword or during role composition,
# so I added a message, "A local method of ...", only for compatibility (gfx)
- $self->throw_error("Cannot add an override of method '$method_name' "\r
+ $self->throw_error("Cannot add an override of method '$method_name' "
. "because there is a local version of '$method_name'"
. "(A local method of the same name as been found)");
}
$self->{override_method_modifiers}->{$method_name} = $method;
}
-sub has_override_method_modifier {\r
- my ($self, $method_name) = @_;\r
- return exists $self->{override_method_modifiers}->{$method_name};\r
-}\r
-\r
-sub get_override_method_modifier {\r
- my ($self, $method_name) = @_;\r
- return $self->{override_method_modifiers}->{$method_name};\r
+sub has_override_method_modifier {
+ my ($self, $method_name) = @_;
+ return exists $self->{override_method_modifiers}->{$method_name};
+}
+
+sub get_override_method_modifier {
+ my ($self, $method_name) = @_;
+ return $self->{override_method_modifiers}->{$method_name};
}
sub get_method_modifier_list {
-package Mouse::Meta::Role::Method;\r
-use strict;\r
-use warnings;\r
-\r
-use base qw(Mouse::Meta::Method);\r
-\r
-1;\r
-\r
-__END__\r
-\r
+package Mouse::Meta::Role::Method;
+use strict;
+use warnings;
+
+use base qw(Mouse::Meta::Method);
+
+1;
+
+__END__
+
}
sub validate {
- my ($self, $value) = @_;\r
- if ($self->{_compiled_type_constraint}->($value)) {\r
- return undef;\r
- }\r
- else {\r
- $self->get_message($value);\r
- }\r
+ my ($self, $value) = @_;
+ if ($self->{_compiled_type_constraint}->($value)) {
+ return undef;
+ }
+ else {
+ $self->get_message($value);
+ }
}
-sub assert_valid {\r
- my ($self, $value) = @_;\r
-\r
- my $error = $self->validate($value);\r
- return 1 if ! defined $error;\r
+sub assert_valid {
+ my ($self, $value) = @_;
+
+ my $error = $self->validate($value);
+ return 1 if ! defined $error;
- Carp::confess($error);\r
-}\r
+ Carp::confess($error);
+}
sub message {
}
sub does_role{
- my ($class_or_obj, $role) = @_;\r
-\r
- my $meta = Mouse::Meta::Module::class_of($class_or_obj);\r
-\r
- return 0 unless defined $meta;\r
- return 1 if $meta->does_role($role);\r
+ my ($class_or_obj, $role) = @_;
+
+ my $meta = Mouse::Meta::Module::class_of($class_or_obj);
+
+ return 0 unless defined $meta;
+ return 1 if $meta->does_role($role);
return 0;
}
}
{ # taken from Sub::Identify
- sub get_code_info($) {\r
- my ($coderef) = @_;\r
- ref($coderef) or return;\r
+ sub get_code_info($) {
+ my ($coderef) = @_;
+ ref($coderef) or return;
- my $cv = B::svref_2object($coderef);\r
+ my $cv = B::svref_2object($coderef);
$cv->isa('B::CV') or return;
- my $gv = $cv->GV;\r
- $gv->isa('B::GV') or return;\r
-\r
- return ($gv->STASH->NAME, $gv->NAME);\r
- }\r
+ my $gv = $cv->GV;
+ $gv->isa('B::GV') or return;
+
+ return ($gv->STASH->NAME, $gv->NAME);
+ }
}
# taken from Mouse::Util (0.90)
{
my %cache;
- sub resolve_metaclass_alias {\r
- my ( $type, $metaclass_name, %options ) = @_;\r
-\r
- my $cache_key = $type . q{ } . ( $options{trait} ? '-Trait' : '' );\r
+ sub resolve_metaclass_alias {
+ my ( $type, $metaclass_name, %options ) = @_;
+
+ my $cache_key = $type . q{ } . ( $options{trait} ? '-Trait' : '' );
+
+ return $cache{$cache_key}{$metaclass_name} ||= do{
- return $cache{$cache_key}{$metaclass_name} ||= do{\r
-\r
my $possible_full_name = join '::',
'Mouse::Meta', $type, 'Custom', ($options{trait} ? 'Trait' : ()), $metaclass_name
;
- my $loaded_class = load_first_existing_class(\r
- $possible_full_name,\r
- $metaclass_name\r
- );\r
-\r
- $loaded_class->can('register_implementation')\r
- ? $loaded_class->register_implementation\r
+ my $loaded_class = load_first_existing_class(
+ $possible_full_name,
+ $metaclass_name
+ );
+
+ $loaded_class->can('register_implementation')
+ ? $loaded_class->register_implementation
: $loaded_class;
- };\r
+ };
}
}
# taken from Moose::Util 0.90
sub english_list {
- return $_[0] if @_ == 1;\r
-
- my @items = sort @_;\r
-\r
- return "$items[0] and $items[1]" if @items == 2;\r
-\r
- my $tail = pop @items;\r
-\r
- return join q{, }, @items, "and $tail";\r
+ return $_[0] if @_ == 1;
+
+ my @items = sort @_;
+
+ return "$items[0] and $items[1]" if @items == 2;
+
+ my $tail = pop @items;
+
+ return join q{, }, @items, "and $tail";
}
sub not_supported{
projects / gitmo/Mouse.git / commitdiff