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 uid uidNumber gidNumber gecos homeDirectory loginShell mail initials nickname expire endcircuit locked snNative givenNameNative wWWHomePage halReference services create createdby date modifiedby ) ], }, user => { name => 'Statut RH', attrs => [ qw( sn givenName description company department managerContact manager contratType expire endcircuit create createdby date modifiedby ) ], }, useremployment => { name => 'Suivi RH', attrs => [ qw( sn givenName endEmployment expire endLastEmployment manager ) ] }, 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 telephoneNumber streetAddress postOfficeBox postalCode l st physicalDeliveryOfficeName site co unexported description facsimileTelephoneNumber ) ], }, employment => { name => 'Nouvelle période', attrs => [ qw( firstday lastday endcircuit company contratType department managerContact ) ], }, group => { name => 'Système', attrs => [ qw( gidNumber description label comment managedBy managedAlsoBy autoMemberFilter sutype services create createdby date modifiedby ) ], }, nethost => { name => 'Ordinateur', attrs => [ qw( name description comment 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( forward expire description comment autoMemberFilter autoExclude finalpoint parents create createdby date modifiedby unexported )], }, 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//>/g; s/"/"/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); return $oattr->{label} ? $oattr->{label}->() : $attr; } } 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_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( '', ($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;