view release on metacpan or  search on metacpan

Wyrd/Datum.pm  view on Meta::CPAN

use 5.006;
use strict;
use warnings;
no warnings qw(uninitialized);

no warnings qw(redefine);

package Apache::Wyrd::Datum;
our $VERSION = '0.98';

use constant TYPE => 0;
use constant VALUE => 1;
use constant PARAMS => 2;

sub new {
	my ($class, $value, $params) = @_;
	my $data = [];
	bless $data, $class;
	$data->_init($value, $params);
	return $data;
}

sub _init {
	my ($self, $value, $params) = @_; 
	$value ||= _default_value();
	$params ||= _default_params();
	$self->_raise_exception("Params must be a hashref") if (ref($params) ne 'HASH');
	my $defaults = $self->_default_params();
	foreach my $i (keys(%$params)) {
		#force lower-case params.  Trust me, it's a good thing.
		$defaults->{lc($i)} = $params->{$i};
	}
	if (ref($defaults->{options}) eq 'HASH') {
		$defaults->{_translate_key} = $defaults->{options};
		foreach my $i (keys(%{$defaults->{options}})) {
			$defaults->{_rev_translate_key}->{$defaults->{options}->{$i}} = $i;
		}
		$defaults->{options} = [values(%{$defaults->{options}})];
	}
	$defaults = $self->_check_params($defaults);
	$self->[Apache::Wyrd::Datum::TYPE] = $self->_type;
	$self->[Apache::Wyrd::Datum::VALUE] = $value;
	$self->[Apache::Wyrd::Datum::PARAMS] = $defaults;
}

sub _type {
	die "The base Apache::Wyrd::Datum is an abstract class.  Please use a defined type instead.";
}

sub _default_value {
	return;
}

sub _default_params {
	return {'strict' => 0};
}

sub _raise_exception {
	my ($value) = @_;
	die ($value . " " . join(':', caller()));
}

sub _check_params {
	#by default, check nothing
	return $_[1];
}

sub _suggest {
	return $_[1];
}

sub _check_value {
	#by default, approve everything unless not-null is specified
	my ($self, $value, $params) = @_;
	return (0, 'Required value missing') if ($params->{'not_null'} and not($value));
	return 1;
}

sub _set {
	my($self, $value) = @_;
	$value = $self->[Apache::Wyrd::Datum::PARAMS]->{_translate_key}->{$value} if ($self->[Apache::Wyrd::Datum::PARAMS]->{translate_key});
	$self->[Apache::Wyrd::Datum::VALUE] = $value;
	return $self->[Apache::Wyrd::Datum::PARAMS]->{_rev_translate_key}->{$self->[Apache::Wyrd::Datum::VALUE]} if ($self->[Apache::Wyrd::Datum::PARAMS]->{translate_key});
	return $value;
}

sub _process_incoming {
	return $_[1];
}

sub _process_outgoing {
	return $_[1];
}

#Public Methods

sub check {
	my ($self, $value) = @_;
	my ($ok, $error) = $self->_check_value($value, $self->[Apache::Wyrd::Datum::PARAMS]);
	return 1 if ($ok);
	return (undef, $error);
}

sub get {
	my ($self) = shift;
	my $value = undef;
	$value = $self->[Apache::Wyrd::Datum::PARAMS]->{_rev_translate_key}->{$self->[Apache::Wyrd::Datum::VALUE]} if ($self->[Apache::Wyrd::Datum::PARAMS]->{translate_key});
	$value = $self->[Apache::Wyrd::Datum::VALUE];
	return $self->_process_outgoing($value);
}

sub set {
	my($self, $value) = @_;
	$value = $self->_process_incoming($value);
	my ($ok, undef) = $self->check($value);
	unless ($ok) {
		return undef if ($self->[Apache::Wyrd::Datum::PARAMS]->{'strict'});
		$value = $self->_suggest($value);
	}
	$self->_set($value);