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

Last change on this file since 1490 was 1490, checked in by nanardon, 8 years ago

Add filter based aliases (dynamics)

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