Oryx::Attribute - Attribute meta-type for Oryx persistent classes

Oryx documentation Contained in the Oryx distribution.

Index

Code Index:

NAME

Top

Oryx::Attribute - Attribute meta-type for Oryx persistent classes

SYNOPSIS

Top

 my $attrib = Oryx::Attribute->new( \%meta, $owner );
 $attrib->name;                 # name used for accessor generation
 $attrib->size;                 # size constraint for the value
 $attrib->type;                 # value type
 $attrib->required;             # NOT NULL

DESCRIPTION

Top

METHODS

Top

new( $meta, $owner )
create

Abstract (see implementing subclasses)

retrieve

Abstract (see implementing subclasses)

update

Abstract (see implementing subclasses)

delete

Abstract (see implementing subclasses)

Abstract (see implementing subclasses)

construct( $self, $obj )

Inflate the attribute value and tie it to the implementing Value class, eg: Oryx::Value::String, Oryx::Value::Complex etc. (see perltie)

name

returns the name meta-attribute for this attribute. This is the same as the accessor and the field in the table in which the value for this attribute is stored.

type

returns the type meta-attribute for this attribute. Defaults to 'String'.

size

returns the size meta-attribute for this attribute. This is the allowed length for the 'String' or size of 'Number' etc. and is used for input checking by the Value type. No default.

required

returns the value of the required meta-attribute. This has the effect of raising an error if an instance of the owning class is constructed without a value for this field defined in the prototype hash reference which is passed to Oryx::Class->create( \%proto ). Equivalent to a NOT NULL constraint.

primitive

returns a list the first argument of which is one of: 'Integer', 'String', 'Boolean', 'Float', 'Text', 'Binary' or 'DateTime' which are mapped to SQL column types by the Oryx::DBI::Util classes. The second argument is an optional size constraint.

type_class

returns the canonical package name of the implementing Oryx::Value meta-type for this attribute.

AUTHOR

Top

Richard Hundt <richard NO SPAM AT protea-systems.com>

THANKS TO

Top

Andrew Sterling Hanenkamp

LICENCE

Top

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

Oryx documentation Contained in the Oryx distribution. 
package Oryx::Attribute;

use base qw(Oryx::MetaClass);


sub new {
    my ($class, $meta, $owner) = @_;
    my $self = bless {
	owner => $owner,
	meta  => $meta,
    }, $class;

    eval 'use '.$self->type_class;
    $self->_croak($@) if $@;

    no strict 'refs';
    *{$owner.'::'.$self->name} = $self->_mk_accessor;

    return $self;

}


sub create    { }
sub retrieve  { }
sub update    { }
sub delete    { }
sub search    { }


sub construct {
    my ($self, $obj) = @_;

    my $attr_name = $self->name;
    $obj->{$attr_name} = $self->inflate($obj->{$attr_name});

    my @args = ($self, $obj);
    tie $obj->{$attr_name}, $self->type_class, @args;

    return $obj;
}


sub name {
    my $self = shift;
    return $self->getMetaAttribute("name");
}


sub type {
    my $self = shift;
    $self->getMetaAttribute("type") || 'String';
}


sub size {
    my $self = shift;
    return $self->getMetaAttribute("size");
}


sub required {
    my $self = shift;
    return $self->getMetaAttribute('required');
}


sub primitive {
    my $self = shift;
    return $self->type_class->primitive;
}


sub type_class {
    my $self = shift;
    return 'Oryx::Value::'.$self->type;
}

sub deflate {
    my $self = shift;
    my $value = shift;
    if (ref $self->meta->{deflate} eq 'CODE') {
        return $self->meta->{deflate}->($value);
    } else {
        return $self->type_class->deflate($value);
    }
}

sub inflate {
    my $self  = shift;
    my $value = shift;
    if (ref $self->meta->{inflate} eq 'CODE') {
        return $self->meta->{inflate}->($value);
    } else {
        return $self->type_class->inflate($value);
    }
}

sub _mk_accessor {
    my $attrib = shift;
    my $attrib_name = $attrib->name;
    return sub {
	my $self = shift;
	$self->{$attrib_name} = shift if @_;
	$self->{$attrib_name};
    };
}

1;