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
|
package Class::MakeMethods::Emulator::Struct;
use strict;
use Class::MakeMethods;
use vars qw(@ISA @EXPORT);
require Exporter;
push @ISA, qw(Exporter);
@EXPORT = qw(struct);
sub import {
my $self = shift;
if ( @_ == 0 ) {
$self->export_to_level( 1, $self, @EXPORT );
} elsif ( @_ == 1 ) {
$self->export_to_level( 1, $self, @_ );
} else {
&struct;
}
}
########################################################################
my %type_map = (
'$' => 'scalar',
'@' => 'array',
'%' => 'hash',
'_' => 'object',
);
sub struct {
my ($class, @decls);
my $base_type = ref $_[1] ;
if ( $base_type eq 'HASH' ) {
$base_type = 'Standard::Hash';
$class = shift;
@decls = %{shift()};
_usage_error() if @_;
}
elsif ( $base_type eq 'ARRAY' ) {
$base_type = 'Standard::Array';
$class = shift;
@decls = @{shift()};
_usage_error() if @_;
}
else {
$base_type = 'Standard::Array';
$class = (caller())[0];
@decls = @_;
}
_usage_error() if @decls % 2 == 1;
my @rewrite;
while ( scalar @decls ) {
my ($name, $type) = splice(@decls, 0, 2);
push @rewrite, $type_map{$type}
? ( $type_map{$type} => { 'name'=>$name, auto_init=>1 } )
: ( $type_map{'_'} => { 'name'=>$name, 'class'=>$type, auto_init=>1 } );
}
Class::MakeMethods->make(
-TargetClass => $class,
-MakerClass => $base_type,
"new" => 'new',
@rewrite
);
}
sub _usage_error {
require Carp;
Carp::confess "struct usage error";
}
########################################################################
1;
__END__
=head1 NAME
Class::MakeMethods::Emulator::Struct - Emulate Class::Struct
=head1 SYNOPSIS
use Class::MakeMethods::Emulator::Struct;
struct (
simple => '$',
ordered => '@',
mapping => '%',
obj_ref => 'FooObject'
);
=head1 DESCRIPTION
This module emulates the functionality of Class::Struct by munging the provided field-declaration arguments to match those expected by Class::MakeMethods.
It supports the same four types of accessors, the choice of array-based or hash-based objects, and the choice of installing methods in the current package or a specified target.
=head1 EXAMPLE
The below three declarations create equivalent methods for a simple hash-based class with a constructor and four accessors.
use Class::Struct;
struct (
simple => '$',
ordered => '@',
mapping => '%',
obj_ref => 'FooObject'
);
use Class::MakeMethods::Emulator::Struct;
struct (
simple => '$',
ordered => '@',
mapping => '%',
obj_ref => 'FooObject'
);
use Class::MakeMethods (
-MakerClass => 'Standard::Array',
'new' => 'new',
'scalar' => 'simple',
'array -auto_init 1' => 'ordered',
'hash -auto_init 1' => 'mapping',
'object -auto_init 1' => '-class FooObject obj_ref'
);
=head1 COMPATIBILITY
This module aims to offer a "95% compatible" drop-in replacement for the core Class::Struct module for purposes of comparison and code migration.
The C<class-struct.t> test for the core Class::Struct module is included with this package. The test is unchanged except for the a direct substitution of this emulator's name in the place of the core module.
However, there are numerous internal differences between the methods generated by the original Class::Struct and this emulator, and some existing code may not work correctly without modification.
=head1 SEE ALSO
See L<Class::MakeMethods> for general information about this distribution.
See L<Class::MakeMethods::Emulator> for more about this family of subclasses.
See L<Class::Struct> for documentation of the original module.
See L<Class::MakeMethods::Standard::Hash> and L<Class::MakeMethods::Standard::Array> for documentation of the created methods.
=cut
|
