source: LATMOS-Accounts-Web/lib/LATMOS/Accounts/Web/Model/AttrForms.pm @ 144

package LATMOS::Accounts::Web::Model::AttrForms;

use strict;
use warnings;
use base 'Catalyst::Model';

=head1 NAME

LATMOS::Accounts::Web::Model::AttrForms - Catalyst Model

=head1 DESCRIPTION

Catalyst Model.

=cut

my $attrs = {
    uid => [ 'Login' ],
    uidNumber => [ 'UID' ],
    gidNumber => [ 'GID', 'select:group:gidNumber' ],
    sn => [ 'Nom' ],
    givenName => [ 'Prénom' ],
    homeDirectory => [ 'Home' ],
    loginShell => [ 'Shell' ],
    physicalDeliveryOfficeName => [ 'Bureau' ],
    telephoneNumber => [ 'Téléphone' ],
    otherTelephone => [ 'Téléphone (autre)' ],
    company => [ 'Société' ],
    l => [ 'Ville' ],
    postalCode => [ 'Code postal' ],
    postOfficeBox => [ 'BP' ],
    department => [ 'Département' ],
    streetAddress => [ 'Rue', 'textarea' ],
    st => [ 'Etat' ],
};

my $forms = {
    user => {
        name => 'SystÚme',
        acl => 'admin',
        attrs => [ qw(
            sn givenName description
            uid uidNumber gidNumber gecos homeDirectory loginShell
            mail
        ) ],
    },
    useraddress => {
        name => 'Adresse',
        attrs => [ qw(
            initials
            telephoneNumber
            otherTelephone
            mail
            streetAddress
            postOfficeBox
            postalCode
            l
            physicalDeliveryOfficeName
        ) ],
    },
    userstatus => {
        name => 'Status',
        attrs => [ qw(
            company
            department
        ) ],
    },
    site => {
        name => 'Site',
        attrs => [ qw(
            streetAddress
            postOfficeBox
            postalCode
            l
        ) ],
    },
    group => {
        name => 'SystÚme',
        acl => 'admin',
        attrs => [ qw(
            gidNumber description
        ) ],
    },
};

sub escape {
    my ($self, $text) = @_;
    $text ||= '';
    for ($text) {
        s/&/&/g;
        s/</&lt;/g;
        s/>/&gt;/g;
        s/"/&quot;/g;
    }
    $text;
}

sub new {
    my ($class) = @_;
    bless({}, $class);
}

# call either OBJ or type + base

sub ACCEPT_CONTEXT {
    my ($self, $c, $form, $object, $base) = @_;
    my $new = {};
    $new->{c} = $c;
    $new->{form} = $form;
    $new->{object} = $object if (ref $object);
    $new->{base} = $base || ($object ? $object->base : undef) or return $self;
    $new->{otype} = ref $object ? $object->type : $object;
    bless($new, 'LATMOS::Accounts::Web::Model::AttrForms');
}

sub base {
    my ( $self ) = @_;
    $self->{base}
}

sub otype {
    my ($self) = @_;
    $self->{otype};
}

sub label {
    my ($self) = @_;
    $forms->{$self->{form}}->{name} || ''
}

sub attributes {
    my ($self) = @_;
    grep { $self->base->get_field_name($self->otype, $_, 'a') }
    @{ $forms->{$self->{form}}->{attrs} };
}

sub attr_label {
    my ($self, $attr) = @_;
    return $self->escape($attrs->{$attr}[0] || $attr);
}

sub attr_raw_value {
    my ($self, $attr) = @_;
    return $self->{c}->req->param($attr) ||
        ($self->{object} ? $self->{object}->get_c_field($attr) : '')
}

sub attr_field {
    my ($self, $attr, $type) = @_;
    $type ||= $self->base->get_field_name($self->otype, $attr, 'w')
        ? $attrs->{$attr}[1] || ''
        : 'label';
    # exception: gidNumber is used also in group, but we don't want
    # group list here, really the number !
    $type = '' if (($self->{form} || '') =~ /^group/);
    for ($type) {
        /^textarea$/ and return sprintf(
            '<textarea name="%s">%s</textarea>',
            $self->escape($attr),
            $self->escape($self->attr_raw_value($attr)),
        );
        /^label$/ and return $self->escape(
            $self->attr_raw_value($attr)
        );
        /^select:([^:]+):(.*)$/ and do {
            my $otype = $1;
            my $keyfield = $2;
            my $select = sprintf('<select name="%s">',
                $self->escape($attr)) . "\n";
            my $value = $self->attr_raw_value($attr);
            foreach my $id ($self->{object}->base->list_objects($otype)) {
                my $obj = $self->{object}->base->get_object($otype, $id) or next;
                my $val = $keyfield ? $obj->get_c_field($keyfield) : $id;
                $select .= sprintf(
                    '    <option value="%s"%s>%s</options>',
                    $self->escape($val),
                    $value eq $val ? ' "selected"' : '',
                    $self->escape($id),
                );
                $select .= "\n";
            }
            $select .= "</select>\n";
            return $select;
        };
    }
    return sprintf(
        '<input type="text" name="%s" value="%s">',
        $attr,
        $self->escape($self->attr_raw_value($attr))
    );
}

sub set_attrs {
    my ($self) = @_;
    $self->{object}->set_c_fields(
        map {
            $_ => $self->{c}->req->param($_)
        } grep { 
            exists $self->{c}->req->params->{$_}
        } $self->attributes
    );
    $self->{object}->base->commit;
}

=head1 AUTHOR

Thauvin Olivier

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;