/usr/share/perl5/MouseX/NativeTraits/MethodProvider.pm is in libmousex-nativetraits-perl 1.07-1.
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 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 | package MouseX::NativeTraits::MethodProvider;
use Mouse;
has attr => (
is => 'ro',
isa => 'Object',
required => 1,
weak_ref => 1,
);
has reader => (
is => 'ro',
lazy_build => 1,
);
has writer => (
is => 'ro',
lazy_build => 1,
);
sub _build_reader {
my($self) = @_;
return $self->attr->get_read_method_ref;
}
sub _build_writer {
my($self) = @_;
return $self->attr->get_write_method_ref;
}
sub has_generator {
my($self, $name) = @_;
return $self->meta->has_method("generate_$name");
}
sub generate {
my($self, $handle_name, $method_to_call) = @_;
my @curried_args;
($method_to_call, @curried_args) = @{$method_to_call};
my $code = $self->meta
->get_method_body("generate_$method_to_call")->($self);
if(@curried_args){
return sub {
my $instance = shift;
$code->($instance, @curried_args, @_);
};
}
else{
return $code;
}
}
sub get_generators {
my($self) = @_;
return grep{ s/\A generate_ //xms } $self->meta->get_method_list;
}
sub argument_error {
my($self, $name, $min, $max, $nargs) = @_;
if(not defined $max) {
$max = 9 ** 9 ** 9; # inifinity :p
}
# fix numbers for $self
$min--;
$max--;
$nargs--;
if($min <= $nargs and $nargs <= $max) {
Carp::croak("Oops ($name): nags=$nargs, min=$min, max=$max");
}
my $message = 'Cannot call %s %s argument%s';
if($min == 0 and $max == 0 && $nargs > 0) {
$self->meta->throw_error(
sprintf $message,
$name, 'with any', 's' );
}
$self->meta->throw_error(
sprintf 'Cannot call %s %s %d argument%s',
$name, ($nargs < $min
? ('without at least', $min)
: ('with more than', $max) ),
$nargs == 1 ? '' : 's' );
}
no Mouse;
__PACKAGE__->meta->make_immutable(strict_constructor => 1);
__END__
=head1 NAME
MouseX::NativeTraits::MethodProvider - The common base class for method providers
=head1 DESCRIPTION
This class is the common base class for method providers.
=head1 ATTRIBUTES
=over 4
=item attr
=item reader
Shortcut for C<< $provider->attr->get_read_method_ref >>.
=item writer
Shortcut for C<< $provider->attr->get_write_method_ref >>.
=back
=head1 METHODS
=over 4
=item has_generator
=item generate
=item get_generators
=back
=head1 SEE ALSO
L<MouseX::NativeTraits>
=cut
|