source: LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Attributes.pm @ 959

package LATMOS::Accounts::Bases::Attributes;

# $Id$

use strict;
use warnings;
use LATMOS::Accounts::Log;

=head1 NAME

    LATMOS::Accounts::Bases::Attributes - Object to handle attribute schema

=head1 FUNCTIONS

=head2 new($attributes, $base_or_object, $maybe_otype)

=cut

sub new {
    my ($class, $attributes, $base_or_object, $maybe_otype) = @_;
    
    my ($object, $base, $otype) =
    $base_or_object->isa('LATMOS::Accounts::Bases::Objects')
        ? ($base_or_object, $base_or_object->base, $base_or_object->type)
        : (undef, $base_or_object, $maybe_otype);

    if (ref $attributes) {
        $attributes->{_base} = $base;
        $attributes->{_object} = $object;
        $attributes->{_name} = $attributes->{name};
        $attributes->{_otype} = $otype;
        return bless($attributes, $class);
    } else {
        my $attr_info = $base->get_attr_schema($otype, $attributes) or return;

        $attr_info->{_base} = $base;
        $attr_info->{_object} = $object;
        $attr_info->{_name} = $attributes;
        $attr_info->{_otype} = $otype;

        return bless($attr_info, $class);
    }
}

sub base  { $_[0]->{_base}  }
sub name  { $_[0]->{_name}  }
sub otype { $_[0]->{_otype} }
sub mandatory { $_[0]->{mandatory} || 0 }
sub object { $_[0]->{_object} }

=head2 reference

A object type this attribute refer to

=cut

sub reference {
    my ($self) = @_;
    if ($self->{reference} &&
        $self->base->is_supported_object($self->{reference})) {
        return $self->{reference};
    } else {
        return;
    }
}

=head2

Return internal name of attributes

=cut

sub iname { $_[0]->{iname} || $_[0]->name }

sub label { $_[0]->{label} || $_[0]->{_name} }

sub has_values_list {
    my ($self) = @_;
    if ($self->base->obj_attr_allowed_values(
        $self->otype,
        $self->name) ||
        $self->{can_values} ||
        $self->reference) {
        return 1;
    } else {
        return 0;
    }
}

sub can_values {
    my ($self) = @_;
    if (my @values = $self->base->obj_attr_allowed_values(
            $self->otype,
            $self->name)) {
        return @values;
    } elsif ($self->{can_values}) {
        if (ref $self->{can_values} eq 'ARRAY') {
            return @{$self->{can_values}};
        } elsif (ref $self->{can_values} eq 'CODE') {
            $self->{can_values}->($self, $self->object);
        } else {
            return;
        }
    } elsif (my $ref = $self->reference) {
        return $self->base->list_objects($ref);
    } else { return }
}

sub display {
    my ($self, $value) = @_;
    if ($self->{display}) {
        return $self->{display}->($self, $value);
    } else {
        return $value;
    }
}

sub input {
    my ($self, $value) = @_;
    if ($self->{input}) {
        return $self->{input}->($value);
    } else {
        return $value;
    }
}

sub ro {
    my ($self) = @_;
    if (ref $self->{ro} eq 'CODE') {
        return $self->{ro}->($self->object) || 0;
    } else {
        return $_[0]->{ro} || 0 
    }
}

sub readable {
    my ($self) = @_;
    if (ref $self->{readable} eq 'CODE') {
        return $self->{readable}->($self->object) || 0;
    } else {
        return defined($_[0]->{readable}) ? $_[0]->{readable} : 1;
    }
}

sub readonly { 
    my ($self) = @_;
    return 1 if ($self->ro);
    
    return ! $self->check_acl('w');
}

sub check_acl {
    my ($self, $mode) = @_;

    return 1 if ($self->{_noacl});

    return $self->base->check_acl($self->object
        ? ($self->object, $self->name, $mode)
        : ($self->otype, '@CREATE', $mode));
}

=head2 form_type

Return the way the fields must be show in GUI.
For each type option maybe given by from_option

=head3 LABEL

=over 4

=item length

The length to use to show the attribute

=back

=head3 TEXT

=head3 TEXTAREA

=head3 DATE

=head3 LIST

=head3 CHECKBOX

=over 4

=item rawvalue

The real value of the attribute must be show

=back

=cut

sub real_form_type { $_[0]->{formtype} || 'TEXT' }

sub form_type {
    $_[0]->readonly ? 'LABEL' :
    $_[0]->{formtype} ? $_[0]->{formtype} :
    $_[0]->has_values_list ? 'LIST' :
    $_[0]->real_form_type
}

sub form_option {
    my ($self, $option) = @_;
    return $self->{formopts}{$option}
}

sub uniq { $_[0]->{uniq} || 0 }

sub multiple { $_[0]->{multiple} || 0 }

sub hidden { $_[0]->{hide} || 0 }

sub delayed { $_[0]->{delayed} || 0 }

=head2 get($attr)

Return the value for this attribute

=cut

sub get {
    my ($self) = @_;

    if (ref $self->{get} eq 'CODE') {
        return $self->{get}->($self);
    } else {
        return $self->object->get_field($self->iname);
    }
}

sub set {
    my ($self, $values) = @_;

    if (ref $self->{set} eq 'CODE') {
        return $self->{set}->($self,
            ref $values
            ? [ map { $self->input($_) } @$values ]
            : $values ? $self->input($values) : undef);
    } else {
        return $self->object->set_fields(
            $self->iname,
            ref $values
                ? [ map { $self->input($_) } @$values ]
                : $values ? $self->input($values) : undef);
    }
}

sub default_value {
    my ($self) = @_;
    return grep { $_ } (ref $self->{default}
        ? @{ $self->{default} }
        : $self->{default});
}

1;