Class-Accessor-Children-0.02/0000755000175000017500000000000010660744627015206 5ustar u-sukeu-sukeClass-Accessor-Children-0.02/lib/0000755000175000017500000000000010660744627015754 5ustar u-sukeu-sukeClass-Accessor-Children-0.02/lib/Class/0000755000175000017500000000000010660744627017021 5ustar u-sukeu-sukeClass-Accessor-Children-0.02/lib/Class/Accessor/0000755000175000017500000000000010660744627020563 5ustar u-sukeu-sukeClass-Accessor-Children-0.02/lib/Class/Accessor/Children/0000755000175000017500000000000010660744627022313 5ustar u-sukeu-sukeClass-Accessor-Children-0.02/lib/Class/Accessor/Children/Fast.pm0000755000175000017500000000567010660744577023565 0ustar u-sukeu-sukepackage 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; Class-Accessor-Children-0.02/lib/Class/Accessor/Children.pm0000755000175000017500000000554010660744575022662 0ustar u-sukeu-sukepackage 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; Class-Accessor-Children-0.02/t/0000755000175000017500000000000010660744627015451 5ustar u-sukeu-sukeClass-Accessor-Children-0.02/t/21_children_fast.t0000644000175000017500000000521410660565537020750 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 29; use_ok qw( Class::Accessor::Children::Fast ); # ---------------------------------------------------------------- { package Foo; use base qw( Class::Accessor::Children::Fast ); __PACKAGE__->mk_child_accessors( Odd => [qw( one seven )], Even => [qw( two eight )], ); __PACKAGE__->mk_child_ro_accessors( Odd => [qw( three nine )], Even => [qw( four ten )], ); __PACKAGE__->mk_child_wo_accessors( Odd => [qw( five eleven )], Even => [qw( six twelve )], ); } # ---------------------------------------------------------------- { my $odd = Foo::Odd->new( {one=>1,three=>3,five=>5} ); ok( ref $odd, 'odd - new' ); ok( $odd->isa( 'Class::Accessor' ), 'odd - isa' ); ok( ! $odd->can( 'zero' ), 'odd - zero' ); my $even = Foo::Even->new( {two=>2,four=>4,six=>6} ); ok( ref $even, 'even - new' ); ok( $even->isa( 'Class::Accessor' ), 'even - isa' ); ok( ! $even->can( 'zero' ), 'even - zero' ); # read is( $odd->one, 1, 'read one' ); is( $even->two, 2, 'read two' ); is( $odd->three, 3, 'read three' ); is( $even->four, 4, 'read four' ); { local $@; eval { $odd->five; }; ok( $@, 'read five [write-only]' ); } { local $@; eval { $even->six; }; ok( $@, 'read six [write-only]' ); } is( $odd->seven, undef, 'read three' ); is( $even->eight, undef, 'read eight' ); is( $odd->nine, undef, 'read nine' ); is( $even->ten, undef, 'read ten' ); # write ok( $odd->seven( 7 ), 'write seven' ); ok( $even->eight( 8 ), 'write eight' ); { local $@; eval { $odd->nine( 9 ); }; ok( $@, 'write nine [read-only]' ); } { local $@; eval { $odd->ten( 10 ); }; ok( $@, 'write ten [read-only]' ); } ok( $odd->eleven( 11 ), 'write eleven' ); ok( $even->twelve( 12 ), 'write twelve' ); # read is( $odd->seven, 7, 'read three' ); is( $even->eight, 8, 'read eight' ); is( $odd->nine, undef, 'read nine' ); is( $even->ten, undef, 'read ten' ); { local $@; eval { $odd->eleven; }; ok( $@, 'read eleven [write-only]' ); } { local $@; eval { $even->twelve; }; ok( $@, 'read twelve [write-only]' ); } } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- Class-Accessor-Children-0.02/t/20_accessors_fast.t0000644000175000017500000000306410660565541021140 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 15; use_ok qw( Class::Accessor::Children::Fast ); # ---------------------------------------------------------------- { package Foo; use base qw( Class::Accessor::Children::Fast ); __PACKAGE__->mk_accessors(qw( one two )); __PACKAGE__->mk_ro_accessors(qw( three four )); __PACKAGE__->mk_wo_accessors(qw( five six )); } # ---------------------------------------------------------------- foreach my $class (qw( Foo )) { my $foo = $class->new( {one=>1,three=>3,five=>5} ); ok( ref $foo, 'foo - new' ); ok( $foo->isa( 'Class::Accessor' ), 'foo - isa' ); ok( ! $foo->can( 'zero' ), 'foo - zero' ); # read is( $foo->one, 1, 'read one' ); is( $foo->two, undef, 'read two' ); is( $foo->three, 3, 'read three' ); is( $foo->four, undef, 'read four' ); { local $@; eval { $foo->five; }; ok( $@, 'read five [write-only]' ); } # write ok( $foo->two( 2 ), 'write two' ); { local $@; eval { $foo->four( 4 ); }; ok( $@, 'write four [read-only]' ); } ok( $foo->six( 6 ), 'write six' ); # read is( $foo->two, 2, 'read two' ); is( $foo->four, undef, 'read four' ); { local $@; eval { $foo->six; }; ok( $@, 'read six [write-only]' ); } } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- Class-Accessor-Children-0.02/t/22_error_fast.t0000644000175000017500000000232410660565534020306 0ustar u-sukeu-suke# ---------------------------------------------------------------- package Foo; use strict; use Test::More tests => 9; use_ok qw( Class::Accessor::Children::Fast ); use base qw( Class::Accessor::Children::Fast ); # ---------------------------------------------------------------- { { local $@; eval { __PACKAGE__->mk_child_accessors(); }; ok( ! $@, 'no accessors' ); } { local $@; eval { __PACKAGE__->mk_child_accessors( 'odd' ); }; ok( $@, 'odd number arguments' ); } { local $@; eval { __PACKAGE__->mk_child_accessors( [], [] ); }; ok( $@, 'Invalid child class name' ); } { local $@; eval { __PACKAGE__->mk_child_accessors( child => 'aaa bbb' ); }; ok( ! $@, 'scalar' ); ok( Foo::child->can( 'aaa' ), 'split 1' ); ok( Foo::child->can( 'bbb' ), 'split 2' ); } { local $@; eval { __PACKAGE__->mk_child_accessors( '' => [qw( ccc )] ); }; ok( ! $@, 'zero' ); ok( Foo->can( 'ccc' ), 'base' ); } } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- Class-Accessor-Children-0.02/t/12_error.t0000644000175000017500000000231010660565526017264 0ustar u-sukeu-suke# ---------------------------------------------------------------- package Foo; use strict; use Test::More tests => 9; use_ok qw( Class::Accessor::Children ); use base qw( Class::Accessor::Children ); # ---------------------------------------------------------------- { { local $@; eval { __PACKAGE__->mk_child_accessors(); }; ok( ! $@, 'no accessors' ); } { local $@; eval { __PACKAGE__->mk_child_accessors( 'odd' ); }; ok( $@, 'odd number arguments' ); } { local $@; eval { __PACKAGE__->mk_child_accessors( [], [] ); }; ok( $@, 'Invalid child class name' ); } { local $@; eval { __PACKAGE__->mk_child_accessors( child => 'aaa bbb' ); }; ok( ! $@, 'scalar' ); ok( Foo::child->can( 'aaa' ), 'split 1' ); ok( Foo::child->can( 'bbb' ), 'split 2' ); } { local $@; eval { __PACKAGE__->mk_child_accessors( '' => [qw( ccc )] ); }; ok( ! $@, 'zero' ); ok( Foo->can( 'ccc' ), 'base' ); } } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- Class-Accessor-Children-0.02/t/01_new.t0000644000175000017500000000121010660565472016720 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 4; # ---------------------------------------------------------------- { use_ok qw( Class::Accessor::Children ); my $api = Class::Accessor::Children->new(); ok( ref $api, 'new()' ); } # ---------------------------------------------------------------- { use_ok qw( Class::Accessor::Children::Fast ); my $api = Class::Accessor::Children::Fast->new(); ok( ref $api, 'new()' ); } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- Class-Accessor-Children-0.02/t/00_pod.t0000644000175000017500000000037710660565353016723 0ustar u-sukeu-sukeuse strict; use Test::More; my $FILES = [qw( lib/Class/Accessor/Children.pm lib/Class/Accessor/Children/Fast.pm )]; local $@; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok( @$FILES ); ;1; Class-Accessor-Children-0.02/t/11_children.t0000644000175000017500000000520010660565522017717 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 29; use_ok qw( Class::Accessor::Children ); # ---------------------------------------------------------------- { package Foo; use base qw( Class::Accessor::Children ); __PACKAGE__->mk_child_accessors( Odd => [qw( one seven )], Even => [qw( two eight )], ); __PACKAGE__->mk_child_ro_accessors( Odd => [qw( three nine )], Even => [qw( four ten )], ); __PACKAGE__->mk_child_wo_accessors( Odd => [qw( five eleven )], Even => [qw( six twelve )], ); } # ---------------------------------------------------------------- { my $odd = Foo::Odd->new( {one=>1,three=>3,five=>5} ); ok( ref $odd, 'odd - new' ); ok( $odd->isa( 'Class::Accessor' ), 'odd - isa' ); ok( ! $odd->can( 'zero' ), 'odd - zero' ); my $even = Foo::Even->new( {two=>2,four=>4,six=>6} ); ok( ref $even, 'even - new' ); ok( $even->isa( 'Class::Accessor' ), 'even - isa' ); ok( ! $even->can( 'zero' ), 'even - zero' ); # read is( $odd->one, 1, 'read one' ); is( $even->two, 2, 'read two' ); is( $odd->three, 3, 'read three' ); is( $even->four, 4, 'read four' ); { local $@; eval { $odd->five; }; ok( $@, 'read five [write-only]' ); } { local $@; eval { $even->six; }; ok( $@, 'read six [write-only]' ); } is( $odd->seven, undef, 'read three' ); is( $even->eight, undef, 'read eight' ); is( $odd->nine, undef, 'read nine' ); is( $even->ten, undef, 'read ten' ); # write ok( $odd->seven( 7 ), 'write seven' ); ok( $even->eight( 8 ), 'write eight' ); { local $@; eval { $odd->nine( 9 ); }; ok( $@, 'write nine [read-only]' ); } { local $@; eval { $odd->ten( 10 ); }; ok( $@, 'write ten [read-only]' ); } ok( $odd->eleven( 11 ), 'write eleven' ); ok( $even->twelve( 12 ), 'write twelve' ); # read is( $odd->seven, 7, 'read three' ); is( $even->eight, 8, 'read eight' ); is( $odd->nine, undef, 'read nine' ); is( $even->ten, undef, 'read ten' ); { local $@; eval { $odd->eleven; }; ok( $@, 'read eleven [write-only]' ); } { local $@; eval { $even->twelve; }; ok( $@, 'read twelve [write-only]' ); } } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- Class-Accessor-Children-0.02/t/10_accessors.t0000644000175000017500000000305010660565511020112 0ustar u-sukeu-suke# ---------------------------------------------------------------- use strict; use Test::More tests => 15; use_ok qw( Class::Accessor::Children ); # ---------------------------------------------------------------- { package Foo; use base qw( Class::Accessor::Children ); __PACKAGE__->mk_accessors(qw( one two )); __PACKAGE__->mk_ro_accessors(qw( three four )); __PACKAGE__->mk_wo_accessors(qw( five six )); } # ---------------------------------------------------------------- foreach my $class (qw( Foo )) { my $foo = $class->new( {one=>1,three=>3,five=>5} ); ok( ref $foo, 'foo - new' ); ok( $foo->isa( 'Class::Accessor' ), 'foo - isa' ); ok( ! $foo->can( 'zero' ), 'foo - zero' ); # read is( $foo->one, 1, 'read one' ); is( $foo->two, undef, 'read two' ); is( $foo->three, 3, 'read three' ); is( $foo->four, undef, 'read four' ); { local $@; eval { $foo->five; }; ok( $@, 'read five [write-only]' ); } # write ok( $foo->two( 2 ), 'write two' ); { local $@; eval { $foo->four( 4 ); }; ok( $@, 'write four [read-only]' ); } ok( $foo->six( 6 ), 'write six' ); # read is( $foo->two, 2, 'read two' ); is( $foo->four, undef, 'read four' ); { local $@; eval { $foo->six; }; ok( $@, 'read six [write-only]' ); } } # ---------------------------------------------------------------- ;1; # ---------------------------------------------------------------- Class-Accessor-Children-0.02/Changes0000644000175000017500000000011710660744615016475 0ustar u-sukeu-suke# Class::Accessor::Children 2007/08/16 version 0.02: - the first release! Class-Accessor-Children-0.02/make-dist.sh0000755000175000017500000000111310655651150017407 0ustar u-sukeu-suke#!/bin/sh die () { echo "$*" >&2 exit 1 } doit () { echo "\$ $*" >&2 $* || die "[ERROR:$?]" } egrep -v '^t/.*\.t$' MANIFEST > MANIFEST~ ls -t t/*.t | sort >> MANIFEST~ diff MANIFEST MANIFEST~ > /dev/null || doit /bin/mv -f MANIFEST~ MANIFEST /bin/rm -f MANIFEST~ [ -f Makefile ] && doit rm -f Makefile doit perl Makefile.PL doit make doit make disttest main=`grep 'lib/.*pm$' < MANIFEST | head -1` [ "$main" == "" ] && die "main module is not found in MANIFEST" doit pod2text $main > README doit make dist doit /bin/rm -fr blib pm_to_blib ls -lt *.tar.gz | head -1 Class-Accessor-Children-0.02/MANIFEST0000644000175000017500000000050410660744627016336 0ustar u-sukeu-sukelib/Class/Accessor/Children.pm lib/Class/Accessor/Children/Fast.pm MANIFEST README Makefile.PL Changes make-dist.sh t/00_pod.t t/01_new.t t/10_accessors.t t/11_children.t t/12_error.t t/20_accessors_fast.t t/21_children_fast.t t/22_error_fast.t META.yml Module meta-data (added by MakeMaker) Class-Accessor-Children-0.02/README0000644000175000017500000000375410660744627016077 0ustar u-sukeu-sukeNAME Class::Accessor::Children - Automated child-class/accessor generation 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 )], ); DESCRIPTION This module automagically generates child classes which have accessor/mutator methods. This module inherits "Class::Accessor" to make accessors. METHODS This module provides the following methods in addition to all methods provided by "Class::Accessor". mk_child_accessors MyClass->mk_child_accessors( Foo => \@fields, ... ); This generates a child class named "MyClass::Foo" which have accessor/mutator methods each named in "\@fields". mk_child_ro_accessors MyClass->mk_child_ro_accessors( Bar => \@fields, ... ); This generates a child class named "MyClass::Bar" which have read-only accessors (ie. true accessors). mk_child_wo_accessors MyClass->mk_child_wo_accessors( Baz => \@fields, ... ); This generates a child class named "MyClass::Baz" which have write-only accessor (ie. mutators). SEE ALSO Class::Accessor AUTHOR Yusuke Kawasaki 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. Class-Accessor-Children-0.02/Makefile.PL0000644000175000017500000000064210660566004017151 0ustar u-sukeu-sukeuse strict; use ExtUtils::MakeMaker; my $opt = { NAME => 'Class::Accessor::Children', VERSION_FROM => 'lib/Class/Accessor/Children.pm', PREREQ_PM => { 'Test::More' => '0', 'Class::Accessor' => '0', }, }; my $mm = $ExtUtils::MakeMaker::VERSION; $mm =~ s/[^\d\.]+//g; $opt->{LICENSE} = 'perl' if ( $mm >= 6.3001 ); WriteMakefile( %$opt ); Class-Accessor-Children-0.02/META.yml0000644000175000017500000000062210660744627016457 0ustar u-sukeu-suke--- #YAML:1.0 name: Class-Accessor-Children version: 0.02 abstract: ~ license: perl generated_by: ExtUtils::MakeMaker version 6.36 distribution_type: module requires: Class::Accessor: 0 Test::More: 0 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2