—package
Class::AccessorMaker::Private;
##
## Class::AccessorMaker::Private by Hartog 'Sinister' de Mik
##
use
strict;
no
strict
'refs'
;
our
$VERSION
=
"1.0"
;
use
Carp;
# lexical for data-hiding
my
%obj_
= ();
sub
import
{
my
(
$class
,
$subs
,
$xtra
) =
@_
;
my
$pkg
=
ref
(
caller
) ||
caller
;
$xtra
||=
""
;
croak
"Can't make methods out of an empty hash-ref\n"
if
!
defined
$subs
;
## define a constructor
if
(
$xtra
ne
"no_new"
) {
# we have a green light for 'new()' creation
if
(
$xtra
ne
"new_init"
) {
*{
"${pkg}::new"
} =
sub
{
my
$class
=
ref
(
$_
[0]) ||
$_
[0];
shift
;
my
$self
=
bless
({},
$class
);
while
(
@_
) {
my
(
$sub
,
$value
) = (
shift
,
shift
);
$self
->
$sub
(
$value
);
}
return
$self
;
};
}
elsif
(
$xtra
eq
"new_init"
) {
*{
"${pkg}::new"
} =
sub
{
my
$class
=
ref
(
$_
[0]) ||
$_
[0];
shift
;
my
$self
=
bless
({},
$class
);
while
(
@_
) {
my
(
$sub
,
$value
) = (
shift
,
shift
);
$self
->
$sub
(
$value
);
}
$self
->init();
return
$self
;
};
}
}
foreach
my
$sub
(
keys
%$subs
) {
# construct the method if it is not defined yet.
next
if
(
defined
&{
"${pkg}::$sub"
} );
*{
"${pkg}::$sub"
} =
sub
{
my
(
$self
,
$value
) =
@_
;
# fill with default at first run
$obj_
{
$self
}->{
$sub
} =
$subs
->{
$sub
}
if
!
exists
$obj_
{
$self
}->{
$sub
};
# more then just self, something has to be set.
if
(
$#_
> 0) {
warn
"The value supplied to '$sub()' is not of propper type"
if
(
ref
(
$subs
->{
$sub
}) and !
ref
(
$value
));
# set the value and return the object.
$obj_
{
$self
}->{
$sub
} =
$value
;
return
$self
;
}
# return the value;
return
$obj_
{
$self
}->{
$sub
};
} or
warn
"Method: $sub not implemented\n"
;
}
return
1;
# import succeeded
}
1;
__END__
=pod
=head1 NAME
Class::AccessorMaker::Private - generate private accessor method with default values.
=head1 DESCRIPTION
For further SYNOPSIS, DESCRIPTION and PITFALLS please read the perldoc of
Class::AccessorMaker.
This 'AccessorMaker' makes you private methods. Actually the methods are
accessible from just about anywhere you like em to, but the data
structure that lies beneath it all is hidden in a far away place. This
forces the users of your object to actually use the acccessor methods,
instead of trying to temper with your objects internals.
=head1 BUT I WANT TO ...
test the value of my accessor or perhaps even slightly alter it...
Too bad, Class:AccessorMaker::Private does not do this for you. You
will have to write your own accessor method. Ah, too bad again,
AccessorMaker::Private does not even give your object reachable data,
but the object self is a blessed hash, be it very empty, so you can
use that...
But if you wish to use global-data for it, be my guest, not that I
advice it, cause it is generally a bad idea to use global data, and if
you use it, you do not even need accessor methods, right?
=head2 an example:
sub seperator {
my ($self, $value) = @_;
# set the default value.
$self->{seperator} = '$$' if !exists $self->{seperator}
if ( $#_ > 0 ) {
$self->{seperator} = quotemeta($value);
return $self;
}
return $self->{seperator};
}
I think I can skip a code explanation, right?
=head1 AUTHOR
Hartog 'Sinister' de Mik <hartog@2organize.com>
=head1 COPYRIGHT
Copyright (c) 2002 Hartog C. de Mik. All rights reserved. This
program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
The full text of the license can be found in the LICENSE file included
with this module.
=cut