/ 
Class-Root-0.02
River stage zero No dependents
/ Class::Root

NAME

Class::Root - framework for writing perl OO modules

VERSION

Version 0.02

SYNOPSIS

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.

DESCRIPTION

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.

LOCAL NAMESPACE

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.

declare

attribute, class_attirbute

method, class_method

private

protected

readonly

overwrite, override

setopts, setoptions

setval, setvalue

CLASS CONSTRUCTOR

class_initialize

class_init

base_class_init

CONSTRUCTOR

new

init

base_init

DESTRUCTOR

DESTROY

base_destroy

class_verify

class_schema

class_dump

instance_dump

import

EXAMPLE

		  -----------
		 |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

SEE ALSO

Several interesting modules included in perl distribution or available on CPAN address similar problems.

fields, Class::Struct, Class::Generate, Class::Contract, Class::Declare.

AUTHOR

Evgeny Nifontov, <classroot@nifsa.de>

BUGS

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.

SUPPORT

You can find documentation for this module with the perldoc command.

perldoc Class::Root

You can also look for information at:

COPYRIGHT & LICENSE

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.