File Coverage

blib/lib/Class/Accessor/Children/Fast.pm

Criterion	Covered	Total	%
statement	29	29	100.0
branch	10	10	100.0
condition			n/a
subroutine	8	8	100.0
pod	3	3	100.0
total	50	50	100.0

package Class::Accessor::Children::Fast;
use base qw( Class::Accessor::Fast );
use Carp;
use vars qw( $VERSION );
$VERSION = '0.02';

sub mk_child_accessors {
    _mk_child_classes( mk_accessors => @_ );
}
sub mk_child_ro_accessors {
    _mk_child_classes( mk_ro_accessors => @_ );
}
sub mk_child_wo_accessors {
    _mk_child_classes( mk_wo_accessors => @_ );
}

sub _mk_child_classes {
    my $method  = shift;
    my $base    = shift;
    Carp::croak 'Odd number arguments' if scalar @_ % 2;
    while ( scalar @_ ) {
        my $name = shift;
        my $list = shift;
        Carp::croak 'Invalid child class name' if ref $name;
        $list = [ grep {$_ ne ''} split( /\s+/, $list )] unless ref $list;
        my $child = ( $name ne '' ) ? $base.'::'.$name : $base;
        if ( ! $child->isa( __PACKAGE__ )) {
            no strict 'refs';
            push( @{$child.'::ISA'}, __PACKAGE__ );
        }
        $child->$method( @$list );
    }
}

=head1 NAME

Class::Accessor::Children::Fast - Faster, child-class/accessor generation

=head1 SYNOPSIS

BEFORE (WITHOUT THIS)

    package MyClass::Foo;
    use base qw( Class:Accessor::Fast );
    __PACKAGE__->mk_ro_accessors(qw( jacob michael joshua ethan ));

    package MyClass::Bar;
    use base qw( Class:Accessor::Fast );
    __PACKAGE__->mk_ro_accessors(qw( emily emma madison isabella ));

    package MyClass::Baz;
    use base qw( Class:Accessor::Fast );
    __PACKAGE__->mk_ro_accessors(qw( haruka haruto miyu yuto ));

AFTER (WITH THIS)

    package MyClass;
    use base qw( Class::Accessor::Children::Fast );
    __PACKAGE__->mk_child_ro_accessors(
        Foo => [qw( jacob michael joshua ethan )],
        Bar => [qw( emily emma madison isabella )],
        Baz => [qw( haruka haruto miyu yuto )],
    );

=head1 DESCRIPTION

This module automagically generates child classes
which have accessor/mutator methods.

This module inherits C to make accessors.

=head1 METHODS

This module provides the following methods in addition to all methods
provided by C.

=head2 mk_child_accessors

    MyClass->mk_child_accessors( Foo => \@fields, ... );

This generates a child class named C
which have accessor/mutator methods each named in C<\@fields>.

=head2 mk_child_ro_accessors

    MyClass->mk_child_ro_accessors( Bar => \@fields, ... );

This generates a child class named C
which have read-only accessors (ie. true accessors).

=head2 mk_child_wo_accessors

    MyClass->mk_child_wo_accessors( Baz => \@fields, ... );

This generates a child class named C
which have write-only accessor (ie. mutators).

=head1 SEE ALSO

L

L

=head1 AUTHOR

Yusuke Kawasaki L

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2007 Yusuke Kawasaki. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut
1;