| Class-MakeMethods documentation | Contained in the Class-MakeMethods distribution. |
Class::MakeMethods::Standard::Universal - Generic Methods
package MyObject;
use Class::MakeMethods::Standard::Universal (
no_op => 'this',
abstract => 'that',
delegate => { name=>'play_music', target=>'instrument', method=>'play' },
);
The Standard::Universal suclass of MakeMethods provides a [INCOMPLETE].
When you use this package, the method names you provide
as arguments cause subroutines to be generated and installed in
your module.
See "Calling Conventions" in Class::MakeMethods::Standard for more information.
To declare methods, pass in pairs of a method-type name followed by one or more method names.
Valid method-type names for this package are listed in "METHOD GENERATOR TYPES".
See "Declaration Syntax" in Class::MakeMethods::Standard and "Parameter Syntax" in Class::MakeMethods::Standard for more information.
For each method name passed, returns a subroutine with the following characteristics:
You might want to create and use such methods to provide hooks for subclass activity.
Sample declaration and usage:
package MyObject;
use Class::MakeMethods::Standard::Universal (
no_op => 'whatever',
);
...
# Doesn't do anything
MyObject->whatever();
For each method name passed, returns a subroutine with the following characteristics:
This is intended to support the use of abstract methods, that must be overidden in a useful subclass.
If each subclass is expected to provide an implementation of a given method, using this abstract method will replace the generic error message below with the clearer, more explicit error message that follows it:
Can't locate object method "foo" via package "My::Subclass" The "foo" method is abstract and can not be called on My::Subclass
However, note that the existence of this method will be detected by UNIVERSAL::can(), so it is not suitable for use in optional interfaces, for which you may wish to be able to detect whether the method is supported or not.
Sample declaration and usage:
package MyObject;
use Class::MakeMethods::Standard::Universal (
abstract => 'whatever',
);
...
package MySubclass;
sub whatever { ... }
# Failure
MyObject->whatever();
# Success
MySubclass->whatever();
For each method name passed, returns a subroutine with the following characteristics:
Sample declaration and usage:
package MyObject;
use Class::MakeMethods::Standard::Universal (
call_methods => 'init',
);
...
my $object = MyObject->new()
$object->init( foo => 'Foozle', bar => 'Barbados' );
# Equivalent to:
$object->foo('Foozle');
$object->bar('Barbados');
For each method name passed, returns a subroutine with the following characteristics:
For each method name passed, returns a subroutine with the following characteristics:
You might create such a method to extend or adapt your class' interface.
Sample declaration and usage:
package MyObject;
use Class::MakeMethods::Standard::Universal (
alias => { name=>'click_here', target=>'complex_machinery' }
);
sub complex_machinery { ... }
...
$myobj->click_here(...); # calls $myobj->complex_machinery(...)
For each method name passed, returns a subroutine with the following characteristics:
You might want to create and use such methods to faciliate composition of objects from smaller objects.
Sample declaration and usage:
package MyObject;
use Class::MakeMethods::Standard::Universal (
'Standard::Hash:object' => { name=>'instrument' },
delegate => { name=>'play_music', target=>'instrument', method=>'play' }
);
...
my $object = MyObject->new();
$object->instrument( MyInstrument->new );
$object->play_music;
See Class::MakeMethods for general information about this distribution.
See Class::MakeMethods::Standard for more about this family of subclasses.
| Class-MakeMethods documentation | Contained in the Class-MakeMethods distribution. |
package Class::MakeMethods::Standard::Universal; $VERSION = 1.000; use strict; use Carp; use Class::MakeMethods::Standard '-isasubclass'; ########################################################################
sub no_op { map { my $method = $_; $method->{name} => sub { } } (shift)->_get_declarations(@_) } ########################################################################
sub abstract { map { my $method = $_; $method->{name} => sub { my $self = shift; my $class = ref($self) ? "a " . ref($self) . " object" : $self; croak("The $method->{name} method is abstract and can not be called on $class"); } } (shift)->_get_declarations(@_) } ########################################################################
sub call_methods { map { my $method = $_; $method->{name} => sub { my $self = shift; local @_ = %{$_[0]} if ( scalar @_ == 1 and ref($_[0]) eq 'HASH'); while (scalar @_) { my $key = shift; $self->$key( shift ) } } } (shift)->_get_declarations(@_) } ########################################################################
sub join_methods { map { my $method = $_; $method->{methods} or confess; $method->{join} = '' if ( ! defined $method->{join} ); $method->{skip_blanks} = '1' if ( ! defined $method->{skip_blanks} ); $method->{name} => sub { my $self = shift; my $joiner = $method->{join}; my @values = map { $self->$_() } @{ $method->{methods} }; @values = grep { defined and length } @values if ( $method->{skip_blanks} ); join $joiner, @values; } } (shift)->_get_declarations(@_) } ########################################################################
sub alias { map { my $method = $_; $method->{name} => sub { my $self = shift; my $t_method = $method->{target} or confess("no target"); my @t_args = $method->{target_args} ? @{$method->{target_args}} : (); $self->$t_method(@t_args, @_); } } (shift)->_get_declarations(@_) } ########################################################################
sub delegate { map { my $method = $_; $method->{method} ||= $method->{name}; $method->{name} => sub { my $self = shift; my $t_method = $method->{target} or confess("no target"); my @t_args = $method->{target_args} ? @{$method->{target_args}} : (); my $m_method = $method->{method} or confess("no method"); my @m_args = $method->{method_args} ? @{$method->{method_args}} : (); push @m_args, $self if ( $method->{target_args_self} ); my $obj = $self->$t_method( @t_args ) or croak("Can't delegate $method->{name} because $t_method is empty"); $obj->$m_method(@m_args, @_); } } (shift)->_get_declarations(@_) } ########################################################################
1;