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

Last change on this file since 2361 was 2361, checked in by nanardon, 4 years ago

Add templates management pages

File size: 10.2 KB
Line 
1package LATMOS::Accounts::Web::Model::AttrForms;
2
3use strict;
4use warnings;
5use base 'Catalyst::Model';
6use LATMOS::Accounts::Log;
7use HTML::Prototype;
8use utf8;
9
10=head1 NAME
11
12LATMOS::Accounts::Web::Model::AttrForms - Catalyst Model
13
14=head1 DESCRIPTION
15
16Catalyst Model.
17
18=cut
19
20my $forms = {
21    usersys => {
22        name => 'SystÚme',
23        attrs => [ qw(
24            sn givenName
25            description
26            comment
27            managerContact
28            uid uidNumber gidNumber
29            gecos homeDirectory loginShell
30            mail
31            expire
32            endcircuit
33            lastlogin
34            locked
35            sshPublicKey
36            sshPublicKeyFilter
37            delUnknownSshKey
38            createRequestId
39            create
40            createdby
41            date
42            modifiedby
43        ) ],
44    },
45    add => {
46        name => 'Others',
47        attrs => [ qw(
48            sn givenName
49            nationality nativeCountry
50            initials nickname
51            snNative
52            givenNameNative
53            wWWHomePage
54            halReference
55            firstAidTrainingValidity
56        ) ],
57    },
58    user => {
59        name => 'Statut RH',
60        attrs => [ qw(
61            sn givenName
62            nationality nativeCountry
63            description
64            company
65            employer
66            department
67            managerContact
68            manager
69            contratType
70            expire
71            endcircuit
72            create
73            createdby
74            date
75            modifiedby
76        ) ],
77    },
78    useremployment => {
79        name => 'Suivi RH',
80        attrs => [ qw(
81            sn givenName
82            nationality nativeCountry
83            expire
84        ) ]
85    },
86    useraddress => {
87        name => 'Adresse',
88        attrs => [ qw(
89            initials
90            mail
91        ) ],
92    },
93    usermy => {
94        name => 'My',
95        attrs => [ qw(
96            snNative
97            givenNameNative
98            wWWHomePage
99            halReference
100        ) ],
101    },
102    site => {
103        name => 'Site',
104        attrs => [ qw(
105            description
106            siteNick
107            streetAddress
108            postOfficeBox
109            postalCode
110            l
111            st
112            co
113            facsimileTelephoneNumber
114            create
115            date
116        ) ],
117    },
118    address => {
119        name => 'Adresse',
120        attrs => [ qw(
121            isMainAddress
122            contactOnly
123            expire
124            telephoneNumber
125            streetAddress
126            postOfficeBox
127            postalCode
128            l
129            st
130            physicalDeliveryOfficeName
131            site
132            co
133            unexported
134            description
135            facsimileTelephoneNumber
136        ) ],
137    },
138    employment => {
139        name => 'Nouvelle période',
140        attrs => [ qw(
141            firstday
142            lastday
143            endcircuit
144            lengthText
145            description
146            company
147            employer
148            contratType
149            assigned
150            department
151            managerContact
152            requestId
153        ) ],
154    },
155    group => {
156        name => 'SystÚme',
157        attrs => [ qw(
158            gidNumber
159            description label
160            comment
161            managedBy
162            managedAlsoBy
163            autoMemberFilter
164            autoFromSutype
165            autoInclude
166            autoExclude
167            sutype
168            services
169            create
170            createdby
171            date
172            modifiedby
173        ) ],
174    },
175    nethost => {
176        name => 'Ordinateur',
177        attrs => [ qw(
178            name
179            description
180            hostType
181            comment
182            endOfWarranty
183            serialNumber
184            inventoryNumber
185            expire
186            netLocked
187            related
188            encryptKey
189            site
190            physicalDeliveryOfficeName
191            owner
192            user
193            ip
194            macaddr
195            puppetClass
196            noInheritPuppet
197            noDynamic
198            services
199            cname
200            otherName
201            reverse
202            create
203            createdby
204            date
205            modifiedby
206            unexported
207            sshfp
208        ) ],
209    },
210    netzone => {
211        name => 'Zone réseau',
212        attrs => [ qw(
213            name
214            description
215            type
216            net
217            netExclude
218            puppetClass
219            outputD
220            templateD
221            site
222            allow_dyn
223            dynFrom
224            domain
225            ipCount
226            freeIPCount
227            create
228            createdby
229            date
230            modifiedby
231            dnsRevision
232            lastUpdate
233            unexported
234            hostParams
235        ) ],
236    },
237    aliases => {
238        name => 'Alias mail',
239        attrs => [ qw(
240            expire
241            description
242            comment
243            autoMemberFilter
244            autoFromSutype
245            autoInclude
246            autoExclude
247            autoAddEmail
248            create
249            createdby
250            date
251            modifiedby
252            unexported
253            forward
254            finalpoint
255            parents
256        )],
257    },
258    services => {
259        name => 'Services',
260        attrs => [ qw(
261            type
262            description
263            comment
264            start
265            end
266            manager
267            dependOn
268            create
269            createdby
270            date
271            modifiedby
272            unexported
273        )],
274    },
275    templates => {
276        name => 'Templates',
277        attrs => [ qw(
278            objectType
279            data
280            create
281            createdby
282            date
283            modifiedby
284            unexported
285        )],
286    },
287};
288
289sub escape {
290    my ($self, $text) = @_;
291    $text ||= '';
292    for ($text) {
293        s/&/&/g;
294        s/</&lt;/g;
295        s/>/&gt;/g;
296        s/"/&quot;/g;
297    }
298    $text;
299}
300
301sub new {
302    my ($class) = @_;
303    bless({}, $class);
304}
305
306# call either OBJ or type + base
307
308sub ACCEPT_CONTEXT {
309    my ($self, $c, $form, $object, $base) = @_;
310    my $new = {};
311    $new->{c} = $c;
312    $new->{form} = $form;
313    $new->{object} = $object if (ref $object);
314    $new->{base} = $base || (ref $object ? $object->base : $c->model('Accounts')->db);
315    $new->{otype} = ref $object ? $object->type : $object;
316
317
318    if ($form) {
319        foreach (@{ $forms->{$form}->{attrs} }) {
320            $new->{_attr}{$_} = $c->model('AttrFormsA', $_, (ref $object
321                    ? ($object)
322                    : ($base, $new->{otype})))
323                or die "Cannot get attribute $_";
324        }
325    }
326
327    bless($new, __PACKAGE__);
328}
329
330sub base {
331    my ( $self ) = @_;
332    $self->{base}
333}
334
335sub otype {
336    my ($self) = @_;
337    $self->{otype};
338}
339
340sub object {
341    my ($self) = @_;
342    $self->{object};
343}
344
345sub label {
346    my ($self) = @_;
347    $forms->{$self->{form}}->{name} || ''
348}
349
350sub attributes {
351    my ($self, $for) = @_;
352    grep { $_ }
353    grep { $self->base->attribute($self->otype, $_) }
354    @{ $forms->{$self->{form}}->{attrs} };
355}
356
357sub _uri_part {
358    my ($self, $ref) = @_;
359    my $uri_part = {
360        user => 'users',
361        group => 'groups',
362        nethost => 'nethosts',
363        netzone => 'netzones',
364        site => 'sites',
365        aliasess => 'aliases',
366    }->{$ref};
367}
368
369sub attr_label {
370    my ($self, $attr, $label, $hint) = @_;
371
372    if ($label) {
373        return $label;
374    } else {
375        my $oattr = $self->base->attribute($self->otype, $attr)
376            or return $attr;
377        my $label = $oattr->label;
378        return $label;
379    }
380}
381
382sub attr_hint {
383    my ($self, $attr) = @_;
384
385    $self->{_attr}{$attr}->attr_hint;
386}
387
388sub attr_field {
389    my ($self, $attr, $type) = @_;
390
391    $self->{_attr}{$attr}->attr_field($type);
392}
393
394sub field {
395    my ($self, $attr, $type) = @_;
396
397    if (!$self->{_attr}{$attr}) {
398        $self->{_attr}{$attr} = $self->{c}->model('AttrFormsA', $attr, ($self->object
399                ? ($self->object)
400                : ($self->base, $self->otype)))
401            or die "Cannot get attribute $_";
402    }
403
404    $self->{_attr}{$attr};
405}
406
407
408sub write_attributes {
409    my ($self) = @_;
410    my @attrs;
411    foreach (values %{ $self->{_attr} }) {
412        $_->readonly and next;
413        push(@attrs, $_);
414    }
415    @attrs;
416}
417
418sub set_attrs {
419    my ($self, $attrs, $id) = @_;
420    $self->{c}->req->param($self->{form}) || $attrs or return;
421    my %fields;
422    foreach ($attrs ? @{ $attrs } : $self->write_attributes) {
423        my $attr = ref $_ ? $_ : $self->{_attr}{$_};
424        $attr ||= $self->{c}->model('AttrFormsA', $_, (
425                ref $self->object
426                    ? ($self->object)
427                    : ($self->base, $self->{otype})
428                )
429        );
430
431        if ($attr->{multiple}) {
432            $fields{$attr->name} = [ grep { $_ } $self->{c}->req->param($attr->htmlname) ];
433        } else {
434            $fields{$attr->name} = $self->{c}->req->param($attr->htmlname) || undef;
435        }
436    }
437    if ($self->object) {
438        $self->object->set_c_fields(%fields) or do {
439            $self->{c}->stash->{page}{error} =
440                LATMOS::Accounts::Log::lastmessage(LA_ERR);
441            $self->object->base->rollback;
442            return;
443        };
444    } else {
445        $id ||= join('', map {('a'..'z')[rand(26)]}(0..8));
446        $self->base->create_c_object($self->otype, $id, %fields) or do {
447            $self->{c}->stash->{page}{error} =
448                LATMOS::Accounts::Log::lastmessage(LA_ERR);
449            $self->base->rollback;
450            return;
451        };
452    }
453    $self->base->commit;
454    $self->reset_param;
455    return $id || $self->object->id;
456   
457}
458
459sub reset_param {
460    my ($self) = @_;
461    foreach (values %{ $self->{_attr} }) {
462        delete($self->{c}->req->params->{$_->htmlname});
463    }
464}
465
466sub submit {
467    my ($self, $hidden) = @_;
468    return sprintf(
469        '<input type="%s" name="%s" value="Enregistrer">',
470        ($hidden ? 'hidden' : 'submit'),
471        $self->escape($self->{form}),
472    );
473}
474
475
476=head1 AUTHOR
477
478Thauvin Olivier
479
480=head1 LICENSE
481
482This library is free software, you can redistribute it and/or modify
483it under the same terms as Perl itself.
484
485=cut
486
4871;
Note: See TracBrowser for help on using the repository browser.