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 locked create date ) ], }, user => { name => 'Statut RH', attrs => [ qw( sn givenName description comment company department manager managerContact contratType expire snNative givenNameNative wWWHomePage halReference create date ) ], }, 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 ) ], }, group => { name => 'Système', attrs => [ qw( gidNumber description label comment managedBy managedAlsoBy autoMemberFilter sutype create date ) ], }, nethost => { name => 'Ordinateur', attrs => [ qw( name description comment related serialNumber encryptKey owner user ip macaddr puppetClass noInheritPuppet noDynamic cname otherName reverse create date 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 date dnsRevision lastUpdate unexported ) ], }, aliases => { name => 'Alias mail', attrs => [ qw( forward expire description comment finalpoint parents create date unexported )], }, services => { name => 'Services', attrs => [ qw( description comment manager dependOn create date 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; foreach (@{ $forms->{$form}->{attrs} }) { $new->{_attr}{$_} = $c->model('AttrFormsA', $_, ($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 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; } elsif (my $hash = LATMOS::Accounts::Web->config->{attrs}{$attr}) { return $hash->{label}; } else { return $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 write_attributes { my ($self) = @_; my @attrs; foreach (values %{ $self->{_attr} }) { $_->readonly and next; push(@attrs, $_); } @attrs; } sub set_attrs { my ($self, $attrs) = @_; $self->{c}->req->param($self->label) || $attrs or return; my %fields; foreach ($attrs ? @{ $attrs } : $self->write_attributes) { my $attr = ref $_ ? $_ : $self->{_attr}{$_}; if ($attr->{multiple}) { $fields{$attr->name} = [ grep { $_ } $self->{c}->req->param($attr->htmlname) ]; } else { $fields{$attr->name} = $self->{c}->req->param($attr->htmlname); } } $self->{object}->set_c_fields(%fields) or do { $self->{c}->stash->{page}{error} = LATMOS::Accounts::Log::lastmessage(LA_ERR); $self->{object}->base->rollback; return; }; $self->{object}->base->commit; } sub submit { my ($self) = @_; return sprintf( '', $self->escape($self->label), ); } =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;