package Class::Accessor::Children; use base qw( Class::Accessor ); 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 - Automated child-class/accessor generation =head1 SYNOPSIS BEFORE (WITHOUT THIS) package MyClass::Foo; use base qw( Class:Accessor ); __PACKAGE__->mk_ro_accessors(qw( jacob michael joshua ethan )); package MyClass::Bar; use base qw( Class:Accessor ); __PACKAGE__->mk_ro_accessors(qw( emily emma madison isabella )); package MyClass::Baz; use base qw( Class:Accessor ); __PACKAGE__->mk_ro_accessors(qw( haruka haruto miyu yuto )); AFTER (WITH THIS) package MyClass; use base qw( Class::Accessor::Children ); __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 =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;