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

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

use strict;
use warnings;
use base 'Catalyst::Model';
use LATMOS::Accounts::Log;
use HTML::Prototype;

=head1 NAME

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

=head1 DESCRIPTION

Catalyst Model.

=cut

my $forms = {
    usersys => {
        name => 'SystÚme',
        attrs => [ qw(
            sn givenName description
            comment
            managerContact
            uid uidNumber gidNumber gecos homeDirectory loginShell
            mail initials nickname
            expire
            endcircuit
            locked
            sshPublicKey
            snNative
            givenNameNative
            wWWHomePage
            halReference
            create
            createdby
            date
            modifiedby
        ) ],
    },
    user => {
        name => 'Statut RH',
        attrs => [ qw(
            sn givenName
            description
            company
            employer
            department
            managerContact
            manager
            contratType
            expire
            endcircuit
            create
            createdby
            date
            modifiedby
        ) ],
    },
    useremployment => {
        name => 'Suivi RH',
        attrs => [ qw(
            sn givenName
            expire
        ) ]
    },
    useraddress => {
        name => 'Adresse',
        attrs => [ qw(
            initials
            mail
        ) ],
    },
    usermy => {
        name => 'My',
        attrs => [ qw(
            snNative
            givenNameNative
            wWWHomePage
            halReference
        ) ],
    },
    site => {
        name => 'Site',
        attrs => [ qw(
            description
            siteNick
            streetAddress
            postOfficeBox
            postalCode
            l
            st
            co
            facsimileTelephoneNumber
            create
            date
        ) ],
    },
    address => {
        name => 'Adresse',
        attrs => [ qw(
            isMainAddress
            expire
            telephoneNumber
            streetAddress
            postOfficeBox
            postalCode
            l
            st
            physicalDeliveryOfficeName
            site
            co
            unexported
            description
            facsimileTelephoneNumber
        ) ],
    },
    employment => {
        name => 'Nouvelle période',
        attrs => [ qw(
            firstday
            lastday
            endcircuit
            lengthText
            description
            company
            employer
            contratType
            department
            managerContact
        ) ],
    },
    group => {
        name => 'SystÚme',
        attrs => [ qw(
            gidNumber
            description label
            comment
            managedBy
            managedAlsoBy
            autoMemberFilter
            autoFromSutype
            sutype
            services
            create
            createdby
            date
            modifiedby
        ) ],
    },
    nethost => {
        name => 'Ordinateur',
        attrs => [ qw(
            name
            description
            comment
            expire
            related
            serialNumber
            encryptKey
            owner
            user
            ip
            macaddr
            puppetClass
            noInheritPuppet
            noDynamic
            services
            cname
            otherName
            reverse
            create
            createdby
            date
            modifiedby
            unexported
            sshfp
        ) ],
    },
    netzone => {
        name => 'Zone réseau',
        attrs => [ qw(
            name
            description
            type
            net
            netExclude
            puppetClass
            outputD
            templateD
            site
            allow_dyn
            dynFrom
            domain
            ipCount
            freeIPCount
            create
            createdby
            date
            modifiedby
            dnsRevision
            lastUpdate
            unexported
        ) ],
    },
    aliases => {
        name => 'Alias mail',
        attrs => [ qw(
            expire
            description
            comment
            autoMemberFilter
            autoFromSutype
            autoExclude
            create
            createdby
            date
            modifiedby
            unexported
            forward
            finalpoint
            parents
        )],
    },
    services => {
        name => 'Services',
        attrs => [ qw(
            type
            description
            comment
            start
            end
            manager
            dependOn
            create
            createdby
            date
            modifiedby
            unexported
        )],
    },
};

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 || (ref $object ? $object->base : undef) or return $self;
    $new->{otype} = ref $object ? $object->type : $object;


    if ($form) {
        foreach (@{ $forms->{$form}->{attrs} }) {
            $new->{_attr}{$_} = $c->model('AttrFormsA', $_, (ref $object
                    ? ($object)
                    : ($base, $new->{otype})))
                or die "Cannot get attribute $_";
        }
    }

    bless($new, __PACKAGE__);
}

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

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

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

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

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

sub _uri_part {
    my ($self, $ref) = @_;
    my $uri_part = {
        user => 'users',
        group => 'groups',
        nethost => 'nethosts',
        netzone => 'netzones',
        site => 'sites',
        aliasess => 'aliases',
    }->{$ref};
}

sub attr_label {
    my ($self, $attr, $label, $hint) = @_;

    if ($label) {
        return $label;
    } else {
        my $oattr = $self->base->attribute($self->otype, $attr)
            or return $attr;
        my $label = $oattr->label;
        utf8::encode($label);
        return $label;
    }
}

sub attr_hint {
    my ($self, $attr) = @_;

    $self->{_attr}{$attr}->attr_hint;
}

sub attr_field {
    my ($self, $attr, $type) = @_;

    $self->{_attr}{$attr}->attr_field($type);
}

sub field {
    my ($self, $attr, $type) = @_;

    if (!$self->{_attr}{$attr}) {
        $self->{_attr}{$attr} = $self->{c}->model('AttrFormsA', $attr, ($self->object
                ? ($self->object)
                : ($self->base, $self->otype)))
            or die "Cannot get attribute $_";
    }

    $self->{_attr}{$attr};
}


sub write_attributes {
    my ($self) = @_;
    my @attrs;
    foreach (values %{ $self->{_attr} }) {
        $_->readonly and next;
        push(@attrs, $_);
    }
    @attrs;
}

sub set_attrs {
    my ($self, $attrs, $id) = @_;
    $self->{c}->req->param($self->{form}) || $attrs or return;
    my %fields;
    foreach ($attrs ? @{ $attrs } : $self->write_attributes) {
        my $attr = ref $_ ? $_ : $self->{_attr}{$_};
        $attr ||= $self->{c}->model('AttrFormsA', $_, (
                ref $self->object
                    ? ($self->object)
                    : ($self->base, $self->{otype})
                )
        );

        if ($attr->{multiple}) {
            $fields{$attr->name} = [ grep { $_ } $self->{c}->req->param($attr->htmlname) ];
        } else {
            $fields{$attr->name} = $self->{c}->req->param($attr->htmlname) || undef;
        }
    }
    if ($self->object) {
        $self->object->set_c_fields(%fields) or do {
            $self->{c}->stash->{page}{error} =
                LATMOS::Accounts::Log::lastmessage(LA_ERR);
            $self->object->base->rollback;
            return;
        };
    } else {
        $id ||= join('', map {('a'..'z')[rand(26)]}(0..8));
        $self->base->create_c_object($self->otype, $id, %fields) or do {
            $self->{c}->stash->{page}{error} =
                LATMOS::Accounts::Log::lastmessage(LA_ERR);
            $self->base->rollback;
            return;
        };
    }
    $self->base->commit;
    $self->reset_param;
    return $id || $self->object->id;
    
}

sub reset_param {
    my ($self) = @_;
    foreach (values %{ $self->{_attr} }) {
        delete($self->{c}->req->params->{$_->htmlname});
    }
}

sub submit {
    my ($self, $hidden) = @_;
    return sprintf(
        '<input type="%s" name="%s" value="Enregistrer">',
        ($hidden ? 'hidden' : 'submit'),
        $self->escape($self->{form}),
    );
}


=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;