Class::Root - framework for writing perl OO modules
Version 0.02
Class::Root provides a compact syntax for creating OO classes in perl.
Class::Root supports:
- public, private, protected and virtual methods
- class and instance attributes with generated accessor methods
- multiple inheritance
- ...more...
Class::Root restricts developer requiring all methods and attributes to be defined using it's declare statement, but in return Class::Root ensures the correctness of the resulting class schema. Thus a problem of two base classes having a method with the same name will be detected at compile time.
Some optional checks may be defined to prove attribute values at run time.
Both run time and compile time checks could be disabled for better performance of production code.
DESCRIPTION section below explains how Class::Root works, and what makes it different from other modules with similar purposes available on CPAN.
package Foo; # Class::Root's import method takes care of @ISA array. use Class::Root "isa"; # switch to Foo's "LOCAL" namespace. package Foo::LOCAL; # now we can import some usefull functions without affecting Foo's inheritable namespace. use Some::Module qw( humpty dumpty ); # public class atribute with default value declare class_attribute favorite_color => 'red'; # private attribute name always begins with "_" declare private class_attribute _top_secret => 'QwErTy'; # declaring a readonly attribute also generates a corresponding # writable private attribute (_population in this case) declare readonly class_attribute population => 0; my $derived_class_counter = -1; # declare class method declare get_foo_dcc => class_method { my $class = shift; return $derived_class_counter; } # optional class_init method could be used for additional construction code declare overwrite class_init => class_method { my $class = shift; # base_class_init method should be called in place of SUPER::class_init # it cares of default values and multiple inheritance $class->base_class_init( @_ ); # custom class construction code $derived_class_counter++; } # class constructor should be called once after all class_attributes were declared class_initialize( _top_secret => 'AsDfGh', favorite_color => 'magenta' ); # instance attribute with default value and check_value function declare attribute a10 => setopts { value => 15, check_value => sub { return "should be integer value" unless /^\d+$/; return "10 < a10 < 25" if ( $_ le 10 or 25 le $_ ); ""; }, }; # attributes accessors can be used with argument or as lvalue Foo->favorite_color = 'blue'; Foo->favorite_color('green'); # it is possible to declare multiple attributes and methods in single declare statement declare attribute a1 => 1, private attribute _priv_a2 => 2, protected attribute _prot_a3 => 3, protected readonly attribute prot_ro_a4 => 4, m1 => method { $self = shift; return $self->X2 - $self->X1 }, _pm2 => private method { <method implementation here> }, vm3 => virtual method; # declare 'NAME' generates an instance attribute NAME declare 'a1'; # declare with out arguments just do nothing declare; # Class::Root provides a constructor "new" # customizable "init" method may be used to add additional construction code declare overwrite init => method { my $self = shift; # "base_init" method should be used in place of SUPER::init # it cares of multiple inheritance and initial values $self->base_init( _id => $self->_ID_COUNTER++, @_, ); # custom construction code $self->_population++; }; # optional instance destructor declare DESTROY => method { my $self = shift; $self->_population--; # base_destroy method calls DESTROY methods from all parent classes # in case of single parent it is equivalent to SUPER::DESTROY $self->base_destroy; }; # class_verify checks the class schema last time ( Are all virtual methods implemented? ) # we use it in the last code line and it returns true value if no errors were found, so # we don't need "1;" at the end of our module. class_verify;
Class Bar derives from class Foo:
package Bar; use Foo "isa"; # switch to Bar's LOCAL namespace package Bar::LOCAL; use strict; use warnings; our (@ISA, @EXPORT, @EXPORT_OK); # we can use the standard Exporter module or define own import function in Bar::LOCAL package use Exporter; @ISA = qw(Exporter); @EXPORT = qw( humpty dumpty ); # Symbols to autoexport (:DEFAULT tag) @EXPORT_OK = qw( rikki tikki ); # Symbols to export on request # change default value fo defined attribute declare setvalue favorite_color => "yellow"; # change default value and check_value function declare setopts a10 => { value => 23, check_value => sub { return "should be integer value" unless /^\d+$/; return "20 < a10 < 25" if ( $_ le 20 or 25 le $_ ); ""; }, }; # call class constructor class_initialize; # check class schema class_verify;
Our main program use module Bar:
# we can disable run time and also compile time checks in production code, after we know that it works use constant RT_CHECKS => 0; use constant CT_CHECKS => 0; # with out "isa" argument the import function from Bar::LOCAL package - if any exists - will be called use Bar; # constructor new defined in Class::Root my $bar1 = Bar->new( a1 => 100, a10 => 24 );
See also a working example with multiple inheritance in the EXMAPLE section below.
We start writing code for class based on Class::Root with something like this:
1: package MyClass::Foo; 2: use Class::Root "isa"; 3: package MyClass::Foo::LOCAL;
Line 1: is usual, here we define a name of our class.
Line 2: compiles Class::Root and invokes Class::Root's import method with argument "isa". With "isa" argument found, method import adds Class::Root to @MyClass::FOO::ISA array and imports some functions into MyClass::Foo:LOCAL package.
In line 3: we switch to MyClass::Foo's LOCAL namespace.
The reason for doing that is following. We want to protect Foo's inheritable namespace from getting dirty. Otherwise if we import some module such as Data::Dumper we get a Dumper method in our class. It is potentially dangerous, sappose that one of Foo's base classes really have a method with the name Dumper and it's code already contains $self->Dumper. Being invoked with instance of Foo, the Dumper function from Data::Dumper will be used, and this is unlikelly to be correct.
Importing modules into LOCAL namespace avoids this problem. And we also get an opportunity to distinguish between methods and functions. We define methods in Foo package and we define functions in Foo::LOCAL package.
Class::Root itself use this technique. For example declare function defined in Class::Root::LOCAL package will not be inherited by Class::Root's derived classes.
----------- |Class::Root| ----------- | V ------------ |MyClass::Foo| ------------ / \ V_ _V ------------ ------------ |MyClass::Bar| |MyClass::Baz| ------------ ------------ \ / _V V_ ------------ |MyClass::Hoo| ------------
File MyClass/Foo.pm:
package MyClass::Foo; # MyClass::Foo derives from Class::Root use Class::Root "isa"; # switch to our "LOCAL" namespace package MyClass::Foo::LOCAL; use strict; use warnings; # declare class attribute with default value declare class_attribute cname => "Foo"; # private attribute names always begin with "_" declare private class_attribute _ID => 0; # declaring a readonly attribute also generates a corresponding writable private attribute (_population in this case) declare readonly class_attribute population => 0; # class constructor should be called after all declarations of class attributes # here all class attributes get there default values class_initialize; # declare instance attribute with default value declare attribute foos => "FOOS"; # declare instance attribute with out default value declare favorite_color => attribute; # declare readonly instance attribute declare id => readonly attribute; # and again corresponding private writable attribute "_id" will be generated my $foo_population = 0; # declare class method declare foo_population => class_method { return $foo_population; }; # Class::Root provides a constructor "new" # Customizable "init" method may be used to add additional construction code declare overwrite init => method { my $self = shift; # "base_init" method should be used in place of SUPER::init # it cares of multiple inheritance and initial values $self->base_init( _id => $self->_ID++, @_, ); # all attribute accessors are lvalue subroutines $self->_population++; $foo_population++; }; # declare instance destructor declare DESTROY => method { my $self = shift; $self->_population--; $foo_population--; # base_destroy method calls DESTROY methods from all parent classes # in case of single parent it is equivalent to SUPER::DESTROY $self->base_destroy; }; # class_verify checks the class schema last time ( Are all virtual methods implemented? ) # we use it in the last code line and it returns true value if no errors were found, so # we don't need "1;" at the end of our module. class_verify;
File MyClass/Bar.pm:
package MyClass::Bar; # MyClass::Bar derives from MyClass::Foo use MyClass::Foo "isa"; # switch to Bar's "LOCAL" namespace package MyClass::Bar::LOCAL; use strict; use warnings; # change initial value for class attribute "cname" declared in Foo declare setvalue cname => "Bar"; # call class constructor class_initialize; # declare instance attribute declare attribute bars => "BARS"; # declare private attribute declare _bars_secret => private attribute; # declare instance method declare get_bars_secret => method { my $self = shift; return $self->_bars_secret; }; my $bar_population = 0; # declare class method declare bar_population => class_method { return $bar_population; }; declare overwrite init => method { my $self = shift; $self->base_init( @_ ); $bar_population++; $self =~ /0x([0-9a-f]+)/; $self->_bars_secret = "BAR:$1"; }; declare overwrite DESTROY => method { my $self = shift; $bar_population--; $self->base_destroy; }; class_verify;
Here another class, which derives from MyClass::Foo
File MyClass/Baz.pm:
package MyClass::Baz; # MyClass::Baz also derives from MyClass::Foo use MyClass::Foo "isa"; # switch to Bar's "LOCAL" namespace package MyClass::Baz::LOCAL; use strict; use warnings; # change initial value for class attribute "cname" declared in Foo declare setvalue cname => "Baz"; # call class constructor class_initialize; # declare instance attribute declare attribute bazs => "BAZS"; # declare private attribute declare _bazs_secret => private attribute; # declare instance method declare get_bazs_secret => method { my $self = shift; return $self->_bazs_secret; }; my $baz_population = 0; # declare instance method declare baz_population => method { return $baz_population; }; declare overwrite init => method { my $self = shift; $self->base_init( @_ ); $baz_population++; $self->_bazs_secret = "BAZ:" . (int( rand(1000) )+1000); }; declare overwrite DESTROY => method { my $self = shift; $baz_population--; $self->base_destroy; }; class_verify;
Class MyClass::Hoo derives from both MyClass::Bar and MyClass::Baz
File MyClass/Hoo.pm:
package MyClass::Hoo; use MyClass::Bar 'isa'; use MyClass::Baz 'isa'; package MyClass::Hoo::LOCAL; use strict; use warnings; declare setvalue cname => "Hoo"; class_initialize; declare attribute hoos => "HOOS"; class_verify;
File main.pl:
#!perl use MyClass::Foo; use MyClass::Bar; use MyClass::Baz; use MyClass::Hoo; my $foo1 = MyClass::Foo->new(favorite_color => "green"); my $bar1 = MyClass::Bar->new(favorite_color => "blue"); my $bar2 = MyClass::Bar->new(favorite_color => "blue2"); my $baz1 = MyClass::Baz->new(favorite_color => "red"); my $baz2 = MyClass::Baz->new(favorite_color => "red2"); my $baz3 = MyClass::Baz->new(favorite_color => "red3"); my $hoo1 = MyClass::Hoo->new(favorite_color => "white"); my $hoo2 = MyClass::Hoo->new(favorite_color => "white2"); my $hoo3 = MyClass::Hoo->new(favorite_color => "white3"); my $hoo4 = MyClass::Hoo->new(favorite_color => "white4"); print "foo1->population: ", $foo1->population, "\n"; print "bar1->population: ", $bar1->population, "\n"; print "baz1->population: ", $baz1->population, "\n"; print "hoo1->population: ", $hoo1->population, "\n"; print "hoo1->foo_population: ", $hoo1->foo_population, "\n"; print "hoo1->bar_population: ", $hoo1->bar_population, "\n"; print "hoo1->baz_population: ", $hoo1->baz_population, "\n"; print "hoo1->get_bars_secret: ", $hoo1->get_bars_secret, "\n"; print "hoo1->get_bazs_secret: ", $hoo1->get_bazs_secret, "\n"; print "hoo1->id: ", $hoo1->id, "\n"; print "hoo2->id: ", $hoo2->id, "\n"; print "hoo3->id: ", $hoo3->id, "\n"; print "hoo4->id: ", $hoo4->id, "\n"; print "hoo3->class_schema:\n", $hoo3->class_schema; print "hoo3->class_dump:\n", $hoo3->class_dump; print "hoo3->instance_dump:\n", $hoo3->instance_dump;
Here is the output from main.pl:
foo1->population: 1 bar1->population: 2 baz1->population: 3 hoo1->population: 4 hoo1->foo_population: 10 hoo1->bar_population: 6 hoo1->baz_population: 7 hoo1->get_bars_secret: BAR:818a1f0 hoo1->get_bazs_secret: BAZ:1831 hoo1->id: 0 hoo2->id: 1 hoo3->id: 2 hoo4->id: 3 hoo3->class_schema: class "MyClass::Hoo" schema: class attributes: cname MyClass::Foo population ro MyClass::Foo attributes: bars MyClass::Bar bazs MyClass::Baz favorite_color MyClass::Foo foos MyClass::Foo hoos MyClass::Hoo id ro MyClass::Foo class methods: bar_population MyClass::Bar base_class_init Class::Root class_dump Class::Root class_init Class::Root class_schema Class::Root class_schema_check Class::Root foo_population MyClass::Foo import Class::Root new Class::Root methods: DESTROY MyClass::Bar base_destroy Class::Root base_init Class::Root baz_population MyClass::Baz get_bars_secret MyClass::Bar get_bazs_secret MyClass::Baz init MyClass::Bar instance_dump Class::Root hoo3->class_dump: class "MyClass::Hoo" dump: 'cname' => 'Hoo', 'population' => 4 hoo3->instance_dump: instance "MyClass::Hoo=HASH(0x818a3ac)" dump: 'bars' => 'BARS', 'bazs' => 'BAZS', 'favorite_color' => 'white3', 'foos' => 'FOOS', 'hoos' => 'HOOS', 'id' => 2
Several interesting modules included in perl distribution or available on CPAN address similar problems.
fields, Class::Struct, Class::Generate, Class::Contract, Class::Declare.
Evgeny Nifontov, <classroot@nifsa.de>
<classroot@nifsa.de>
Class::Root is still very young, so it probably has some bugs.
Please report any bugs or feature requests to bug-class-root at rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Class-Root. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
bug-class-root at rt.cpan.org
You can find documentation for this module with the perldoc command.
perldoc Class::Root
You can also look for information at:
AnnoCPAN: Annotated CPAN documentation
http://annocpan.org/dist/Class-Root
CPAN Ratings
http://cpanratings.perl.org/d/Class-Root
RT: CPAN's request tracker
http://rt.cpan.org/NoAuth/Bugs.html?Dist=Class-Root
Search CPAN
http://search.cpan.org/dist/Class-Root
Copyright 2007 Evgeny Nifontov, all rights reserved.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
To install Class::Root, copy and paste the appropriate command in to your terminal.
cpanm
cpanm Class::Root
CPAN shell
perl -MCPAN -e shell install Class::Root
For more information on module installation, please visit the detailed CPAN module installation guide.