File Coverage

lib/Oryx/Value.pm

Criterion	Covered	Total	%
statement	6	57	10.5
branch	0	18	0.0
condition			n/a
subroutine	2	18	11.1
pod	11	11	100.0
total	19	104	18.2

package Oryx::Value;

use base qw(Class::Data::Inheritable);

use Module::Pluggable(
    search_path => 'Oryx::Value',
    sub_name    => 'types',
    require     => 1,
);

=head1 NAME

Value - base class for value types for the Oryx object persistence tool

=head1 SYNOPSIS

 # constructor - this is what you should do
 tie $obj->{some_field}, 'Oryx::Value::SomeType', ($meta, $owner);

 # this is if you really must call these methods on the tied object
 # although normally these are called by the tied object on $self
 tied($obj->{some_field})->deflate($value);
 tied($obj->{some_field})->inflate($value);
 tied($obj->{some_field})->check($value);
 tied($obj->{some_field})->check_required($value);
 tied($obj->{some_field})->check_type($value);
 tied($obj->{some_field})->check_size($value);
 tied($obj->{some_field})->meta;
 tied($obj->{some_field})->owner;

=head1 DESCRIPTION

This module is considered abstract and should be sublcassed to create the
actual Value types.

The purpose of these Value types is to validate input and to prepare
field values for storage in the database via the C method and
to prepare the values for consumption after retrieval via the C
method.

The tie constructor is passed the associated L instance which
can be accessed via C, along with the L instance to which
the Attribute - and therefore the value - belongs. The L instance
can be accessed with the C accessor.

=head1 SUBCLASSING

The C related methods: C, C and C, as well as
C should not be overridden when subclassing - they are documented here
for the sake of completeness.

The C, C, C, and C methods are usually overloaded when subclassing.

=head1 METHODS

=over

=item TIESCALAR( $meta, $owner )

takes two arguments: C<$meta> and C<$owner> - C<$meta> is the L
instance with which this value is associated, and C<$owner> is the L
instance (or persistent object).

This method should not be called directly, instead use

 my $attr_name = $attrib->name;
 tie $object->{$attr_name}, 'Oryx::Value::String', $attrib, $object;

=cut

sub TIESCALAR {
    my $class = shift;
    my ($meta, $owner) = @_;
    my $self = bless {
	meta  => $meta,  # Oryx::Attribute instance
	owner => $owner, # Oryx::Class instance
    }, $class;

    $self->STORE($self->owner->{$self->meta->name});
    return $self;
}

=item FETCH

automatically called by Perl when the field to which this Value is tied
is retrieved. You should not normally need to call this directly.

=cut

sub FETCH {
    my $self = shift;
    unless (defined $self->VALUE) {
	my $value = $self->owner->{$self->meta->name};
	$self->VALUE($self->inflate($value));
    }
    return $self->VALUE;
}

=item STORE( $value )

automatically called by Perl when the field to which this Value is tied
is set via assignment. You should not normally need to call this directly.

=cut

sub STORE {
    my ($self, $value) = @_;
    if ($self->check($value)) {
	$self->VALUE($value);
    } else {
	$self->_croak('check failed ['.$value.'] MESSAGE: '.$self->errstr);
    }
}

=item VALUE

mutator to the internal raw value held in this tied object instance

=cut

sub VALUE {
    my $self = shift;
    $self->{VALUE} = shift if @_;
    return $self->{VALUE};
}

=item deflate( $value )

hook to modify the value before it is stored in the db. C<$value> is the
raw value associated with the attribute as it is in the live object. This
is not neccessarily the same as its representation in the database. Take
L for example. Complex serializes its value using
L before it saves it to the database. C does the serialization
in this case. It is passed the value in the live object which could be
a hash ref or array ref (or anything else that could be serialized using
YAML) and returns the serialized YAML string representation of that value.

=cut

sub deflate {
    my ($self, $value) = @_;
    return $value
}

=item inflate( $value )

hook to modify the value as it is loaded from the db. This is the complement
to C in that it takes the value loaded from the database and cooks
it before it is associated with the attribute of the live C object.

In the case of L C<$value> is a YAML string which is
deserialized using YAML and the result returned.

=cut

sub inflate {
    my ($self, $value) = @_;
    return $value;
}

=item check( $value )

hook for checking the value before it is set. You should consider carefully
if you need to override this method as this one calls the other C
methods and sets C<< $self->errstr >> if any of them fail.

=cut

sub check {
    my ($self, $value) = @_;
    unless ($self->check_required($value)) {
	$self->errstr('value required');
	return 0;
    }
    if (defined $value) {
	unless ($self->check_type($value)) {
	    $self->errstr('type mismatch');
	    return 0;
	}
	unless ($self->check_size($value)) {
	    $self->errstr('size mismatch');
	    return 0;
	}
    }
    return 1;
}

=item check_type( $value )

hook for doing type checking on the passed C<$value>. Should return
1 if successful and 0 if not.

=cut

sub check_type {
    my ($self, $value) = @_;
    return 1;
}

=item check_size( $value )

hook for doing size checking on the passed C<$value>. Should return
1 if successful and 0 if not.

=cut

sub check_size {
    my ($self, $value) = @_;
    return 1;
}

=item check_required( $value )

hook for checking if the passed C<$value> is required. Should return
1 if the value is required and defined and 0 if required and not defined.
If the value is not required, return 1.

=cut

sub check_required {
    my ($self, $value) = @_;
    if ($self->meta->required) {
	return defined $value;
    } else {
	return 1;
    }
}

=item errstr

returns the error string if input checks failed.

=cut

sub errstr {
    my $self = shift;
    $self->{errstr} = shift if @_;
    return $self->{errstr};
}

=item meta

simple accessor to meta data for this value type, in this case,
a reference to the L with which this Value instance
is associated.

=cut

sub meta  { $_[0]->{meta}  }

=item owner

returns the L which owns the L instance
with which this Value instance is associated.

=cut

sub owner { $_[0]->{owner} }

=item primitive

Returns a string representing the underlying primitive type. This is used by the storage driver to determine how to pick the data type to use to store the value. The possible values include:

=over

=item Integer

=item String

=item Text

=item Binary

=item Float

=item Boolean

=item DateTime

=back

There is an additional internal type called "Oid", but it should not be used.

=cut

sub primitive { $_[0]->_croak('abstract') }

sub _croak {
    my ($self, $msg) = @_;
    $self->{owner}->_croak("<".$self->{meta}->name."> $msg");
}

sub _carp {
    my ($self, $msg) = @_;
    $self->{owner}->_carp("<".$self->{meta}->name."> $msg");
}

1;

=back

=head1 AUTHOR

Copyright (C) 2005 Richard Hundt

=head1 LICENCE

This library is free software and may be used under the same terms as Perl itself.

=cut