Dancer::Object - Objects base class for Dancer

Dancer documentation Contained in the Dancer distribution.

Index

Code Index:

NAME

Top

Dancer::Object - Objects base class for Dancer

SYNOPSIS

Top

    package My::Dancer::Extension;

    use strict;
    use warnings;
    use base 'Dancer::Object';

    __PACKAGE__->attributes( qw/name value this that/ );

    sub init {
        # our initialization code, if we need one
    }

DESCRIPTION

Top

While we love Moose, we can't use it for Dancer and still keep Dancer minimal, so we wrote Dancer::Object instead.

It provides you with attributes and an initializer.

METHODS

Top

new

Creates a new object of whatever is based off Dancer::Object. This is a generic new method so you don't have to write one yourself when extending Dancer::Object.

It accepts arguments in a hash and runs an additional init method (described below) which you should implement.

init

Exists but does nothing. This is so you won't have to write an initializer if you don't want to.

clone

Creates and returns a clone of the object using Clone, which is loaded dynamically. If we cannot load Clone, we throw an exception.

get_attributes

Get the attributes of the specific class.

attributes

Generates attributes for whatever object is extending Dancer::Object and saves them in an internal hashref so they can be later fetched using get_attributes.

attributes_defaults

  $self->attributes_defaults(length => 2);

given a hash (not a hashref), makes sure an object has the given attributes default values. Usually called from within an init function.

AUTHOR

Top

Alexis Sukrieh

LICENSE AND COPYRIGHT

Top

Copyright 2009-2010 Alexis Sukrieh.

This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

Dancer documentation Contained in the Dancer distribution. 
package Dancer::Object;

# This class is a root class for each object in Dancer.
# It provides basic OO tools for Perl5 without being... Moose ;-)

use strict;
use warnings;
use Carp;

# constructor
sub new {
    my ($class, %args) = @_;
    my $self = \%args;
    bless $self, $class;
    $self->init(%args);
    return $self;
}

sub clone {
    my ($self) = @_;
    croak "The 'Clone' module is needed"
        unless Dancer::ModuleLoader->load('Clone');
    return Clone::clone($self);
}

# initializer
sub init {1}

# meta information about classes
my $_attrs_per_class = {};
sub get_attributes {
    my ($class, $visited_parents) = @_;
    # $visited_parents keeps track of parent classes we already handled, to
    # avoid infinite recursion (in case of dependancies loop). It's not stored as class singleton, otherwise
    # get_attributes wouldn't be re-entrant.
    $visited_parents ||= {};
    my @attributes = @{$_attrs_per_class->{$class} || [] };
    my @parents;
    { no strict 'refs';
      @parents = @{"$class\::ISA"}; }
    foreach my $parent (@parents) {
        # cleanup $parent
        $parent =~ s/'/::/g;
        $parent =~ /^::/
          and $parent = 'main' . $parent;

        # check we didn't visited it already
        $visited_parents->{$parent}++
          and next;

        # check it's a Dancer::Object
        $parent->isa(__PACKAGE__)
          or next;

        # merge parents attributes
        push @attributes, @{$parent->get_attributes($visited_parents)};
    }
    return \@attributes;
}

# accessor code for normal objects
# (overloaded in D::O::Singleton for instance)
sub _setter_code {
    my ($class, $attr) = @_;
    sub {
        my ($self, $value) = @_;
        if (@_ == 1) {
            return $self->{$attr};
        }
        else {
            return $self->{$attr} = $value;
        }
    };
}

# accessors builder
sub attributes {
    my ($class, @attributes) = @_;

    # save meta information
    $_attrs_per_class->{$class} = \@attributes;

    # define setters and getters for each attribute
    foreach my $attr (@attributes) {
        my $code = $class->_setter_code($attr);
        my $method = "${class}::${attr}";
        { no strict 'refs'; *$method = $code; }
    }
}

sub attributes_defaults {
    my ($self, %defaults) = @_;
    while (my ($k, $v) = each %defaults) {
        exists $self->{$k} or $self->{$k} = $v;
    }
}

1;

__END__