lib/Moose/Meta/Method/Delegation.pm

   1
   2 package Moose::Meta::Method::Delegation;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Carp         'confess';
   8 use Scalar::Util 'blessed', 'weaken';
   9
  10 our $VERSION   = '0.57';
  11 $VERSION = eval $VERSION;
  12 our $AUTHORITY = 'cpan:STEVAN';
  13
  14 use base 'Moose::Meta::Method';
  15
  16
  17 sub new {
  18     my $class   = shift;
  19     my %options = @_;
  20
  21     (exists $options{attribute})
  22         || confess "You must supply an attribute to construct with";
  23
  24     (blessed($options{attribute}) && $options{attribute}->isa('Moose::Meta::Attribute'))
  25         || confess "You must supply an attribute which is a 'Moose::Meta::Attribute' instance";
  26
  27     ($options{package_name} && $options{name})
  28         || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
  29
  30     my $self = $class->_new(\%options);
  31
  32     weaken($self->{'attribute'});
  33
  34     return $self;
  35 }
  36
  37 sub _new {
  38     my $class = shift;
  39     my $options = @_ == 1 ? $_[0] : {@_};
  40
  41     return bless $options, $class;
  42 }
  43
  44 sub associated_attribute { (shift)->{'attribute'} }
  45
  46 1;
  47
  48 __END__
  49
  50 =pod
  51
  52 =head1 NAME
  53
  54 Moose::Meta::Method::Delegation - A Moose Method metaclass for delegation methods
  55
  56 =head1 DESCRIPTION
  57
  58 This is a subclass of L<Moose::Meta::Method> for delegation
  59 methods.
  60
  61 =head1 METHODS
  62
  63 =over 4
  64
  65 =item B<new (%options)>
  66
  67 This creates the method based on the criteria in C<%options>,
  68 these options are:
  69
  70 =over 4
  71
  72 =item I<attribute>
  73
  74 This must be an instance of C<Moose::Meta::Attribute> which this
  75 accessor is being generated for. This paramter is B<required>.
  76
  77 =back
  78
  79 =item B<associated_attribute>
  80
  81 Returns the attribute associated with this method.
  82
  83 =back
  84
  85 =head1 BUGS
  86
  87 All complex software has bugs lurking in it, and this module is no
  88 exception. If you find a bug please either email me, or add the bug
  89 to cpan-RT.
  90
  91 =head1 AUTHOR
  92
  93 Dave Rolsky E<lt>autarch@urth.orgE<gt>
  94
  95 =head1 COPYRIGHT AND LICENSE
  96
  97 Copyright 2008 by Infinity Interactive, Inc.
  98
  99 L<http://www.iinteractive.com>
 100
 101 This library is free software; you can redistribute it and/or modify
 102 it under the same terms as Perl itself.
 103
 104 =cut