#!/usr/bin/perl
package Util::NamedArray;
use strict;
use warnings;
use base qw(Exporter);
our @EXPORT = qw(named_array_create);

sub make_meth_name { sprintf("%s::%s", $_[0], $_[1]) }

sub make_glob {
	my ($classname,$methname,$fn) = @_;
	no strict "refs";
	*{make_meth_name($classname,$methname)} = $fn;
}
sub named_array_create {
	my ($classname, @fields) = @_;
	make_glob($classname, "new",  sub {
		my (undef, %attrs) = @_;
		my $self = [];
		$$self[$_] = undef foreach (0..$#fields);
		bless($self, $classname);
		foreach (keys %attrs) {
			if(!$self->can($_)) {
				warn "$classname does not have any attribute $_";
				return;
			}
			$self->can($_)->($self, $attrs{$_});
		}
		return $self;
	});

	for my $i (0..$#fields) {
		make_glob($classname, $fields[$i], sub {
			my $self = shift;
			my $value;
			if (@_) {
				$value = shift;
				$$self[$i] = $value
			} else {
				$value = $$self[$i];
			}
			return $value;
		});
	}
	return $classname;
}

if(!caller) {
	Util::NamedArray->import();
	use Data::Dumper;
	my $newcls = named_array_create("Nametest", qw(foo bar baz));
	my $test = Nametest->new(foo => "This is foo!");
	$test->baz("This is baz!");
	
	print "test->foo is " . $test->foo() . "\n";
	print "test->baz is " . $test->baz() . "\n";
	print Dumper($test);
}
1;
__END__

=head1 DESCRIPTION

The NamedArray class allows you to use accessor-style semantics with little fuss.
This is similar to Python's collections.namedtuple

=head1 SYNOPSIS

use Util::NamedArray;

Util::NamedArray::create("Point", qw(x y));

my $point = Point->new();

$point->x(5);

$point->y(10);

#or

my $point = Point->new(x => 5, y => 10);

printf("My point is %d x %d\n", $point->x, $point->y);

=head1 FUNCTIONS

This package exports a single method

=over

=item named_array_create($classname, @list_of_attributes)

creates a class named $classname, with a getter/setter for each of the @list_of_attributes