The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.

NAME

Class::Root - framework for writing perl OO modules

VERSION

Version 0.01

SYNOPSIS

Class::Root provides a compact syntax for creating OO classes in perl with all common OO features: class and instance attributes with generated accessor methods public, private, protected, overridden and virtual methods multiple inheritance ... more ...

Class::Root declare statement is used to create OO methods and attributes. With the knowledge of all declared methods and attributes Class::Root ensures the correctness of the resulting class schema 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.

INTERNALS section below explains how Class::Root works, and what makes it different from other modules with similar purposes available from CPAN.

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

EXPORT

A list of functions that can be exported. You can delete this section if you don't export anything, such as for a purely object-oriented module.

FUNCTIONS

declare

AUTHOR

Evgeny Nifontov, <classroot at nifsa.de>

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:

ACKNOWLEDGEMENTS

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.