package Class::Frame;

use 5.006;
use strict;
no strict 'refs';
no strict 'subs';
use warnings;

our $VERSION = '1.0';
our ( @ISA, @EXPORT );

use Exporter;

@ISA = qw( Exporter );
@EXPORT = qw( DEFINE_FIELDS );

sub DEFINE_FIELDS {
	my $pkg = (caller())[0];
	my %args = @_;

	*{$pkg.'::_FIELDS'} = sub {return {%args}};

	# Inject constructor
	my $constructor =<<'CONSTRUCTOR';
	sub {
		my $pkg = shift;
		my %args = @_;

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

		# Set-up class fields with default values
		my $fields = $self->_FIELDS;
		$self->_setter(name => $_, val => $fields->{$_})
			for (keys %$fields);

		# Update class fields with new values
		$self->_setter(name => $_, val => $args{$_}) for (keys %args);

		return $self;
	}
CONSTRUCTOR

	*{$pkg.'::new'} = eval($constructor);

	# Inject accessors/mutators
	foreach my $arg (keys %args) {

		*{$pkg.'::set_'.$arg} =
			eval('sub { my $self = shift; $self->_setter(name => "'.$arg.'", val => shift);}');

		*{$pkg.'::get_'.$arg} =
			eval('sub { my $self = shift; return $self->_getter(name => "'.$arg.'");}');

		*{$pkg.'::get_'.$arg.'_default'} =
			eval('sub { my $self = shift; return $self->_FIELDS->{'.$arg.'};}');

		*{$pkg.'::'.$arg} = *{$pkg.'::get_'.$arg};
	}
}

sub _setter {
	my $self = shift;
	my %args = @_;
	my $name = $args{name} or die "name argument is missing";
	$self->{$name} = $args{val};
}

sub _getter {
	my $self = shift;
	my %args = @_;
	my $name = $args{name} or die "name argument is missing";
	return $self->{$name};
}

1;

__END__


=head1 NAME

Class::Frame - Class template with default constructor and accessors autogenerated

=head1 SYNOPSIS

	In class Sith:
	--------------

	package Sith;

	use strict;

	use base qw( Class::Frame );
	use Class::Frame;

	DEFINE_FIELDS(
	    name => 'Palpatine',
	    occupation => 'Sith Lord',
	    weapon => [ 'The Force', 'Lightsaber' ]
	);

	1;


	In a galaxy far far away:
	-------------------------

	use Sith;

	# Difficult to see the Dark Side is . . .
	my $emperor = Sith->new(
		name => 'Palpatine',
		occupation => 'Senator'
	);

	# Get name attribute
	print $emperor->name();

	# Another way of getting name
	print $emperor->get_name();

	# Revealed itself the Dark Side has . . .
	$emperor->set_name('Darth Sidios'); 
	$emperor->set_points(120);
	$emperor->set_occupation('Sith Lord');

	# Get default value for occupation field in Sith class
	my $occupation = $emperor->get_occupation_default();

	. . .


	Subclassing Sith:
	-----------------

	package Sith::Lord;

	use base qw( Sith );

	sub new {
		my $pkg = shift;
		my @args = @_;
		
		my $self = $pkg->SUPER::new(@args);
		bless $self, $pkg;
	}

	. . .


=head1 ABSTRACT

This is 'yet another accessor creation helper' module but its
different ( of course :-)). For the class using Class::Frame as a base
class it automatically creates default constructor wich accepts field
values as input parameters and if some or all of the parameters were
not set - uses default values specified during class structure declaration
( please see below for more details ). Also it creates three methods for each field:
accessor ('get'), mutator ('set') and 'shortcut' method ( $obj-><field> is
the same as $obj->get_<field> ). Supports further subclassing of Class::Frame
derived class.

=head1 DESCRIPTION

=over

=item B<Learn Class::Frame in 5 seconds!>

To start using Class::Frame as base class you will need to make 8,
err, 2 easy steps :-)
	
1) Create your class

	package Jedi;

	use strict;
	use base qw( Class::Frame );
	use Class::Frame; # Exports DEFINE_FIELDS helper function

	# Accepts a hash of field names with default values
	# that can be scalars or references to anything
	# ( array, hash, object ). If field doesn't have default
	# value - set it to undef

	DEFINE_FIELDS(
		name => undef,
		points => 140,
		weapon => Jedi::Weapon::Lightsaber
	);

2) In your code there you are going to use My::Class:

	use Jedi;

	. . .

	# Create instance of My::Class and override default name value
	my $kit_fisto = Jedi->new(name => 'Kit Fisto');
	$kit_fisto->weapon->activate();

	. . .
	

=item B<Class Declaration>

DEFINE_FIELDS( <field_name> => <default_value>, ... )

	This method creates accessors and constructor for the class it has been
	called from. Input - hash of fields and their default_values. If default
	value is undef please specify so EXPLICITLY

=item B<Generated constructor>

new( [<field_name> => <value> [ , ... ]] )

	Creates new instance of class derived from Class::Frame. Accepts a hash
	containing field names as keys and field initializing values as values.
	If field has init value then its default value will be overriden,
	otherwise - default value will be used (if provided in class declaration).

=item B<Accessors>

<field_name>

	Gets field value

	Example:

	my $jedi_name = $jedi->name;

get_<field_name>

	Another way to get field value

	Examle:

	my $jedi_name = $jedi->get_name;


get_<field_name>_default

	Gets field default value from class declaration

	Examle:

		my $default_weapon = $jedi->get_weapon_default;

set_<field_name>( <value> )

	Sets field to value passed even if it is 'undef' ( which
	sometimes is handy )

	Example:

		$jedi->set_weapon(Jedi::Weapon::DualBladeLightSaber->new());
		$jedi->set_dark_side_points(undef);

=back

=head1 BUGS

Please report them

=head1 SEE ALSO

L<Class::Accessor>

=head1 AUTHOR

Denys Vorobyov, E<lt>denysv@primus.caE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2005 by Denys Vorobyov

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut