KevinSchoenmayer/GseTDDUebungKCLR
2
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial Commit

Browse Source
This commit is contained in:
Riley Schneider
2025-12-03 16:38:10 +01:00
parent c5e26bf594
commit b732d8d4b5
17680 changed files with 5977495 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

818
database/perl/vendor/lib/Object/Accessor.pm vendored Normal file
View File

@@ -0,0 +1,818 @@
package Object::Accessor;
use if $] > 5.017, 'deprecate';
use strict;
use Carp qw[carp croak];
use vars qw[$FATAL $DEBUG $AUTOLOAD $VERSION];
use Params::Check qw[allow];
### some objects might have overload enabled, we'll need to
### disable string overloading for callbacks
require overload;
$VERSION = '0.48';
$FATAL = 0;
$DEBUG = 0;
use constant VALUE => 0; # array index in the hash value
use constant ALLOW => 1; # array index in the hash value
use constant ALIAS => 2; # array index in the hash value
=head1 NAME
Object::Accessor - interface to create per object accessors
=head1 SYNOPSIS
### using the object
$obj = Object::Accessor->new; # create object
$obj = Object::Accessor->new(@list); # create object with accessors
$obj = Object::Accessor->new(\%h); # create object with accessors
# and their allow handlers
$bool = $obj->mk_accessors('foo'); # create accessors
$bool = $obj->mk_accessors( # create accessors with input
{foo => ALLOW_HANDLER} ); # validation
$bool = $obj->mk_aliases( # create an alias to an existing
alias_name => 'method'); # method name
$clone = $obj->mk_clone; # create a clone of original
# object without data
$bool = $obj->mk_flush; # clean out all data
@list = $obj->ls_accessors; # retrieves a list of all
# accessors for this object
$bar = $obj->foo('bar'); # set 'foo' to 'bar'
$bar = $obj->foo(); # retrieve 'bar' again
$sub = $obj->can('foo'); # retrieve coderef for
# 'foo' accessor
$bar = $sub->('bar'); # set 'foo' via coderef
$bar = $sub->(); # retrieve 'bar' by coderef
### using the object as base class
package My::Class;
use base 'Object::Accessor';
$obj = My::Class->new; # create base object
$bool = $obj->mk_accessors('foo'); # create accessors, etc...
### make all attempted access to non-existent accessors fatal
### (defaults to false)
$Object::Accessor::FATAL = 1;
### enable debugging
$Object::Accessor::DEBUG = 1;
### advanced usage -- callbacks
{ my $obj = Object::Accessor->new('foo');
$obj->register_callback( sub { ... } );
$obj->foo( 1 ); # these calls invoke the callback you registered
$obj->foo() # which allows you to change the get/set
# behaviour and what is returned to the caller.
}
### advanced usage -- lvalue attributes
{ my $obj = Object::Accessor::Lvalue->new('foo');
print $obj->foo = 1; # will print 1
}
### advanced usage -- scoped attribute values
{ my $obj = Object::Accessor->new('foo');
$obj->foo( 1 );
print $obj->foo; # will print 1
### bind the scope of the value of attribute 'foo'
### to the scope of '$x' -- when $x goes out of
### scope, 'foo's previous value will be restored
{ $obj->foo( 2 => \my $x );
print $obj->foo, ' ', $x; # will print '2 2'
}
print $obj->foo; # will print 1
}
=head1 DESCRIPTION
C<Object::Accessor> provides an interface to create per object
accessors (as opposed to per C<Class> accessors, as, for example,
C<Class::Accessor> provides).
You can choose to either subclass this module, and thus using its
accessors on your own module, or to store an C<Object::Accessor>
object inside your own object, and access the accessors from there.
See the C<SYNOPSIS> for examples.
=head1 METHODS
=head2 $object = Object::Accessor->new( [ARGS] );
Creates a new (and empty) C<Object::Accessor> object. This method is
inheritable.
Any arguments given to C<new> are passed straight to C<mk_accessors>.
If you want to be able to assign to your accessors as if they
were C<lvalue>s, you should create your object in the
C<Object::Accessor::Lvalue> namespace instead. See the section
on C<LVALUE ACCESSORS> below.
=cut
sub new {
my $class = shift;
my $obj = bless {}, $class;
$obj->mk_accessors( @_ ) if @_;
return $obj;
}
=head2 $bool = $object->mk_accessors( @ACCESSORS | \%ACCESSOR_MAP );
Creates a list of accessors for this object (and C<NOT> for other ones
in the same class!).
Will not clobber existing data, so if an accessor already exists,
requesting to create again is effectively a C<no-op>.
When providing a C<hashref> as argument, rather than a normal list,
you can specify a list of key/value pairs of accessors and their
respective input validators. The validators can be anything that
C<Params::Check>'s C<allow> function accepts. Please see its manpage
for details.
For example:
$object->mk_accessors( {
foo => qr/^\d+$/, # digits only
bar => [0,1], # booleans
zot => \&my_sub # a custom verification sub
} );
Returns true on success, false on failure.
Accessors that are called on an object, that do not exist return
C<undef> by default, but you can make this a fatal error by setting the
global variable C<$FATAL> to true. See the section on C<GLOBAL
VARIABLES> for details.
Note that you can bind the values of attributes to a scope. This allows
you to C<temporarily> change a value of an attribute, and have it's
original value restored up on the end of it's bound variable's scope;
For example, in this snippet of code, the attribute C<foo> will
temporarily be set to C<2>, until the end of the scope of C<$x>, at
which point the original value of C<1> will be restored.
my $obj = Object::Accessor->new;
$obj->mk_accessors('foo');
$obj->foo( 1 );
print $obj->foo; # will print 1
### bind the scope of the value of attribute 'foo'
### to the scope of '$x' -- when $x goes out of
### scope, 'foo' previous value will be restored
{ $obj->foo( 2 => \my $x );
print $obj->foo, ' ', $x; # will print '2 2'
}
print $obj->foo; # will print 1
Note that all accessors are read/write for everyone. See the C<TODO>
section for details.
=cut
sub mk_accessors {
my $self = $_[0];
my $is_hash = UNIVERSAL::isa( $_[1], 'HASH' );
### first argument is a hashref, which means key/val pairs
### as keys + allow handlers
for my $acc ( $is_hash ? keys %{$_[1]} : @_[1..$#_] ) {
### already created apparently
if( exists $self->{$acc} ) {
__PACKAGE__->___debug( "Accessor '$acc' already exists");
next;
}
__PACKAGE__->___debug( "Creating accessor '$acc'");
### explicitly vivify it, so that exists works in ls_accessors()
$self->{$acc}->[VALUE] = undef;
### set the allow handler only if one was specified
$self->{$acc}->[ALLOW] = $_[1]->{$acc} if $is_hash;
}
return 1;
}
=head2 @list = $self->ls_accessors;
Returns a list of accessors that are supported by the current object.
The corresponding coderefs can be retrieved by passing this list one
by one to the C<can> method.
=cut
sub ls_accessors {
### metainformation is stored in the stringified
### key of the object, so skip that when listing accessors
return sort grep { $_ ne "$_[0]" } keys %{$_[0]};
}
=head2 $ref = $self->ls_allow(KEY)
Returns the allow handler for the given key, which can be used with
C<Params::Check>'s C<allow()> handler. If there was no allow handler
specified, an allow handler that always returns true will be returned.
=cut
sub ls_allow {
my $self = shift;
my $key = shift or return;
return exists $self->{$key}->[ALLOW]
? $self->{$key}->[ALLOW]
: sub { 1 };
}
=head2 $bool = $self->mk_aliases( alias => method, [alias2 => method2, ...] );
Creates an alias for a given method name. For all intents and purposes,
these two accessors are now identical for this object. This is akin to
doing the following on the symbol table level:
*alias = *method
This allows you to do the following:
$self->mk_accessors('foo');
$self->mk_aliases( bar => 'foo' );
$self->bar( 42 );
print $self->foo; # will print 42
=cut
sub mk_aliases {
my $self = shift;
my %aliases = @_;
while( my($alias, $method) = each %aliases ) {
### already created apparently
if( exists $self->{$alias} ) {
__PACKAGE__->___debug( "Accessor '$alias' already exists");
next;
}
$self->___alias( $alias => $method );
}
return 1;
}
=head2 $clone = $self->mk_clone;
Makes a clone of the current object, which will have the exact same
accessors as the current object, but without the data stored in them.
=cut
### XXX this creates an object WITH allow handlers at all times.
### even if the original didn't
sub mk_clone {
my $self = $_[0];
my $class = ref $self;
my $clone = $class->new;
### split out accessors with and without allow handlers, so we
### don't install dummy allow handlers (which makes O::A::lvalue
### warn for example)
my %hash; my @list;
for my $acc ( $self->ls_accessors ) {
my $allow = $self->{$acc}->[ALLOW];
$allow ? $hash{$acc} = $allow : push @list, $acc;
### is this an alias?
if( my $org = $self->{ $acc }->[ ALIAS ] ) {
$clone->___alias( $acc => $org );
}
}
### copy the accessors from $self to $clone
$clone->mk_accessors( \%hash ) if %hash;
$clone->mk_accessors( @list ) if @list;
### copy callbacks
#$clone->{"$clone"} = $self->{"$self"} if $self->{"$self"};
$clone->___callback( $self->___callback );
return $clone;
}
=head2 $bool = $self->mk_flush;
Flushes all the data from the current object; all accessors will be
set back to their default state of C<undef>.
Returns true on success and false on failure.
=cut
sub mk_flush {
my $self = $_[0];
# set each accessor's data to undef
$self->{$_}->[VALUE] = undef for $self->ls_accessors;
return 1;
}
=head2 $bool = $self->mk_verify;
Checks if all values in the current object are in accordance with their
own allow handler. Specifically useful to check if an empty initialised
object has been filled with values satisfying their own allow criteria.
=cut
sub mk_verify {
my $self = $_[0];
my $fail;
for my $name ( $self->ls_accessors ) {
unless( allow( $self->$name, $self->ls_allow( $name ) ) ) {
my $val = defined $self->$name ? $self->$name : '<undef>';
__PACKAGE__->___error("'$name' ($val) is invalid");
$fail++;
}
}
return if $fail;
return 1;
}
=head2 $bool = $self->register_callback( sub { ... } );
This method allows you to register a callback, that is invoked
every time an accessor is called. This allows you to munge input
data, access external data stores, etc.
You are free to return whatever you wish. On a C<set> call, the
data is even stored in the object.
Below is an example of the use of a callback.
$object->some_method( "some_value" );
my $callback = sub {
my $self = shift; # the object
my $meth = shift; # "some_method"
my $val = shift; # ["some_value"]
# could be undef -- check 'exists';
# if scalar @$val is empty, it was a 'get'
# your code here
return $new_val; # the value you want to be set/returned
}
To access the values stored in the object, circumventing the
callback structure, you should use the C<___get> and C<___set> methods
documented further down.
=cut
sub register_callback {
my $self = shift;
my $sub = shift or return;
### use the memory address as key, it's not used EVER as an
### accessor --kane
$self->___callback( $sub );
return 1;
}
=head2 $bool = $self->can( METHOD_NAME )
This method overrides C<UNIVERAL::can> in order to provide coderefs to
accessors which are loaded on demand. It will behave just like
C<UNIVERSAL::can> where it can -- returning a class method if it exists,
or a closure pointing to a valid accessor of this particular object.
You can use it as follows:
$sub = $object->can('some_accessor'); # retrieve the coderef
$sub->('foo'); # 'some_accessor' now set
# to 'foo' for $object
$foo = $sub->(); # retrieve the contents
# of 'some_accessor'
See the C<SYNOPSIS> for more examples.
=cut
### custom 'can' as UNIVERSAL::can ignores autoload
sub can {
my($self, $method) = @_;
### it's one of our regular methods
my $code = $self->UNIVERSAL::can($method);
if( $code ) {
carp( "Can '$method' -- provided by package" ) if $DEBUG;
return $code;
}
### it's an accessor we provide;
if( UNIVERSAL::isa( $self, 'HASH' ) and exists $self->{$method} ) {
carp( "Can '$method' -- provided by object" ) if $DEBUG;
return sub { $self->$method(@_); }
}
### we don't support it
carp( "Cannot '$method'" ) if $DEBUG;
return;
}
### don't autoload this
sub DESTROY { 1 };
### use autoload so we can have per-object accessors,
### not per class, as that is incorrect
sub AUTOLOAD {
my $self = shift;
my($method) = ($AUTOLOAD =~ /([^:']+$)/);
my $val = $self->___autoload( $method, @_ ) or return;
return $val->[0];
}
sub ___autoload {
my $self = shift;
my $method = shift;
my $assign = scalar @_; # is this an assignment?
### a method on our object
if( UNIVERSAL::isa( $self, 'HASH' ) ) {
if ( not exists $self->{$method} ) {
__PACKAGE__->___error("No such accessor '$method'", 1);
return;
}
### a method on something else, die with a descriptive error;
} else {
local $FATAL = 1;
__PACKAGE__->___error(
"You called '$AUTOLOAD' on '$self' which was interpreted by ".
__PACKAGE__ . " as an object call. Did you mean to include ".
"'$method' from somewhere else?", 1 );
}
### is this is an alias, redispatch to the original method
if( my $original = $self->{ $method }->[ALIAS] ) {
return $self->___autoload( $original, @_ );
}
### assign?
my $val = $assign ? shift(@_) : $self->___get( $method );
if( $assign ) {
### any binding?
if( $_[0] ) {
if( ref $_[0] and UNIVERSAL::isa( $_[0], 'SCALAR' ) ) {
### tie the reference, so we get an object and
### we can use it's going out of scope to restore
### the old value
my $cur = $self->{$method}->[VALUE];
tie ${$_[0]}, __PACKAGE__ . '::TIE',
sub { $self->$method( $cur ) };
${$_[0]} = $val;
} else {
__PACKAGE__->___error(
"Can not bind '$method' to anything but a SCALAR", 1
);
}
}
### need to check the value?
if( defined $self->{$method}->[ALLOW] ) {
### double assignment due to 'used only once' warnings
local $Params::Check::VERBOSE = 0;
local $Params::Check::VERBOSE = 0;
allow( $val, $self->{$method}->[ALLOW] ) or (
__PACKAGE__->___error(
"'$val' is an invalid value for '$method'", 1),
return
);
}
}
### callbacks?
if( my $sub = $self->___callback ) {
$val = eval { $sub->( $self, $method, ($assign ? [$val] : []) ) };
### register the error
$self->___error( $@, 1 ), return if $@;
}
### now we can actually assign it
if( $assign ) {
$self->___set( $method, $val ) or return;
}
return [$val];
}
=head2 $val = $self->___get( METHOD_NAME );
Method to directly access the value of the given accessor in the
object. It circumvents all calls to allow checks, callbacks, etc.
Use only if you C<Know What You Are Doing>! General usage for
this functionality would be in your own custom callbacks.
=cut
### XXX O::A::lvalue is mirroring this behaviour! if this
### changes, lvalue's autoload must be changed as well
sub ___get {
my $self = shift;
my $method = shift or return;
return $self->{$method}->[VALUE];
}
=head2 $bool = $self->___set( METHOD_NAME => VALUE );
Method to directly set the value of the given accessor in the
object. It circumvents all calls to allow checks, callbacks, etc.
Use only if you C<Know What You Are Doing>! General usage for
this functionality would be in your own custom callbacks.
=cut
sub ___set {
my $self = shift;
my $method = shift or return;
### you didn't give us a value to set!
@_ or return;
my $val = shift;
### if there's more arguments than $self, then
### replace the method called by the accessor.
### XXX implement rw vs ro accessors!
$self->{$method}->[VALUE] = $val;
return 1;
}
=head2 $bool = $self->___alias( ALIAS => METHOD );
Method to directly alias one accessor to another for
this object. It circumvents all sanity checks, etc.
Use only if you C<Know What You Are Doing>!
=cut
sub ___alias {
my $self = shift;
my $alias = shift or return;
my $method = shift or return;
$self->{ $alias }->[ALIAS] = $method;
return 1;
}
sub ___debug {
return unless $DEBUG;
my $self = shift;
my $msg = shift;
local $Carp::CarpLevel += 1;
carp($msg);
}
sub ___error {
my $self = shift;
my $msg = shift;
my $lvl = shift || 0;
local $Carp::CarpLevel += ($lvl + 1);
$FATAL ? croak($msg) : carp($msg);
}
### objects might be overloaded.. if so, we can't trust what "$self"
### will return, which might get *really* painful.. so check for that
### and get their unoverloaded stringval if needed.
sub ___callback {
my $self = shift;
my $sub = shift;
my $mem = overload::Overloaded( $self )
? overload::StrVal( $self )
: "$self";
$self->{$mem} = $sub if $sub;
return $self->{$mem};
}
=head1 LVALUE ACCESSORS
C<Object::Accessor> supports C<lvalue> attributes as well. To enable
these, you should create your objects in the designated namespace,
C<Object::Accessor::Lvalue>. For example:
my $obj = Object::Accessor::Lvalue->new('foo');
$obj->foo += 1;
print $obj->foo;
will actually print C<1> and work as expected. Since this is an
optional feature, that's not desirable in all cases, we require
you to explicitly use the C<Object::Accessor::Lvalue> class.
Doing the same on the standard C<Object>>Accessor> class would
generate the following code & errors:
my $obj = Object::Accessor->new('foo');
$obj->foo += 1;
Can't modify non-lvalue subroutine call
Note that C<lvalue> support on C<AUTOLOAD> routines is a
C<perl 5.8.x> feature. See perldoc L<perl58delta> for details.
=head2 CAVEATS
=over 4
=item * Allow handlers
Due to the nature of C<lvalue subs>, we never get access to the
value you are assigning, so we can not check it against your allow
handler. Allow handlers are therefor unsupported under C<lvalue>
conditions.
See C<perldoc perlsub> for details.
=item * Callbacks
Due to the nature of C<lvalue subs>, we never get access to the
value you are assigning, so we can not check provide this value
to your callback. Furthermore, we can not distinguish between
a C<get> and a C<set> call. Callbacks are therefor unsupported
under C<lvalue> conditions.
See C<perldoc perlsub> for details.
=cut
{ package Object::Accessor::Lvalue;
use base 'Object::Accessor';
use strict;
use vars qw[$AUTOLOAD];
### constants needed to access values from the objects
*VALUE = *Object::Accessor::VALUE;
*ALLOW = *Object::Accessor::ALLOW;
### largely copied from O::A::Autoload
sub AUTOLOAD : lvalue {
my $self = shift;
my($method) = ($AUTOLOAD =~ /([^:']+$)/);
$self->___autoload( $method, @_ ) or return;
### *don't* add return to it, or it won't be stored
### see perldoc perlsub on lvalue subs
### XXX can't use $self->___get( ... ), as we MUST have
### the container that's used for the lvalue assign as
### the last statement... :(
$self->{$method}->[ VALUE() ];
}
sub mk_accessors {
my $self = shift;
my $is_hash = UNIVERSAL::isa( $_[0], 'HASH' );
$self->___error(
"Allow handlers are not supported for '". __PACKAGE__ ."' objects"
) if $is_hash;
return $self->SUPER::mk_accessors( @_ );
}
sub register_callback {
my $self = shift;
$self->___error(
"Callbacks are not supported for '". __PACKAGE__ ."' objects"
);
return;
}
}
### standard tie class for bound attributes
{ package Object::Accessor::TIE;
use Tie::Scalar;
use base 'Tie::StdScalar';
my %local = ();
sub TIESCALAR {
my $class = shift;
my $sub = shift;
my $ref = undef;
my $obj = bless \$ref, $class;
### store the restore sub
$local{ $obj } = $sub;
return $obj;
}
sub DESTROY {
my $tied = shift;
my $sub = delete $local{ $tied };
### run the restore sub to set the old value back
return $sub->();
}
}
=back
=head1 GLOBAL VARIABLES
=head2 $Object::Accessor::FATAL
Set this variable to true to make all attempted access to non-existent
accessors be fatal.
This defaults to C<false>.
=head2 $Object::Accessor::DEBUG
Set this variable to enable debugging output.
This defaults to C<false>.
=head1 TODO
=head2 Create read-only accessors
Currently all accessors are read/write for everyone. Perhaps a future
release should make it possible to have read-only accessors as well.
=head1 CAVEATS
If you use codereferences for your allow handlers, you will not be able
to freeze the data structures using C<Storable>.
Due to a bug in storable (until at least version 2.15), C<qr//> compiled
regexes also don't de-serialize properly. Although this bug has been
reported, you should be aware of this issue when serializing your objects.
You can track the bug here:
http://rt.cpan.org/Ticket/Display.html?id=1827
=head1 BUG REPORTS
Please report bugs or other issues to E<lt>bug-object-accessor@rt.cpan.orgE<gt>.
=head1 AUTHOR
This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
=head1 COPYRIGHT
This library is free software; you may redistribute and/or modify it
under the same terms as Perl itself.
=cut
1;

320
database/perl/vendor/lib/Object/Tiny.pm vendored Normal file
View File

@@ -0,0 +1,320 @@
package Object::Tiny; # git description: 5abde2e
use strict 'vars', 'subs';
our $VERSION = '1.09';
sub import {
return unless shift eq 'Object::Tiny';
my $pkg = caller;
my $child = !! @{"${pkg}::ISA"};
eval join "\n",
"package $pkg;",
($child ? () : "\@${pkg}::ISA = 'Object::Tiny';"),
map {
defined and ! ref and /^[^\W\d]\w*\z/s
or die "Invalid accessor name '$_'";
"sub $_ { return \$_[0]->{$_} }"
} @_;
die "Failed to generate $pkg" if $@;
return 1;
}
sub new {
my $class = shift;
bless { @_ }, $class;
}
1;
__END__
=pod
=head1 NAME
Object::Tiny - Class building as simple as it gets
=head1 SYNOPSIS
# Define a class
package Foo;
use Object::Tiny qw{ bar baz };
1;
# Use the class
my $object = Foo->new( bar => 1 );
print "bar is " . $object->bar . "\n";
=head1 DESCRIPTION
There's a whole bunch of class builders out there. In fact, creating
a class builder seems to be something of a rite of passage (this is
my fifth, at least).
Unfortunately, most of the time I want a class builder I'm in a
hurry and sketching out lots of fairly simple data classes with fairly
simple structure, mostly just read-only accessors, and that's about it.
Often this is for code that won't end up on CPAN, so adding a small
dependency doesn't matter much. I just want to be able to define these
classes FAST.
By which I mean LESS typing than writing them by hand, not more. And
I don't need all those weird complex features that bloat out the code
and take over the whole way I build modules.
And so, I present yet another member of the Tiny family of modules,
Object::Tiny.
The goal here is really just to save me some typing. There's others
that could do the job just fine, but I want something that does as little
as possible and creates code the same way I'd have written it by hand
anyway.
To use Object::Tiny, just call it with a list of accessors to be created.
use Object::Tiny 'foo', 'bar';
For a large list, I lay it out like this...
use Object::Tiny qw{
item_font_face
item_font_color
item_font_size
item_text_content
item_display_time
seperator_font_face
seperator_font_color
seperator_font_size
seperator_text_content
};
This will create a bunch of simple accessors, and set the inheritance to
be the child of Object::Tiny.
Object::Tiny is empty other than a basic C<new> constructor which
does the following
sub new {
my $class = shift;
return bless { @_ }, $class;
}
In fact, if doing the following in your class gets annoying...
sub new {
my $class = shift;
my $self = $class->SUPER::new( @_ );
# Extra checking and such
...
return $self;
}
... then feel free to ditch the SUPER call and just create the hash
yourself! It's not going to make a lick of different and there's nothing
magic going on under the covers you might break.
And that's really all there is to it. Let a million simple data classes
bloom. Features? We don't need no stinking features.
=head2 Handling Subclasses
If the class you are using Object::Tiny for is already a subclass of
another Object::Tiny class (or a subclass of anything else) it doesn't
really work to make the class use multiple inheritance.
So in this case, Object::Tiny will create the accessors you specify, but
WON'T make it a subclass of Object::Tiny.
=head2 Why bother when Class::Accessor::* already does the same thing?
As a class builder, L<Object::Tiny> inevitably is compared to
L<Class::Accessor> and related modules. They seem so similar, so why would
I reimplement it?
The answer is that for experienced developers that don't need or want
hand-holding, Object::Tiny is just outright better, faster or cheaper
on every single metric than L<Class::Accessor::Fast>, which
is the most comparable member of the Class::Accessor::* family.
B<Object::Tiny is 93% smaller than Class::Accessor::Fast>
L<Class::Accessor::Fast> requires about 125k of memory to load.
Object::Tiny requires about 8k of memory to load.
B<Object::Tiny is 75% more terse to use than Class::Accessor::Fast>
Object::Tiny is used with the least possible number of keystrokes
(short of making the actual name Object::Tiny smaller).
And it requires no ugly constructor methods.
I mean really, what sort of a method name is 'mk_ro_accessors'. That sort
of thing went out of style in the early nineties.
Using Class::Accessor::Fast...
package Foo::Bar;
use base 'Class::Accessor::Fast';
Foo::Bar->mk_ro_accessors(qw{ foo bar baz });
Using Object::Tiny...
package Foo::Bar;
use Object::Tiny qw{ foo bar baz };
Further, Object::Tiny lets you pass your params in directly, without
having to wrap them in an additional HASH reference that will just be
copied ANYWAY inside the constructor.
Using Class::Accessor::Fast...
my $object = Foo::Bar->new( {
foo => 1,
bar => 2,
baz => 3,
} );
Using Object::Tiny...
my $object = Foo::Bar->new(
foo => 1,
bar => 2,
baz => 3,
);
B<Object::Tiny constructors are 110% faster than Class::Accessor::Fast>
Object::Tiny accessors are identical in speed to Class::Accessor::Fast
accessors, but Object::Tiny constructors are TWICE as fast as
Class::Accessor::Fast constructors, DESPITE C:A:Fast forcing you to pass
by reference (which is typically done for speed reasons).
Benchmarking constructor plus accessors...
Rate accessor tiny
accessor 100949/s -- -45%
tiny 182382/s 81% --
Benchmarking constructor alone...
Rate accessor tiny
accessor 156470/s -- -54%
tiny 342231/s 119% --
Benchmarking accessors alone...
Rate tiny accessor
tiny 81.0/s -- -0%
accessor 81.0/s 0% --
B<Object::Tiny pollutes your API 95% less than Class::Accessor::Fast>
Object::Tiny adds two methods to your class, C<new> and C<import>. The
C<new> constructor is so trivial you can just ignore it and use your own
if you wish, and the C<import> will shortcut and do nothing (it is used to
implement the C<"use Object::Tiny qw{ foo bar baz };"> syntax itself).
So if you make your own import, you can ignore the Object::Tiny one.
Class::Accessor::Fast isn't quite as light, adding all sorts of useless
extra public methods (why on earth would you want to add method accessors
at run-time?).
Here's what the classes used in the benchmark end up like.
DB<1> use Class::Inspector
DB<2> x Class::Inspector->methods('Foo_Bar_Tiny');
0 ARRAY(0xfda780)
0 'bar'
1 'baz'
2 'foo'
3 'import'
4 'new'
DB<3> x Class::Inspector->methods('Foo_Bar_Accessor');
0 ARRAY(0xfdb3c8)
0 '_bar_accessor'
1 '_baz_accessor'
2 '_carp'
3 '_croak'
4 '_foo_accessor'
5 '_mk_accessors'
6 'accessor_name_for'
7 'bar'
8 'baz'
9 'best_practice_accessor_name_for'
10 'best_practice_mutator_name_for'
11 'follow_best_practice'
12 'foo'
13 'get'
14 'make_accessor'
15 'make_ro_accessor'
16 'make_wo_accessor'
17 'mk_accessors'
18 'mk_ro_accessors'
19 'mk_wo_accessors'
20 'mutator_name_for'
21 'new'
22 'set'
As you can see, Object::Tiny adds 2 methods to your class, Class::Accessor
adds 16 methods, plus one extra one for every accessor.
B<Object::Tiny doesn't have any of the caveats of Class::Accessor::Fast>
When you call B<use Object::Tiny qw{ foo bar baz }> it isn't treated as some
sort of specification for the class, it's just a list of accessors you want
made for you.
So if you want to customize C<foo> you don't need to get into contortions with
"pure" base classes or calling alternate internal methods. Just make your own
C<foo> method and remove C<foo> from the list passed to the C<use> call.
B<Object::Tiny is more back-compatible than Class::Accessor::Fast>
Class::Accessor::Fast has a minimum Perl dependency of 5.005002.
Object::Tiny has a minimum Perl dependency of 5.004.
B<Object::Tiny has no module dependencies whatsoever>
Object::Tiny does not load ANYTHING at all outside of its own single .pm file.
So Object::Tiny will never get confused in odd situations due to old or weird
versions of other modules (Class::Accessor::Fast has a dependency on base.pm,
which has some caveats of its own).
=head1 SUPPORT
Bugs should be reported via the CPAN bug tracker at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Object-Tiny>
For other issues, contact the author.
=head1 AUTHOR
Adam Kennedy E<lt>adamk@cpan.orgE<gt>
=head1 SEE ALSO
L<Config::Tiny>
=head1 COPYRIGHT
Copyright 2007 - 2011 Adam Kennedy.
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