File Coverage

blib/lib/Class/Member.pm

Criterion	Covered	Total	%
statement	73	74	98.6
branch	14	16	87.5
condition			n/a
subroutine	15	15	100.0
pod			n/a
total	102	105	97.1

line	stmt	bran	sub	time	code
1					package Class::Member;
2
3	1		1	16	use strict;
	1			15
	1			18
4					our $VERSION='1.3';
5
6	1		1	15	use Carp 'confess';
	1			9
	1			21
7
8					sub import {
9	2		2	21	my $pack=shift;
10	2			24	($pack)=caller;
11
12					my $getset_hash=sub : lvalue {
13	9		9	76	my $I=shift;
14	9			77	my $what=shift;
15	9	100		108	unless( UNIVERSAL::isa( $I, 'HASH' ) ) {
16	1			20	confess "$pack\::$what must be called as instance method\n";
17					}
18	8			75	$what=$pack.'::'.$what;
19	8	100		80	if( $#_>=0 ) {
20	2			20	$I->{$what}=shift;
21					}
22	8			101	$I->{$what};
23	2			69	};
24
25					my $getset_glob=sub : lvalue {
26	9		9	76	my $I=shift;
27	9			78	my $what=shift;
28	9	100		104	unless( UNIVERSAL::isa( $I, 'GLOB' ) ) {
29	1			18	confess "$pack\::$what must be called as instance method\n";
30					}
31	8			74	$what=$pack.'::'.$what;
32	8	100		82	if( $#_>=0 ) {
33	2			42	${*$I}{$what}=shift;
	2			23
34					}
35	8			67	${*$I}{$what};
	8			111
36	2			101	};
37
38					my $getset=sub : lvalue {
39	4		4	36	my $I=shift;
40	4			178	my $name=shift;
41
42	4	100		56	if( UNIVERSAL::isa( $I, 'HASH' ) ) {
		50
43	1		1	16	no strict 'refs';
	1			9
	1			13
44	1		1	16	no warnings 'redefine';
	1			10
	1			19
45	2			29	*{$pack.'::'.$name}=sub:lvalue {
46	9		9	100	my $I=shift;
47	9			79	&{$getset_hash}( $I, $name, @_ );
	9			415
48	2			35	};
49					} elsif( UNIVERSAL::isa( $I, 'GLOB' ) ) {
50	1		1	16	no strict 'refs';
	1			9
	1			12
51	1		1	16	no warnings 'redefine';
	1			9
	1			55
52	2			71	*{$pack.'::'.$name}=sub:lvalue {
53	9		9	90	my $I=shift;
54	9			76	&{$getset_glob}( $I, $name, @_ );
	9			85
55	2			37	};
56					} else {
57	0			0	confess "$pack\::$name must be called as instance method\n";
58					}
59	4			48	$I->$name(@_);
60	2			92	};
61
62	2			21	foreach my $name (@_) {
63	6	100		271	if( $name=~/^-(.*)/ ) { # reserved name, aka option
64	2	50		64	if( $1 eq 'CLASS_MEMBERS' ) {
65	2			19	local $_;
66	1		1	16	no strict 'refs';
	1			9
	1			14
67	2			20	*{$pack.'::CLASS_MEMBERS'}=[grep {!/^-/} @_];
	2			71
	6			65
68					}
69					} else {
70	1		1	23	no strict 'refs';
	1			37
	1			15
71	4			71	*{$pack.'::'.$name}=sub:lvalue {
72	4		4	118	my $I=shift;
73	4			36	&{$getset}( $I, $name, @_ );
	4			70
74	4			56	};
75					}
76					}
77					}
78
79					1; # make require fail
80
81					__END__
82
83					=head1 NAME
84
85					Class::Member - A set of modules to make the module developement easier
86
87					=head1 SYNOPSIS
88
89					package MyModule;
90					use Class::Member::HASH qw/member_A member_B -CLASS_MEMBERS/;
91
92					or
93
94					package MyModule;
95					use Class::Member::GLOB qw/member_A member_B -CLASS_MEMBERS/;
96
97					or
98
99					package MyModule;
100					use Class::Member qw/member_A member_B -CLASS_MEMBERS/;
101
102					or
103
104					package MyModule;
105					use Class::Member::Dynamic qw/member_A member_B -CLASS_MEMBERS/;
106
107					=head1 DESCRIPTION
108
109					Perl class instances are mostly blessed HASHes or GLOBs and store member
110					variables either as C<$self-E<gt>{membername}> or
111					C<${*$self}{membername}> respectively.
112
113					This is very error prone when you start to develope derived classes based
114					on such modules. The developer of the derived class must watch the
115					member variables of the base class to avoid name conflicts.
116
117					To avoid that C<Class::Member::XXX> stores member variables in its own
118					namespace prepending the package name to the variable name, e.g.
119
120					package My::New::Module;
121
122					use Class::Member::HASH qw/member_A memberB/;
123
124					will store C<member_A> as C<$self-E<gt>{'My::New::Module::member_A'}>.
125
126					To make access to these members easier it exports access functions into
127					the callers namespace. To access C<member_A> you simply call.
128
129					$self->member_A; # read access
130					$self->member_A($new_value); # write access
131					$self->member_A=$new_value; # write access (used as lvalue)
132
133					C<Class::Member::HASH> and C<Class::Member::GLOB> are used if your objects
134					are HASH or GLOB references. But sometimes you do not know whether your
135					instances are GLOBs or HASHes (Consider developement of derived classes where
136					the base class is likely to be changed.). In this case use C<Class::Member>
137					and the methods are defined at compile time to handle each type of objects,
138					GLOBs and HASHes. But the first access to a method redefines it according
139					to the actual object type. Thus, the first access will last slightly longer
140					but all subsequent calls are executed at the same speed as
141					C<Class::Member::GLOB> or C<Class::Member::HASH>.
142
143					C<Class::Member::Dynamic> is used if your objects can be GLOBs and HASHes at
144					the same time. The actual type is determined at each access and the
145					appropriate action is taken.
146
147					In addition to member names there is (by now) one option that can be given:
148					C<-CLASS_MEMBERS>. It lets the C<import()> function create an array named
149					C<@CLASS_MEMBERS> in the caller's namespace that contains the names of all
150					methods it defines. Thus, you can create a contructor that expects named
151					parameters where each name corresponds to a class member:
152
153					use Class::Member qw/member_A member_B -CLASS_MEMBERS/;
154					our @CLASS_MEMBERS;
155
156					sub new {
157					my $parent=shift;
158					my $class=ref($parent) \|\| $parent;
159					my $I=bless {}=>$class;
160					my %o=@_;
161
162					if( ref($parent) ) { # inherit first
163					foreach my $m (@CLASS_MEMBERS) {
164					$I->$m=$parent->$m;
165					}
166					}
167
168					# then override with named parameters
169					foreach my $m (@CLASS_MEMBERS) {
170					$I->$m=$o{$m} if( exists $o{$m} );
171					}
172
173					return $I;
174					}
175
176					=head1 AUTHOR
177
178					Torsten F�rtsch E<lt>Torsten.Foertsch@gmx.netE<gt>
179
180					=head1 SEE ALSO
181
182					L<Class::Member::HASH>, L<Class::Member::GLOB>, L<Class::Member::Dynamic>
183
184					=head1 COPYRIGHT
185
186					Copyright 2003 Torsten F�rtsch.
187
188					This library is free software; you can redistribute it and/or
189					modify it under the same terms as Perl itself.
190
191					=cut
192