[111] | 1 | package LATMOS::Accounts::Web::Model::AttrForms; |
---|
| 2 | |
---|
| 3 | use strict; |
---|
| 4 | use warnings; |
---|
| 5 | use base 'Catalyst::Model'; |
---|
| 6 | |
---|
| 7 | =head1 NAME |
---|
| 8 | |
---|
| 9 | LATMOS::Accounts::Web::Model::AttrForms - Catalyst Model |
---|
| 10 | |
---|
| 11 | =head1 DESCRIPTION |
---|
| 12 | |
---|
| 13 | Catalyst Model. |
---|
| 14 | |
---|
| 15 | =cut |
---|
| 16 | |
---|
| 17 | my $attrs = { |
---|
[143] | 18 | uid => [ 'Login' ], |
---|
| 19 | uidNumber => [ 'UID' ], |
---|
| 20 | gidNumber => [ 'GID', 'select:group:gidNumber' ], |
---|
[151] | 21 | manager => [ 'Responsable', 'select-N:user:uid' ], |
---|
[143] | 22 | sn => [ 'Nom' ], |
---|
| 23 | givenName => [ 'Prénom' ], |
---|
| 24 | homeDirectory => [ 'Home' ], |
---|
| 25 | loginShell => [ 'Shell' ], |
---|
| 26 | physicalDeliveryOfficeName => [ 'Bureau' ], |
---|
| 27 | telephoneNumber => [ 'Téléphone' ], |
---|
| 28 | otherTelephone => [ 'Téléphone (autre)' ], |
---|
| 29 | company => [ 'Société' ], |
---|
| 30 | l => [ 'Ville' ], |
---|
| 31 | postalCode => [ 'Code postal' ], |
---|
| 32 | postOfficeBox => [ 'BP' ], |
---|
[151] | 33 | department => [ 'Département', 'select-N:department' ], |
---|
[143] | 34 | streetAddress => [ 'Rue', 'textarea' ], |
---|
| 35 | st => [ 'Etat' ], |
---|
[145] | 36 | title => [ 'Fonction' ], |
---|
[160] | 37 | expire => [ 'Expire le', 'date' ], |
---|
[165] | 38 | st => [ 'Ãtat (US)' ], |
---|
| 39 | sutype => [ 'Structure admin.', 'select-N:sutype' ], |
---|
[167] | 40 | exported => [ undef, 'checkbox' ], |
---|
[111] | 41 | }; |
---|
| 42 | |
---|
| 43 | my $forms = { |
---|
[117] | 44 | user => { |
---|
| 45 | name => 'SystÚme', |
---|
[111] | 46 | acl => 'admin', |
---|
[112] | 47 | attrs => [ qw( |
---|
[125] | 48 | sn givenName description |
---|
| 49 | uid uidNumber gidNumber gecos homeDirectory loginShell |
---|
[117] | 50 | mail |
---|
[112] | 51 | ) ], |
---|
[117] | 52 | }, |
---|
| 53 | useraddress => { |
---|
| 54 | name => 'Adresse', |
---|
| 55 | attrs => [ qw( |
---|
[129] | 56 | initials |
---|
[117] | 57 | telephoneNumber |
---|
| 58 | otherTelephone |
---|
[129] | 59 | mail |
---|
| 60 | streetAddress |
---|
[131] | 61 | postOfficeBox |
---|
[129] | 62 | postalCode |
---|
| 63 | l |
---|
[160] | 64 | st |
---|
[117] | 65 | physicalDeliveryOfficeName |
---|
| 66 | ) ], |
---|
| 67 | }, |
---|
[129] | 68 | userstatus => { |
---|
| 69 | name => 'Status', |
---|
| 70 | attrs => [ qw( |
---|
| 71 | company |
---|
[151] | 72 | manager |
---|
[141] | 73 | department |
---|
[145] | 74 | title |
---|
[160] | 75 | expire |
---|
[167] | 76 | exported |
---|
[129] | 77 | ) ], |
---|
| 78 | }, |
---|
[134] | 79 | site => { |
---|
| 80 | name => 'Site', |
---|
| 81 | attrs => [ qw( |
---|
[148] | 82 | description |
---|
[134] | 83 | streetAddress |
---|
| 84 | postOfficeBox |
---|
| 85 | postalCode |
---|
[160] | 86 | st |
---|
[134] | 87 | l |
---|
| 88 | ) ], |
---|
| 89 | }, |
---|
[148] | 90 | department => { |
---|
| 91 | name => 'Département', |
---|
[151] | 92 | attrs => [qw(description manager) ], |
---|
[148] | 93 | }, |
---|
[125] | 94 | group => { |
---|
| 95 | name => 'SystÚme', |
---|
| 96 | acl => 'admin', |
---|
| 97 | attrs => [ qw( |
---|
[126] | 98 | gidNumber description |
---|
[167] | 99 | sutype exported |
---|
[125] | 100 | ) ], |
---|
| 101 | }, |
---|
[111] | 102 | }; |
---|
| 103 | |
---|
[116] | 104 | sub escape { |
---|
| 105 | my ($self, $text) = @_; |
---|
[117] | 106 | $text ||= ''; |
---|
[116] | 107 | for ($text) { |
---|
| 108 | s/&/&/g; |
---|
| 109 | s/</</g; |
---|
| 110 | s/>/>/g; |
---|
| 111 | s/"/"/g; |
---|
| 112 | } |
---|
| 113 | $text; |
---|
| 114 | } |
---|
[111] | 115 | |
---|
| 116 | sub new { |
---|
| 117 | my ($class) = @_; |
---|
| 118 | bless({}, $class); |
---|
| 119 | } |
---|
| 120 | |
---|
[144] | 121 | # call either OBJ or type + base |
---|
| 122 | |
---|
[111] | 123 | sub ACCEPT_CONTEXT { |
---|
[144] | 124 | my ($self, $c, $form, $object, $base) = @_; |
---|
| 125 | my $new = {}; |
---|
| 126 | $new->{c} = $c; |
---|
| 127 | $new->{form} = $form; |
---|
| 128 | $new->{object} = $object if (ref $object); |
---|
| 129 | $new->{base} = $base || ($object ? $object->base : undef) or return $self; |
---|
| 130 | $new->{otype} = ref $object ? $object->type : $object; |
---|
| 131 | bless($new, 'LATMOS::Accounts::Web::Model::AttrForms'); |
---|
[111] | 132 | } |
---|
| 133 | |
---|
[144] | 134 | sub base { |
---|
| 135 | my ( $self ) = @_; |
---|
| 136 | $self->{base} |
---|
| 137 | } |
---|
| 138 | |
---|
| 139 | sub otype { |
---|
| 140 | my ($self) = @_; |
---|
| 141 | $self->{otype}; |
---|
| 142 | } |
---|
| 143 | |
---|
[117] | 144 | sub label { |
---|
| 145 | my ($self) = @_; |
---|
| 146 | $forms->{$self->{form}}->{name} || '' |
---|
| 147 | } |
---|
| 148 | |
---|
[111] | 149 | sub attributes { |
---|
| 150 | my ($self) = @_; |
---|
[144] | 151 | grep { $self->base->get_field_name($self->otype, $_, 'a') } |
---|
[143] | 152 | @{ $forms->{$self->{form}}->{attrs} }; |
---|
[111] | 153 | } |
---|
| 154 | |
---|
| 155 | sub attr_label { |
---|
| 156 | my ($self, $attr) = @_; |
---|
[143] | 157 | return $self->escape($attrs->{$attr}[0] || $attr); |
---|
[111] | 158 | } |
---|
| 159 | |
---|
[144] | 160 | sub attr_raw_value { |
---|
| 161 | my ($self, $attr) = @_; |
---|
| 162 | return $self->{c}->req->param($attr) || |
---|
| 163 | ($self->{object} ? $self->{object}->get_c_field($attr) : '') |
---|
| 164 | } |
---|
| 165 | |
---|
[111] | 166 | sub attr_field { |
---|
[143] | 167 | my ($self, $attr, $type) = @_; |
---|
[144] | 168 | $type ||= $self->base->get_field_name($self->otype, $attr, 'w') |
---|
[143] | 169 | ? $attrs->{$attr}[1] || '' |
---|
| 170 | : 'label'; |
---|
| 171 | # exception: gidNumber is used also in group, but we don't want |
---|
| 172 | # group list here, really the number ! |
---|
[165] | 173 | $type = '' if (($self->{form} || '') =~ /^group/ && $attr eq 'gidNumber'); |
---|
[143] | 174 | for ($type) { |
---|
| 175 | /^textarea$/ and return sprintf( |
---|
| 176 | '<textarea name="%s">%s</textarea>', |
---|
| 177 | $self->escape($attr), |
---|
[144] | 178 | $self->escape($self->attr_raw_value($attr)), |
---|
[143] | 179 | ); |
---|
| 180 | /^label$/ and return $self->escape( |
---|
[144] | 181 | $self->attr_raw_value($attr) |
---|
[143] | 182 | ); |
---|
[160] | 183 | /^date$/ and do { |
---|
[170] | 184 | my ($date, $time) = split(/ /, $self->attr_raw_value($attr) || ''); |
---|
[168] | 185 | if ($date && $date =~ /^(\d+)-(\d+)-(\d+)$/) { |
---|
[160] | 186 | $date = "$3/$2/$1"; |
---|
| 187 | } |
---|
| 188 | my $html = "\n" . q{<SCRIPT LANGUAGE="JavaScript" ID="js13"> |
---|
| 189 | var cal13 = new CalendarPopup(); |
---|
| 190 | </SCRIPT>} . "\n"; |
---|
| 191 | $html .= sprintf( |
---|
| 192 | '<input type="text" name="%s" value="%s">', |
---|
| 193 | $attr, |
---|
| 194 | $self->escape($date) |
---|
| 195 | ); |
---|
| 196 | $html .= q{<DIV ID="testdiv1" STYLE="position:absolute;visibility:hidden;background-color:white;layer-background-color:white;"></DIV>}; |
---|
| 197 | $html .= qq{ |
---|
| 198 | <A HREF="#" |
---|
| 199 | onClick="cal13.select(document.forms[0].$attr,'anchor13','dd/MM/yyyy');return false;" |
---|
| 200 | TITLE="cal13.select(document.forms[0].$attr,'anchor13','dd/MM/yyyy'); return false;" |
---|
| 201 | NAME="anchor13" ID="anchor13"> |
---|
| 202 | <img src="} . $self->{c}->uri_for(qw(/static icons view-calendar-day.png)) |
---|
| 203 | . qq{" style="ref"></A>} . "\n"; |
---|
| 204 | return $html; |
---|
| 205 | }; |
---|
[167] | 206 | /^checkbox$/ and do { |
---|
| 207 | return sprintf('<input type="checkbox" name="%s"%s>', |
---|
| 208 | $attr, |
---|
| 209 | $self->attr_raw_value($attr) ? ' checked="yes"' : '' |
---|
| 210 | ); |
---|
| 211 | }; |
---|
[151] | 212 | /^select(-\w+)?:([^:]+)(?::(.*))?$/ and do { |
---|
| 213 | my $options = $1 || ''; |
---|
| 214 | my $otype = $2; |
---|
| 215 | my $keyfield = $3; |
---|
[143] | 216 | my $select = sprintf('<select name="%s">', |
---|
| 217 | $self->escape($attr)) . "\n"; |
---|
[151] | 218 | $select .= '<option value="">--</option>' . "\n" if ($options =~ /N/); |
---|
| 219 | my $value = $self->attr_raw_value($attr) || ''; |
---|
[145] | 220 | foreach my $id ($self->base->list_objects($otype)) { |
---|
| 221 | my $obj = $self->base->get_object($otype, $id) or next; |
---|
[143] | 222 | my $val = $keyfield ? $obj->get_c_field($keyfield) : $id; |
---|
| 223 | $select .= sprintf( |
---|
| 224 | ' <option value="%s"%s>%s</options>', |
---|
| 225 | $self->escape($val), |
---|
| 226 | $value eq $val ? ' "selected"' : '', |
---|
| 227 | $self->escape($id), |
---|
| 228 | ); |
---|
| 229 | $select .= "\n"; |
---|
| 230 | } |
---|
| 231 | $select .= "</select>\n"; |
---|
| 232 | return $select; |
---|
| 233 | }; |
---|
| 234 | } |
---|
[111] | 235 | return sprintf( |
---|
| 236 | '<input type="text" name="%s" value="%s">', |
---|
| 237 | $attr, |
---|
[144] | 238 | $self->escape($self->attr_raw_value($attr)) |
---|
[111] | 239 | ); |
---|
| 240 | } |
---|
| 241 | |
---|
[174] | 242 | sub submit { |
---|
| 243 | my ($self) = @_; |
---|
| 244 | return sprintf( |
---|
| 245 | '<input type="submit" name="%s">', |
---|
| 246 | $self->escape($self->label), |
---|
| 247 | ); |
---|
| 248 | } |
---|
| 249 | |
---|
[112] | 250 | sub set_attrs { |
---|
| 251 | my ($self) = @_; |
---|
[174] | 252 | $self->{c}->req->param($self->label) or return; |
---|
[112] | 253 | $self->{object}->set_c_fields( |
---|
| 254 | map { |
---|
[169] | 255 | $_ => |
---|
[170] | 256 | ($attrs->{$_}[1] || '') eq 'checkbox' |
---|
[174] | 257 | ? ($self->{c}->req->param($_) ? 1 : 0) |
---|
[169] | 258 | : $self->{c}->req->param($_) |
---|
[112] | 259 | } $self->attributes |
---|
| 260 | ); |
---|
| 261 | $self->{object}->base->commit; |
---|
| 262 | } |
---|
| 263 | |
---|
[111] | 264 | =head1 AUTHOR |
---|
| 265 | |
---|
| 266 | Thauvin Olivier |
---|
| 267 | |
---|
| 268 | =head1 LICENSE |
---|
| 269 | |
---|
| 270 | This library is free software, you can redistribute it and/or modify |
---|
| 271 | it under the same terms as Perl itself. |
---|
| 272 | |
---|
| 273 | =cut |
---|
| 274 | |
---|
| 275 | 1; |
---|