Class::Light - Provides cascading object initialization and autovivified accessors and mutators


Class-Light documentation Contained in the Class-Light distribution.

Index


Code Index:

NAME

Top

Class::Light - Provides cascading object initialization and autovivified accessors and mutators

SYNOPSIS

Top

		package SubClass;
		use base qw(Class::Light);

		sub _init {
			my $self = shift;
			my $data = shift;
			$self->{'data'} = $data;
		}

		package main;

		my $obj = SubClass->new("epiphany");

		# Will print the string epiphany on stdout
		if ($obj->getData eq $obj->get_data) {
			print $obj->get_Data;
		}

		$obj->setData("42");
		print $obj->getData;

DESCRIPTION

Top

Subclasses are not to define a class method named "new", instead they should define the private instance method named "_init" which does object initialization. new will invoke _init from each superclass in the object's class hierarchy including of course the object's class itself. _init should not bless or return $self as this is handled by new.

Installs default accessor and mutator methods for public instance members. Public members are those hash keys that don't start with an underscore.

Accessor and mutator methods can be invoked as:

$obj->getAttribute or $obj->get_attribute or $obj->get_Attribute

All forms of invocation will search for the member named "attribute" in the object and, if found, AUTOLOAD will install a method of the corresponding name in the package that $obj's class belongs to. Note that this imposes the restriction on inheriting classes that if they want automatically defined accessor and mutator methods for their public members, those members' identifiers must start with a lowercase letter. Also note that access to private members will not be given to AUTOLOAD, so for example a method invocation such as $obj->get__attribute will not install and execute an accessor for the private member "_attribute". If a method already exists for one of the three forms shown above then that method is executed. For example, if a user invokes a non-existant $obj->get_foo but $obj->getFoo does exist, then $obj->getFoo is invoked.

METHODS

Top

There are no public methods except for new and those autovivified. All sorts of bells and whistles could have been added such as logging, error storage, etc. However the goal of Class::Light is to provide simple (and useful) object initialization and method autovivification. If you want to add logging or other features simply create a sublcass of Class::Light and add your features.

AUTHOR

Top

Christopher Davaz www.chrisdavaz.com cdavaz@gmail.com

VERSION

Top

Version 0.01003 (Apr 25 2009)

SEE ALSO

Top

perlobj perltoot

COPYRIGHT

Top


Class-Light documentation Contained in the Class-Light distribution.

package Class::Light;
# Copyright (c) 2009 Christopher Davaz. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Documentation at the __END__

use strict;
use warnings;
use vars qw($VERSION);
use Carp;

$VERSION = "0.01003";

sub new {
	my $class = shift;

	croak "Attempted instantiation of abstract class " + __PACKAGE__
		if $class eq __PACKAGE__;

	my $super = $class;
	my @super;

	# Find all super classes and add them to @super in hierarchical order.
	no strict 'refs';
	while ($super ne __PACKAGE__) {
		unshift @super, $super;
		$super = ${$super . "::ISA"}[0];
	}

	my $self = {};
	bless $self, $class;

	for (@super) {
		my $init = $_ . "::_init";
		&$init($self, @_) if exists &$init;
	}
	use strict 'refs';

	return $self;
}

# Subclasses should implement their own _init method.
sub init;

our $AUTOLOAD;
sub AUTOLOAD {
	my ($pkg, $method) = ($AUTOLOAD =~ /(.+)::(.+)/);
	my ($type, $attr)  = ($method   =~ /^(get|set)_?(.*)/);

	# We only handle methods that match the pattern /^(get|set)_?(.*)/
	croak "Unknown method: $AUTOLOAD" unless $type && $attr;

	my $origAttr = $attr;
	$attr = lcfirst $attr;

	# Don't allow calls such as "getattr", see documentation for details.
	if ($method eq $type . $attr && $origAttr eq $attr) {
		croak "Unknown method: $AUTOLOAD";
	}

	# Disallow access to private members
	unless ($type && $attr !~ /^_/ && exists $_[0]->{$attr}) {
		croak "Unknown method: $AUTOLOAD";
	}

	# We want to check if an alternative form of invocation is available
	# and if it is make an alias for that method instead of calling the
	# automatically generated one.
	my (@form) = (
		$pkg . "::" . $type . ucfirst $origAttr,
		$pkg . "::" . $type . "_" . $origAttr,
		$pkg . "::" . $type . "_" . $attr
	);

	no strict 'refs';
	for (@form) {
		if (exists &$_) {
			*{$AUTOLOAD} = \&$_;
			goto &{$AUTOLOAD};
		}
	}

	if ($type =~ /^get/) {
		*{$AUTOLOAD} = sub { return $_[0]->{$attr} };
	}
	elsif ($type =~ /^set/) {
		*{$AUTOLOAD} = sub {
			my $old = $_[0]->{$attr};
			$_[0]->{$attr} = $_[1];
			return $old;
		}
	}

	goto &{$AUTOLOAD};
}

sub DESTROY {}

1;
__END__