| Class-MakeMethods documentation | Contained in the Class-MakeMethods distribution. |
Class::MakeMethods::Composite::Hash - Composite hash methods
package MyObject;
use Class::MakeMethods::Composite::Hash (
new => 'new',
scalar => [ 'foo', 'bar' ],
array => 'my_list',
hash => 'my_index',
);
...
my $obj = MyObject->new( foo => 'Foozle' );
print $obj->foo();
$obj->bar('Barbados');
print $obj->bar();
$obj->my_list(0 => 'Foozle', 1 => 'Bang!');
print $obj->my_list(1);
$obj->my_index('broccoli' => 'Blah!', 'foo' => 'Fiddle');
print $obj->my_index('foo');
The Composite::Hash suclass of MakeMethods provides a basic constructor and accessors for blessed-hash object instances.
When you use this package, the method declarations you provide
as arguments cause subroutines to be generated and installed in
your module.
You can also omit the arguments to use and instead make methods
at runtime by passing the declarations to a subsequent call to
make().
You may include any number of declarations in each call to use
or make(). If methods with the same name already exist, earlier
calls to use or make() win over later ones, but within each
call, later declarations superceed earlier ones.
You can install methods in a different package by passing -TargetClass => package as your first arguments to use or make.
See Class::MakeMethods for more details.
The following types of Basic declarations are supported:
See the "METHOD GENERATOR TYPES" section below for a list of the supported values of generator_type.
For each method name you provide, a subroutine of the indicated type will be generated and installed under that name in your module.
Method names should start with a letter, followed by zero or more letters, numbers, or underscores.
The Composite syntax also provides several ways to optionally associate a hash of additional parameters with a given method name.
name, you create a self-contained declaration with that name and any associated hash values.Basic declarations, as described above, are given an empty parameter hash.
For each method name passed, returns a subroutine with the following characteristics:
'defaults' => hash_ref method parameter. Sample declaration and usage:
package MyObject;
use Class::MakeMethods::Composite::Hash (
new => 'new',
);
...
# Bare constructor
my $empty = MyObject->new();
# Constructor with initial values
my $obj = MyObject->new( foo => 'Foozle', bar => 'Barbados' );
# Copy with overriding value
my $copy = $obj->new( bar => 'Bob' );
For each method name passed, returns a subroutine with the following characteristics:
For each method name passed, uses a closure to generate a subroutine with the following characteristics:
'hash_key' = string> method parameter. Sample declaration and usage:
package MyObject;
use Class::MakeMethods::Composite::Hash (
scalar => 'foo',
);
...
# Store value
$obj->foo('Foozle');
# Retrieve value
print $obj->foo;
For each method name passed, uses a closure to generate a subroutine with the following characteristics:
'hash_key' = string> method parameter. Sample declaration and usage:
package MyObject;
use Class::MakeMethods::Composite::Hash (
array => 'bar',
);
...
# Clear and set contents of list
print $obj->bar([ 'Spume', 'Frost' ] );
# Set values by position
$obj->bar(0 => 'Foozle', 1 => 'Bang!');
# Positions may be overwritten, and in any order
$obj->bar(2 => 'And Mash', 1 => 'Blah!');
# Retrieve value by position
print $obj->bar(1);
# Direct access to referenced array
print scalar @{ $obj->bar() };
There are also calling conventions for slice and splice operations:
# Retrieve slice of values by position
print join(', ', $obj->bar( undef, [0, 2] ) );
# Insert an item at position in the array
$obj->bar([3], 'Potatoes' );
# Remove 1 item from position 3 in the array
$obj->bar([3, 1], undef );
# Set a new value at position 2, and return the old value
print $obj->bar([2, 1], 'Froth' );
For each method name passed, uses a closure to generate a subroutine with the following characteristics:
'hash_key' = string> method parameter. Sample declaration and usage:
package MyObject;
use Class::MakeMethods::Composite::Hash (
hash => 'baz',
);
...
# Set values by key
$obj->baz('foo' => 'Foozle', 'bar' => 'Bang!');
# Values may be overwritten, and in any order
$obj->baz('broccoli' => 'Blah!', 'foo' => 'Fiddle');
# Retrieve value by key
print $obj->baz('foo');
# Retrive slice of values by position
print join(', ', $obj->baz( ['foo', 'bar'] ) );
# Direct access to referenced hash
print keys %{ $obj->baz() };
# Reset the hash contents to empty
@{ $obj->baz() } = ();
For each method name passed, uses a closure to generate a subroutine with the following characteristics:
'hash_key' = string> method parameter. Sample declaration and usage:
package MyObject;
use Class::MakeMethods::Composite::Hash (
object => 'foo',
);
...
# Store value
$obj->foo( Foozle->new() );
# Retrieve value
print $obj->foo;
See Class::MakeMethods for general information about this distribution.
See Class::MakeMethods::Composite for more about this family of subclasses.
| Class-MakeMethods documentation | Contained in the Class-MakeMethods distribution. |
package Class::MakeMethods::Composite::Hash; $VERSION = 1.000; use strict; use Class::MakeMethods::Composite '-isasubclass'; use Carp; ########################################################################
use vars qw( %ConstructorFragments ); sub new { (shift)->_build_composite( \%ConstructorFragments, @_ ); } %ConstructorFragments = ( '' => [ '+init' => sub { my $method = pop @_; $method->{target_class} ||= $Class::MethodMaker::CONTEXT{TargetClass}; $method->{defaults} ||= {}; }, 'do' => sub { my $method = pop @_; my $self = shift @_; my $obj = ref($self) ? bless( { %$self }, ref $self ) : bless( { %{$method->{defaults}} }, $self ); @_ = %{$_[0]} if ( scalar @_ == 1 and ref $_[0] eq 'HASH' ); while ( scalar @_ ) { my $method = shift @_; my $value = shift @_; $obj->$method( $value ); } $obj; }, ], 'with_values' => [ 'do' => sub { my $method = pop @_; my $self = shift @_; @_ = %{$_[0]} if ( scalar @_ == 1 and ref $_[0] eq 'HASH' ); bless( { @_ }, ref($self) || $self ); } ], ); ########################################################################
use vars qw( %ScalarFragments ); sub scalar { (shift)->_build_composite( \%ScalarFragments, @_ ); } %ScalarFragments = ( '' => [ '+init' => sub { my ($method) = @_; $method->{hash_key} ||= $method->{name}; $method->{target_class} ||= $Class::MethodMaker::CONTEXT{TargetClass}; }, 'do' => sub { my $method = pop @_; my $self = shift @_; if ( scalar(@_) == 0 ) { $self->{$method->{hash_key}}; } elsif ( scalar(@_) == 1 ) { $self->{$method->{hash_key}} = shift; } else { $self->{$method->{hash_key}} = [@_]; } }, ], 'rw' => [], 'p' => [ '+pre' => sub { my $method = pop @_; my $self = shift @_; unless ( UNIVERSAL::isa((caller(1))[0], $method->{target_class}) ) { croak "Method $method->{name} is protected"; } }, ], 'pp' => [ '+pre' => sub { my $method = pop @_; my $self = shift @_; unless ( (caller(1))[0] eq $method->{target_class} ) { croak "Method $method->{name} is private"; } }, ], 'pw' => [ '+pre' => sub { my $method = pop @_; my $self = shift @_; my $args = \@_; unless ( @$args == 0 or UNIVERSAL::isa((caller(1))[0], $method->{target_class}) ) { croak "Method $method->{name} is write-protected"; } }, ], 'ppw' => [ '+pre' => sub { my $method = pop @_; my $self = shift @_; my $args = \@_; unless ( @$args == 0 or (caller(1))[0] eq $method->{target_class} ) { croak "Method $method->{name} is write-private"; } }, ], 'r' => [ '+pre' => sub { my $method = pop @_; my $self = shift @_; my $args = \@_; @$args = (); }, ], 'ro' => [ '+pre' => sub { my $method = pop @_; my $self = shift @_; my $args = \@_; unless ( @$args == 0 ) { croak("Method $method->{name} is read-only"); } }, ], 'wo' => [ '+pre' => sub { my $method = pop @_; my $self = shift @_; my $args = \@_; if ( @$args == 0 ) { croak("Method $method->{name} is write-only"); } }, ], 'return_original' => [ '+pre' => sub { my $method = pop @_; my $self = shift @_; my $args = \@_; $method->{scratch}{return_original} = $self->{$method->{hash_key}}; }, '+post' => sub { my $method = pop @_; my $self = shift @_; my $args = \@_; ${ $method->{result} } = $method->{scratch}{return_original}; }, ], ); ########################################################################
use vars qw( %ArrayFragments ); sub array { (shift)->_build_composite( \%ArrayFragments, @_ ); } %ArrayFragments = ( '' => [ '+init' => sub { my ($method) = @_; $method->{hash_key} ||= $_->{name}; }, 'do' => sub { my $method = pop @_; my $self = shift @_; my $args = \@_; if ( scalar(@$args) == 0 ) { if ( $method->{auto_init} and ! defined $self->{$method->{hash_key}} ) { $self->{$method->{hash_key}} = []; } wantarray ? @{ $self->{$method->{hash_key}} } : $self->{$method->{hash_key}}; } elsif ( scalar(@_) == 1 and ref $_[0] eq 'ARRAY' ) { $self->{$method->{hash_key}} = [ @{ $_[0] } ]; wantarray ? @{ $self->{$method->{hash_key}} } : $self->{$method->{hash_key}}; } else { $self->{$method->{hash_key}} ||= []; array_splicer( $self->{$method->{hash_key}}, @$args ); } }, ], ); ########################################################################
use vars qw( %HashFragments ); sub hash { (shift)->_build_composite( \%HashFragments, @_ ); } %HashFragments = ( '' => [ '+init' => sub { my ($method) = @_; $method->{hash_key} ||= $_->{name}; }, 'do' => sub { my $method = pop @_; my $self = shift @_; my $args = \@_; if ( scalar(@$args) == 0 ) { if ( $method->{auto_init} and ! defined $self->{$method->{hash_key}} ) { $self->{$method->{hash_key}} = {}; } wantarray ? %{ $self->{$method->{hash_key}} } : $self->{$method->{hash_key}}; } elsif ( scalar(@$args) == 1 ) { if ( ref($_[0]) eq 'HASH' ) { %{$self->{$method->{hash_key}}} = %{$_[0]}; } elsif ( ref($_[0]) eq 'ARRAY' ) { return @{$self->{$method->{hash_key}}}{ @{$_[0]} } } else { return $self->{$method->{hash_key}}->{ $_[0] } } } elsif ( scalar(@$args) % 2 ) { croak "Odd number of items in assigment to $method->{name}"; } else { while ( scalar(@$args) ) { my $key = shift @$args; $self->{$method->{hash_key}}->{ $key} = shift @$args; } wantarray ? %{ $self->{$method->{hash_key}} } : $self->{$method->{hash_key}}; } }, ], ); ########################################################################
use vars qw( %ObjectFragments ); sub object { (shift)->_build_composite( \%ObjectFragments, @_ ); } %ObjectFragments = ( '' => [ '+init' => sub { my ($method) = @_; $method->{hash_key} ||= $_->{name}; }, 'do' => sub { my $method = pop @_; my $self = shift; if ( scalar @_ ) { my $value = shift; if ( $method->{class} and ! UNIVERSAL::isa( $value, $method->{class} ) ) { croak "Wrong argument type ('$value') in assigment to $method->{name}"; } $self->{$method->{hash_key}} = $value; } else { if ( $method->{auto_init} and ! defined $self->{$method->{hash_key}} ) { my $class = $method->{class} or die "Can't auto_init without a class"; my $new_method = $method->{new_method} || 'new'; $self->{$method->{hash_key}} = $class->$new_method(); } $self->{$method->{hash_key}}; } }, ], ); ########################################################################
1;