/usr/share/perl5/Class/MakeMethods/Template/Hash.pm is in libclass-makemethods-perl 1.01-4.
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 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 | package Class::MakeMethods::Template::Hash;
use Class::MakeMethods::Template::Generic '-isasubclass';
$VERSION = 1.008;
use strict;
require 5.0;
sub generic {
{
'params' => {
'hash_key' => '*',
},
'code_expr' => {
_VALUE_ => '_SELF_->{_STATIC_ATTR_{hash_key}}',
'-import' => { 'Template::Generic:generic' => '*' },
_EMPTY_NEW_INSTANCE_ => 'bless {}, _SELF_CLASS_',
_SET_VALUES_FROM_HASH_ => 'while ( scalar @_ ) { local $_ = shift(); $self->{ $_ } = shift() }'
},
'behavior' => {
'hash_delete' => q{ delete _VALUE_ },
'hash_exists' => q{ exists _VALUE_ },
},
'modifier' => {
# XXX the below doesn't work because modifiers can't have params,
# although interfaces can... Either add support for default params
# in modifiers, or else move this to another class.
# X Should there be a version which uses caller() instead of target_class?
'class_keys' => { 'hash_key' => '"*{target_class}::*{name}"' },
}
}
}
########################################################################
=head1 NAME
Class::MakeMethods::Template::Hash - Method interfaces for hash-based objects
=head1 SYNOPSIS
package MyObject;
use Class::MakeMethods::Template::Hash (
new => [ 'new' ],
scalar => [ 'foo', 'bar' ]
);
package main;
my $obj = MyObject->new( foo => "Foozle", bar => "Bozzle" );
print $obj->foo();
$obj->bar("Bamboozle");
=head1 DESCRIPTION
These meta-methods create and access values within blessed hash objects.
B<Common Parameters>: The following parameters are defined for Hash meta-methods.
=over 4
=item hash_key
The hash key to use when retrieving values from each hash instance. Defaults to '*', the name of the meta-method.
Changing this allows you to change an accessor method name to something other than the name of the hash key used to retrieve its value.
Note that this parameter is not portable to the other implementations, such as Global or InsideOut.
You can take advantage of parameter expansion to define methods whose hash key is composed of the defining package's name and the individual method name, such as C<$self-E<gt>{I<MyObject>-I<foo>}>:
'hash_key' => '*{target_class}-*{name}'
=back
B<Common Behaviors>
=over 4
=item Behavior: delete
Deletes the named key and associated value from the current hash instance.
=back
=head2 Standard Methods
The following methods from Generic are all supported:
new
scalar
string
string_index
number
boolean
bits (*)
array
hash
tiedhash
hash_of_arrays
object
instance
array_of_objects
code
code_or_scalar
See L<Class::MakeMethods::Template::Generic> for the interfaces and behaviors of these method types.
The items marked with a * above are specifically defined in this package, whereas the others are formed automatically by the interaction of this package's generic settings with the code templates provided by the Generic superclass.
=cut
# This is the only one that needs to be specifically defined.
sub bits {
{
'-import' => { 'Template::Generic:bits' => '*' },
'params' => {
'hash_key' => '*{target_class}__*{template_name}',
},
}
}
########################################################################
=head2 struct
struct => [ qw / foo bar baz / ];
Creates methods for setting, checking and clearing values which
are stored by position in an array. All the slots created with this
meta-method are stored in a single array.
The argument to struct should be a string or a reference to an
array of strings. For each string meta-method x, it defines two
methods: I<x> and I<clear_x>. x returns the value of the x-slot.
If called with an argument, it first sets the x-slot to the argument.
clear_x sets the slot to undef.
Additionally, struct defines three class method: I<struct>, which returns
a list of all of the struct values, I<struct_fields>, which returns
a list of all the slots by name, and I<struct_dump>, which returns a hash of
the slot-name/slot-value pairs.
=cut
sub struct {
( {
'interface' => {
default => {
'*'=>'get_set', 'clear_*'=>'clear',
'struct_fields'=>'struct_fields',
'struct'=>'struct', 'struct_dump'=>'struct_dump'
},
},
'params' => {
'hash_key' => '*{target_class}__*{template_name}',
},
'behavior' => {
'-init' => sub {
my $m_info = $_[0];
$m_info->{class} ||= $m_info->{target_class};
my $class_info =
($Class::MakeMethods::Template::Hash::struct{$m_info->{class}} ||= []);
if ( ! defined $m_info->{sfp} ) {
foreach ( 0..$#$class_info ) {
if ( $class_info->[$_] eq $m_info->{'name'} ) {
$m_info->{sfp} = $_;
last
}
}
if ( ! defined $m_info->{sfp} ) {
push @$class_info, $m_info->{'name'};
$m_info->{sfp} = $#$class_info;
}
}
return;
},
'struct_fields' => sub { my $m_info = $_[0]; sub {
my $class_info =
( $Class::MakeMethods::Template::Hash::struct{$m_info->{class}} ||= [] );
@$class_info;
}},
'struct' => sub { my $m_info = $_[0]; sub {
my $self = shift;
$self->{$m_info->{hash_key}} ||= [];
if ( @_ ) { @{$self->{$m_info->{hash_key}}} = @_ }
@{$self->{$m_info->{hash_key}}};
}},
'struct_dump' => sub { my $m_info = $_[0]; sub {
my $self = shift;
my $class_info =
( $Class::MakeMethods::Template::Hash::struct{$m_info->{class}} ||= [] );
map { ($_, $self->$_()) } @$class_info;
}},
'get_set' => sub { my $m_info = $_[0]; sub {
my $self = shift;
$self->{$m_info->{hash_key}} ||= [];
if ( @_ ) {
$self->{$m_info->{hash_key}}->[ $m_info->{sfp} ] = shift;
}
$self->{$m_info->{hash_key}}->[ $m_info->{sfp} ];
}},
'clear' => sub { my $m_info = $_[0]; sub {
my $self = shift;
$self->{$m_info->{hash_key}} ||= [];
$self->{$m_info->{hash_key}}->[ $m_info->{sfp} ] = undef;
}},
},
} )
}
########################################################################
=head1 SEE ALSO
See L<Class::MakeMethods> for general information about this distribution.
See L<Class::MakeMethods::Template> for more about this family of subclasses.
See L<Class::MakeMethods::Template::Generic> for information about the various accessor interfaces subclassed herein.
=cut
1;
|