/usr/share/perl5/Moose/Meta/Method/VariantTable.pm is in libmoosex-types-varianttable-perl 0.04-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | #!/usr/bin/perl
package Moose::Meta::Method::VariantTable;
use Moose;
extends qw(Moose::Object Moose::Meta::Method);
use MooseX::Types::VariantTable;
use Carp qw(croak);
use Sub::Name qw(subname);
has _variant_table => (
isa => "MooseX::Types::VariantTable",
is => "ro",
default => sub { MooseX::Types::VariantTable->new },
handles => qr/^(?: \w+_variant$ | has_ )/x,
);
has class => (
isa => "Class::MOP::Class",
is => "ro",
);
has name => (
isa => "Str",
is => "ro",
);
has full_name => (
isa => "Str",
is => "ro",
lazy => 1,
default => sub {
my $self = shift;
join "::", $self->class->name, $self->name;
},
);
has super => (
isa => "Maybe[Class::MOP::Method]",
is => "ro",
lazy_build => 1,
);
sub _build_super {
my $self = shift;
$self->class->find_next_method_by_name($self->name);
}
has body => (
isa => "CodeRef",
is => "ro",
lazy => 1,
builder => "initialize_body",
);
sub merge {
my ( $self, @others ) = @_;
return ( ref $self )->new(
_variant_table => $self->_variant_table->merge(map { $_->_variant_table } @others),
);
}
sub initialize_body {
my $self = shift;
my $variant_table = $self->_variant_table;
my $super = $self->super;
my $super_body = $super && $super->body;
my $name = $self->name;
return subname $self->full_name, sub {
my ( $self, $value, @args ) = @_;
if ( my ( $result, $type ) = $variant_table->find_variant($value) ) {
my $method = (ref($result)||'') eq 'CODE'
? $result
: $self->can($result);
goto $method;
} else {
return $self->next::method($value, @args);
}
my $dump = eval { require Devel::PartialDump; 1 }
? \&Devel::PartialDump::dump
: sub { return join $", map { overload::StrVal($_) } @_ };
croak "No variant of method '$name' found for ", $dump->($value, @args);
};
}
__PACKAGE__
__END__
|