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

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',
    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',
    st => 'Département',
    streetAddress => 'Rue',
};

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
            st
        ) ],
    },
    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);
}

sub ACCEPT_CONTEXT {
    my ($self, $c, $form, $object) = @_;
    $form or return $self;
    $forms->{$form} or return;
    $self->{c} = $c;
    $self->{form} = $form;
    $self->{object} = $object or return;
    $self
}

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

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

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

sub attr_field {
    my ($self, $attr) = @_;
    return sprintf(
        '<input type="text" name="%s" value="%s">',
        $attr,
        $self->escape(
            $self->{c}->req->param($attr) ||
            $self->{object}->get_c_field($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;