package LATMOS::Accounts::Bases::Sql::Accreq; use 5.010000; use strict; use warnings; use LATMOS::Accounts::Utils; use LATMOS::Accounts::Log; use base qw(LATMOS::Accounts::Bases::Sql::objects); use YAML; our $VERSION = (q$Rev$ =~ /^Rev: (\d+) /)[0]; =head1 NAME LATMOS::Accounts::Bases::Sql::Accreq - Accreq object in LATMOS::Accounts system =head1 DESCRIPTION The C object is a form handle information about form allowing user to request admin for change =head1 FUNCTIONS =cut sub _yaml_attr { qw(description notifyMail) } sub _object_table { 'accreq' } sub _key_field { 'name' } sub _has_extended_attributes { 1 } sub _get_attr_schema { my ($class, $base) = @_; $class->SUPER::_get_attr_schema($base, { unexported => { inline => 1, formtype => 'CHECKBOX',}, name => { inline => 1, ro => 1, }, create => { inline => 1, ro => 1, }, date => { inline => 1, ro => 1, }, attributes => { ro => 1, multiple => 1, get => sub { my ($self) = @_; my $ref = _parse_form($self, $self->object->get_attributes('form')); my @attributes = (); my @attrs = @{ $ref->{attrs} }; while (my $attr = shift(@attrs)) { my $attrname = ref $attr ? $attr->{name} : $attr; push(@attributes, $attrname); } \@attributes }, }, oType => { can_values => sub { return $base->list_supported_objects }, mandatory => 1, }, requireObject => { formtype => 'CHECKBOX', }, hidden => { formtype => 'CHECKBOX', }, form => { get => sub { my ($self) = @_; if (my $obj = $self->object) { my $res = $obj->parse_form; foreach (_yaml_attr()) { $res->{$_} = $obj->get_field($_); } return YAML::freeze($res); } else { return; } }, set => sub { my ($self, $yaml) = @_; my $res = _parse_form($self, $yaml) or return 0; my %attrs; foreach (_yaml_attr()) { $attrs{$_} = $res->{$_} if (exists($res->{$_})); } $self->object->set_fields(%attrs, form => $yaml); }, }, } ) } =head2 parse_form Load C
attribute and return reference to data read from YAML data =cut sub parse_form { my ($self) = @_; if (my $text = $self->get_field('form')) { $self->_parse_form($text); } else { return { attrs => [] }; } } sub _parse_form { my ($self, $yaml) = @_; my $ref = YAML::thaw($yaml) or return 0; my @attributes = (); my @attrs = @{ $ref->{attrs} }; while (my $attr = shift(@attrs)) { my $attrname = ref $attr ? $attr->{name} : $attr; if (!$attrname) { $self->base->log('LA_ERR', 'No attribute name supplied'); return; } } $ref } =head2 attr_info($attr) Return information for attribute C<$attr> from form. =cut sub attr_info { my ($self, $wanted_attr) = @_; my $ref = $self->parse_form; my @attrs = @{ $ref->{attrs} }; while (my $attr = shift(@attrs)) { my $attrname = ref $attr ? $attr->{name} : $attr; if ($wanted_attr eq $attrname) { if (ref $attr) { return $attr; } else { return; } } } return; } 1; __END__ =head1 SEE ALSO L =head1 AUTHOR Olivier Thauvin, Eolivier.thauvin@latmos.ipsl.frE =head1 COPYRIGHT AND LICENSE Copyright (C) 2008, 2009 CNRS SA/CETP/LATMOS This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.0 or, at your option, any later version of Perl 5 you may have available. =cut