Class::InheritDefaul

package Class::InheritDefaults;
use strict;
use base qw(Class::Data::Inheritable);

#    Class::InheritDefaults  ---  a universal base class with inhertiable
#                                 default values and automatic generation
#                                 of accessor methods
#    Copyright (C) 2006  Stefan Schwarzkopf
# 
# This program is free software; you can redistribute it and/or modify 
# it under the terms of the GNU General Public License as published by 
# the Free Software Foundation; either version 2 of the License, or (at 
# your option) any later version.
# 
# This program is distributed in the hope that it will be useful, but 
# WITHOUT ANY WARRANTY; without even the implied warranty of 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 
# General Public License for more details.
# 
# You should have received a copy of the GNU General Public License 
# along with this program; if not, write to the Free Software 
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110, USA

sub new {
	my $invocant = shift;
	my $class = ref($invocant) || $invocant;
	my $self = {};
	bless $self, $class;
	my %defaults = %{$class->defaults};
	$self->_init(%defaults, @_);	
	return $self;
}

sub init (@) {
	shift;
	my ($class, undef, undef) = caller;
	my %newdefaults = @_;
	my $defref = $class->defaults || {};
	my %olddefaults = %{$defref};

	while (my ($key, $value) = each %newdefaults) {
		if (ref($olddefaults{$key}) eq 'HASH') {
			my %newkey = %{$olddefaults{$key}};
			while (my ($skey, $svalue) = each %{$value}) {
				$newkey{$skey} = $svalue;
			}
			$olddefaults{$key} = \%newkey;
		} else {
			$olddefaults{$key} = $value;
		}
	}
 	$class->defaults(\%olddefaults);

	for my $field (keys %newdefaults) {
		my $slot = $class . "::$field";
		no strict "refs";
		*$slot = sub {
			my $self = shift;
			$self->{$slot} = shift if @_;
			return $self->{$slot};
		};
	}
}

sub _init {
	my $self = shift;
	my %args = @_;

	$self->$_($args{$_}) for keys %args;
}

Class::InheritDefaults->mk_classdata('defaults');
Class::InheritDefaults->init();

1;