line
stmt
bran
cond
sub
pod
time
code
1
=head1 NAME
2
3
HTML::FormEngine::Handler - FormEngine template handler
4
5
=head1 HANDLERS
6
7
=cut
8
9
######################################################################
10
11
package HTML::FormEngine::Handler;
12
13
1
1
5
use Locale::gettext;
1
2
1
2756
14
15
######################################################################
16
17
=head2 default
18
19
The default handler is called if the named handler doesn't exist.
20
21
With help of the default handler one can nest templates. It expects
22
the name, with which it was called, to be the name of an template. It
23
then reads in this template and processes it. The resulting code is
24
returned.
25
26
=cut
27
28
######################################################################
29
30
sub _handle_default {
31
0
0
my ($self,$templ,@args) = @_;
32
0
0
0
if(defined($templ) && defined($self->{skin_obj}->get_templ($templ))) {
33
0
my $back = $self->{_handle_default};
34
0
0
$self->{_handle_default} = (@args ? \@args : undef);
35
0
my $res = $self->_parse($self->{skin_obj}->get_templ($templ));
36
0
$self->{_handle_default} = $back;
37
0
return $res;
38
}
39
0
return '';
40
}
41
42
######################################################################
43
44
=head2 checked
45
46
This handler is used in the I, I, I and similar
47
templates.
48
49
The first argument defines the value, which should be returned if a
50
certain option was submitted. By default this is 'checked'.
51
52
The second argument defines the name of the variable in which the
53
option values are stored (default: OPT_VAL).
54
55
The third argument defines the name of the variable which defines the
56
field name (default: NAME).
57
58
..or if you want to know it more exactly:
59
60
The first argument is returned if the field was selected. If this
61
argument is not defined, I is returned. If the field wasn't
62
selected, an empty string is returned.
63
64
The second argument is the name of the variable in which the value of
65
the field is defined which is submitted if the field was selected. By
66
default the value of this argument is I.
67
68
The third argument contains the name of the variable in which the name
69
of the field is stored. With the help of this variable the submitted
70
value of the field is read in to be compared with the value which the
71
field should have if it was selected. So the handler can determine
72
whether the field was selected or not. By default this argument is
73
I.
74
75
Normally the only important argument is the first one. The others can
76
be important if you want to change variable names.
77
78
=cut
79
80
######################################################################
81
82
sub _handle_checked {
83
0
0
my($self, $caller, $res, $namevar, $valuevar) = @_;
84
0
0
$res = 'checked' if(! defined($res));
85
86
#we use a little dirty hack to get the whole VALUE contents and not the element corresponding to the loop-level
87
#we want the whole because the user of this module just specifies e.g. VALUE = [1,2,7] to say that he wants the checkboxes
88
#representing the values 1,2,7 to be checked. If we would consider the loop level he'd have to say e.g. VALUE = [1,2,,,,7]
89
#if the form was submitted this hack doesn't have any effect.
90
0
my $loop;
91
#...choosing the loop-status that matters...
92
0
0
if(defined($self->{loop_var}->{'VALUE'})) {
93
0
$loop = \$self->{loop_var}->{'VALUE'};
94
} else {
95
0
$loop = \$self->{loop};
96
}
97
98
#temporaly reseting the loop-level (we pretend not to be in any loop)
99
0
local $_ = $$loop;
100
0
$$loop = [];
101
0
my $checked = $self->_get_value($namevar);
102
0
$$loop = $_;
103
104
#i don't know if that is a good idea...
105
0
0
return '' unless($checked ne '');
106
107
0
0
my $value = $self->_get_var($valuevar||'OPT_VAL');
108
0
my $input = '';
109
#we just have to check if one of the submitted values matches $value
110
0
0
if(ref($checked) eq 'ARRAY') {
0
111
0
0
if(grep {$_ eq $value} @{$checked}) {
0
0
112
0
return $res;
113
}
114
}
115
#..even easier
116
elsif($checked eq $value) {
117
0
return $res;
118
}
119
0
return '';
120
}
121
122
######################################################################
123
124
=head2 value
125
126
This handler returns the value of the field.
127
128
The first argument defines the value which should be returned if the
129
value is empty. By default this is undef.
130
131
If the second argument is true (1), the returned value will be
132
returned again next time the handler is called for this field name.
133
134
The third argument is used to tell the handler the name of the
135
variable in which the field name is stored. By default this is
136
I.
137
138
The fourth argument should be set to the name of the variable which
139
contains the fields value. By default this is I.
140
141
If the form wasn't submitted, the fields default value is returned.
142
143
=cut
144
145
######################################################################
146
147
sub _handle_value {
148
0
0
my ($self,$caller,$none,$same,$namevar,$valuevar) = @_;
149
0
$res = $self->_get_value($namevar,$valuevar);
150
0
0
if(ref($res) eq 'ARRAY') {
151
0
0
$_ = $self->_get_var($namevar||'NAME');
152
0
0
if(ref($self->{_handle_value}) ne 'HASH') {
153
0
$self->{_handle_value} = {};
154
# this hash must be cleaned before calling make again!!
155
0
0
push @{$self->{call_before_make}}, sub { my ($self) = @_; $self->{_handle_value} = {}; };
0
0
0
156
# seperate handler should reset _handle_value so that the count starts again from 0
157
0
push @{$self->{reset_on_seperate}}, '_handle_value';
0
158
}
159
0
0
if(!$same) {
0
0
160
0
0
$res = $res->[$self->{_handle_value}->{$_}++ || 0];
161
}
162
#next call the same value should be returned for this field name
163
elsif($same > 0) {
164
0
0
$res = $res->[$self->{_handle_value}->{$_} || 0];
165
}
166
elsif($same < 0) {
167
0
0
0
$res = $res->[(defined($self->{_handle_value}->{$_}) and $self->{_handle_value}->{$_} > 0) ? $self->{_handle_value}->{$_} -1 : 0];
168
}
169
}
170
0
0
0
return (defined($res) and $res ne '') ? $res : $none;
171
}
172
173
######################################################################
174
175
=head2 error, error_in, error_check
176
177
The first argument sets the name of the variable in which the error
178
checks are set. By default this is I.
179
180
The second argument sets the name of the variable in which the fields
181
name is stored. By default this is I.
182
183
The third argument sets the name of the variable which contains the
184
fields value. By default this is I but if error_check was used
185
as handler name the default is I.
186
187
If the last argument is set to true (1) no checking will be done, that
188
means that also no error can be returned. This can only be usefull for
189
debugging.
190
191
The handler calls the defined error checks until an error message is
192
returned or all checks were called. If it retrieves an error message
193
it returns this message or the message given by the [checkmethod,
194
errormessage, arg1, ... argn] notation, else NULL is returned.
195
196
=cut
197
198
######################################################################
199
200
sub _handle_error {
201
0
0
my ($self,$caller,$keyvar,$namevar,$valuevar,$nocheck) = @_;
202
0
0
0
if($self->is_submitted && $self->{check_error}) {
203
0
0
my $check = $self->_get_var($keyvar||'ERROR');
204
0
0
0
$check = [ $check ] if(defined($check) and ref($check) ne 'ARRAY' and $check ne '');
0
205
0
0
0
if(ref($check) eq 'ARRAY' and @{$check}) {
0
206
0
0
my $name = $self->_get_var($namevar||'NAME');
207
0
my $value = $self->_get_value($namevar,$valuevar,1);
208
209
# #error_in calls should only check exactly one value
210
0
0
0
if($caller eq '#error_in' && ref($value) eq 'ARRAY') {
0
211
0
0
if (ref($self->{_handle_error}) ne 'HASH') {
212
0
$self->{_handle_error} = {};
213
0
0
push @{$self->{call_before_make}}, sub { my($self) = @_; $self->{_handle_error} = {}; };
0
0
0
214
# seperate handler should reset _handle_error so that the count starts again from 0
215
0
push @{$self->{reset_on_seperate}}, '_handle_error';
0
216
}
217
0
0
$value = $value->[$self->{_handle_error}->{$name}++ || 0];
218
}
219
220
# error_check is designed to be used in templates like radio, checkbox and select
221
elsif($caller eq '#error_check') {
222
0
0
$value = [$value] if(ref($value) ne 'ARRAY');
223
0
0
my $optval = $self->_get_var($valuevar || 'OPT_VAL');
224
0
0
if(grep {$optval eq $_} @$value) {
0
225
0
$value = $optval;
226
}
227
else {
228
0
$value = '';
229
}
230
}
231
232
0
0
unless($nocheck) {
233
0
foreach my $chk (@{$check}) {
0
234
0
my $errmsg = '';
235
0
my @args = ();
236
0
0
if(ref($chk) ne 'CODE') {
237
#this implements the [checkmethod, errmsg, arg1, arg2, ... argn] notation
238
0
0
if(ref($chk) eq 'ARRAY') {
239
#add the name of the call alias infront of the argument list
240
0
push @args, $chk->[0];
241
0
$errmsg = $chk->[1];
242
0
0
push @args, @$chk[2..@{$chk}-1] if(@{$chk} >= 3);
0
0
243
0
$chk = $chk->[0];
244
}
245
else {
246
#add the name of the call alias infront of the argument list
247
0
push @args, $chk;
248
}
249
0
$chk = $self->{skin_obj}->get_check($chk);
250
}
251
0
0
if(ref($chk) eq 'CODE') {
252
0
local $_ = undef;
253
0
0
if($_ = &$chk($value, $self, @args)) {
254
0
$self->{errcount} ++;
255
0
0
return $self->_get_var('errmsg') || $errmsg || $_;
256
}
257
}
258
}
259
}
260
}
261
}
262
0
return '';
263
}
264
265
######################################################################
266
267
=head2 gettext
268
269
The arguments given to this handler, are passed through gettext and
270
then joined together with a spacing blank inbetween. The resulting
271
string is returned.
272
273
=cut
274
275
######################################################################
276
277
sub _handle_gettext {
278
0
0
my ($self,$caller) = (shift,shift);
279
0
my @res;
280
0
foreach $_ (@_) {
281
0
push @res, gettext($_);
282
}
283
0
return join(' ', @res);
284
}
285
286
######################################################################
287
288
=head2 gettext_var
289
290
You can pass variable names to this handler. The values of those
291
variables are then pushed through gettext and the resulting strings
292
are glued together with a blank inbetween.
293
294
=cut
295
296
######################################################################
297
298
sub _handle_gettext_var {
299
0
0
my ($self,$caller) = (shift,shift);
300
0
my @res;
301
0
foreach $_ (@_) {
302
#get content of variable
303
0
$_ = $self->_get_var($_);
304
0
0
push @res, gettext($_) if($_ ne '');
305
}
306
0
return join(' ', @res);
307
}
308
309
######################################################################
310
311
=head2 label
312
313
This handler gets the id, title and accesskey value and uses this
314
informations to create a (X)HTML C<< >> tag which is then returned.
315
316
The first argument should be set to the name of the variable which
317
provides the fields title, by default this is I.
318
319
The seconds argument default is I. It should be always set to the
320
variable which contains the fields id.
321
322
The third argument is used to try to get an accesskey for the
323
field. Normally the variable ACCESSKEY is expected to provide such, if
324
you prefer to use another variable please give its name here.
325
326
=cut
327
328
######################################################################
329
330
sub _handle_label {
331
0
0
my($self,$caller,$labelvar,$idvar,$accesskeyvar) = @_;
332
0
0
my $label = $self->_get_var($labelvar||'TITLE');
333
0
0
my $id = $self->_get_var($idvar||'ID');
334
#the label tag doesn't make sense without a label
335
0
0
return '' if(!$label);
336
#the label tag doesn't make sense without an id, we also should parse it if things like <& are contained
337
#its not necessary anymore because this is done by _get_var anyway
338
#return $self->_parse($label) if(ref($id) || !defined($id) || $label =~ /<(&|~|!).*(!|~|&)>/);
339
0
0
my $accesskey = $self->_get_var($accesskeyvar||'ACCESSKEY');
340
0
0
$accesskey='' unless(defined($accesskey));
341
0
return "$label ";
342
}
343
344
######################################################################
345
346
=head2 decide
347
348
Expects a list of variable names, it then returns the content of the
349
first variable in the list which is not empty.
350
351
=cut
352
353
######################################################################
354
355
sub _handle_decide {
356
0
0
my($self,$caller,@vars) = @_;
357
0
foreach $_ (@vars) {
358
0
my $value = $self->_get_var($_,1);
359
0
0
return $self->_parse($value) if(defined($value));
360
}
361
0
return '';
362
}
363
364
######################################################################
365
366
=head2 readonly
367
368
Expects the name of the variable which says whether the field should
369
be set readonly or not. By default this is I.
370
C is returned if that variable is set to 1 (true).
371
372
=cut
373
374
######################################################################
375
376
sub _handle_readonly {
377
0
0
my($self,$caller,$readonlyvar) = @_;
378
0
0
$readonlyvar = 'READONLY' unless($readonlyvar);
379
0
0
return 'readonly="readonly"' if($self->_get_var($readonlyvar,1));
380
0
return '';
381
}
382
383
######################################################################
384
385
=head2 multiple
386
387
Works like C but C is returned if
388
I is true.
389
390
=cut
391
392
######################################################################
393
394
sub _handle_multiple {
395
0
0
my($self,$caller,$multiplevar) = @_;
396
0
0
$multiplevar = 'MULTIPLE' unless($multiplevar);
397
0
0
return 'multiple="multiple"' if($self->_get_var($multiplevar,1));
398
0
return '';
399
}
400
401
######################################################################
402
403
=head2 confirm_check_prepare
404
405
This handler is a confirm handler. It sets the variables I and
406
I to the list of submitted values resp. their visible
407
names. This is usefull because like that only the really submitted
408
values and options are printed when the template iterates over OPTION
409
and/or OPT_VAL.
410
411
With the first argument you can set how many options/values you want to
412
have per line when iterating. By default this is 2. Internally it just
413
configurs how many elements every array should have.
414
415
The second argument is by default I and should always be set
416
to the name of the variable which provides the option list.
417
418
The third argument configures which variable should be read in to get
419
the list of submitted values. By default this is I.
420
421
The fourth argument should be set to the right variable name if the
422
variable which contains the fields name is not I (normally it is
423
I).
424
425
=cut
426
427
######################################################################
428
429
sub _handle_confirm_check_prepare {
430
0
0
my($self,$caller,$perline,$optionvar,$optvalvar,$namevar) = @_;
431
0
0
$perline = 2 unless($perline);
432
#get list of submitted values
433
0
my $value = $self->_get_value($namevar);
434
0
0
$value = [$value] unless(ref($value) eq 'ARRAY');
435
#get list of all options
436
0
0
my $option = $self->_get_var($optionvar||'OPTION');
437
0
0
$option = [$self->_flatten_array(ref($option) eq 'ARRAY' ? @$option : $option)];
438
#get list of all values
439
0
0
my $optval = $self->_get_var($optvalvar||'OPT_VAL');
440
0
0
$optval = [$self->_flatten_array(ref($optval) eq 'ARRAY' ? @$optval : $optval)];
441
0
my %option;
442
#create a optval => option map
443
0
for(my $i=0; $i<@$option; $i++) {
444
0
$option{$optval->[$i]} = $option->[$i];
445
}
446
0
my @optcache = (), my @valcache = ();
447
0
my @option = ();
448
0
my @value = ();
449
0
$i = 0;
450
#now create the new option and value list which then only contains the submitted values/options
451
0
foreach $_ (@$value) {
452
0
0
if(defined($option{$_})) {
453
0
push @optcache, $option{$_};
454
0
push @valcache, $_;
455
0
$i++;
456
#when iterating the first array dimension creates the rows, the second fills up the columns
457
0
0
if(!($i % $perline)) {
458
0
push @option, [@optcache];
459
0
push @value, [@valcache];
460
0
@optcache = ();
461
0
@valcache = ();
462
}
463
}
464
}
465
#we probably have to fill up the last row
466
#while($i % $perline and $i > 0) {
467
#i don't know why, but when i enable this namechooser.cgi ends up in an endless loop when the confirm-form is being generated
468
#push @optcache, '';
469
#$i++;
470
#}
471
0
0
push @option, [@optcache] if(@optcache);
472
0
0
push @value, [@valcache] if(@valcache);
473
0
$self->_set_var('OPTION', \@option);
474
0
$self->_set_var('OPT_VAL', \@value);
475
0
return '';
476
}
477
478
479
######################################################################
480
481
=head2 seperate
482
483
First of all: The handler doesn't do anything if the C
484
method was not called with a true value!
485
486
If set_seperate was called with a true value, this handler returns a
487
seperation-field if the fieldname changes while iterating or if a
488
template came to its end. Of course that only works when used in the
489
right way in the templates.
490
491
The seperation-field is important because it controlls which values of
492
a certain fieldname belong together and are thus packed into one
493
subarray of the C result for that fieldname.
494
495
E.g.: you've a field called I which consists of two text-inputs,
496
one for the first- and one for the lastname. If you now call
497
C it'll return: [firstname,lastname]. So far no
498
problem. The problem comes if you use this I field twice
499
e.g. because you want to get the data of 2 persons in one form. Now
500
FormEngine normally would think that all four belong together:
501
[firstname,lastname,firstname,lastname] but with the help of the
502
seperation field which will automatically be inserted inbetween, it
503
knows that the following is to be expected:
504
[[firstname,lastname],[firstname,lastname]]. So far that isn't so
505
important, but it really gets important for the radio,select and
506
checkbox fields, because here FormEngine must know which values belong
507
to which group and so on.
508
509
One might think: why do people not just use diffrent names? Well, i
510
would say it is much more easier to define and also much more easy
511
to evaluate the return value if fields who semanticlly belong
512
together have the same name. If you would give the fields for each
513
person its own name like name1, name2 ... it'll be not so nice to call
514
get_value() for each person especially if the count of persons is
515
flexible. So its much nicer to just call get_value(name) and then to
516
know that each subarray represents one person.
517
518
The first argument is attached to the seperation-field-code. If the
519
second argument is set to true (1) the sepeartion-field-code will be
520
returned in any case (if set_seperate was called with a true
521
value). The third argument is by default I and should always be
522
set to the variable which contains the fields name.
523
524
=cut
525
526
######################################################################
527
528
sub _handle_seperate {
529
0
0
my($self,$caller,$attach,$clear,$namevar) = @_;
530
#only if set_seperate() was called and set to true this handler shall do something
531
0
0
return '' unless($self->{seperate});
532
0
my $res = '';
533
0
0
my $name = $self->_get_var($namevar||'NAME',1);
534
0
0
if (ref($self->{_handle_seperate}) ne 'ARRAY') {
535
0
$self->{_handle_seperate} = [];
536
0
0
push @{$self->{call_before_make}}, sub { my($self) = @_; $self->{_handle_seperate} = []; };
0
0
0
537
}
538
#seperation works per level, that means that when the fieldname changes from one to another level that has no effect, only changes on the same level matter
539
0
my $old = $self->{_handle_seperate}->[$self->{depth}];
540
#if clear is true or the fieldname changed...
541
0
0
0
if($clear || (defined($old) and $old ne $name)) {
0
542
0
0
local $_ = defined($old) ? $old : $name;
543
#create the seperation field
544
0
0
$res = $self->_parse(' ' . (defined($attach) ? $attach : '')) unless($caller eq '#seperate_conly');
0
545
#
546
0
$self->{values}->{$_} ++;
547
0
foreach my $key (@{$self->{reset_on_seperate}}) {
0
548
0
$self->{$key}->{$_} = 0;
549
}
550
}
551
0
0
$self->{_handle_seperate}->[$self->{depth}] = ($clear ? undef : $name);
552
0
return $res;
553
}
554
555
######################################################################
556
557
=head2 encentities
558
559
This handler expects a variable name. It then fetches the variables
560
contents and passes it through encode_entities so that all HTML
561
entities are encoded. The resulting string is returned.
562
563
=cut
564
565
######################################################################
566
567
sub _handle_encentities {
568
0
0
my($self,$caller,$var) = @_;
569
0
0
return '' unless(defined($var));
570
0
require HTML::Entities;
571
0
return encode_entities($self->_get_var($var));
572
}
573
574
######################################################################
575
576
=head2 save_to_global
577
578
The handlers first argument can be any template expression (like
579
<&NAME&> or <&value ,1&>), the second argument is by default I
580
and should always be set to a string which is not yet used as variable
581
name anywhere in the template (at least it normally will make most
582
sense if it is not used anywhere, in some cases might be usefull to
583
use an existing name).
584
585
The handler will then read in the value of the expression given as
586
first argument and will save it to the variable given as second
587
argument but as a global variable, that means that value will then be
588
available in every template if the variable is not overwritten by a
589
local variable.
590
591
This handler is especially usefull in association with the C
592
check method.
593
594
=cut
595
596
######################################################################
597
598
sub _handle_save_to_global {
599
0
0
my($self,$caller,$expr,$savetovar) = @_;
600
0
my $val = $self->_parse($expr);
601
0
0
if(defined($val)) {
602
0
0
$self->{varstack}->[0]->{$savetovar||'saved'} = $val;
603
}
604
0
return '';
605
}
606
607
######################################################################
608
609
=head2 not_null
610
611
The first argument is by default I and should always be set to
612
the name of the variable which defines the error checks.
613
614
The second argument is returned if the list of error checks contains
615
the I check, which means that the field mustn't be
616
empty. What is to be returned by default is setted by the skin,
617
normally it is the empty string (no mark). A good value would be
618
e.g. I<*>. See L on how to modify the default
619
(C).
620
621
This handler is used to automatically mark fields which have to be
622
filled out.
623
624
=cut
625
626
######################################################################
627
628
sub _handle_not_null {
629
0
0
my($self,$caller,$err_var,$res) = @_;
630
0
0
my $err = $self->_get_var($err_var||'ERROR');
631
0
0
return '' unless(defined($err));
632
0
0
$err = [$err] unless(ref($err) eq 'ARRAY');
633
0
0
0
return $res||$self->{skin_obj}->get_not_null_string() if(grep {defined($_) && $_ eq 'not_null'} @$err);
0
0
634
0
return '';
635
}
636
637
######################################################################
638
639
=head2 html2text
640
641
This handler expects a variable name as argument, it then fetches the
642
value of the variable and passes it through
643
C before returning
644
it. C turns HTML entities like C<<> in their
645
corresponding plain-text character.
646
647
=cut
648
649
######################################################################
650
651
sub _handle_html2text {
652
0
0
my($self,$caller,$var) = @_;
653
0
require HTML::Entities;
654
0
0
return '' unless(defined($var));
655
0
return HTML::Entities::decode_entities($self->_get_var($var));
656
}
657
658
######################################################################
659
660
=head2 arg
661
662
When calling a template you can pass arguments to it like this: C<<
663
<&template arg0,arg1...,argn&> >>
664
665
In the template you then use this handler to fetch the passed
666
arguments. An example: C<< <arg 1&> >>. This will return I.
667
668
=cut
669
670
######################################################################
671
672
sub _handle_arg {
673
0
0
my($self,$caller,@args) = @_;
674
0
my @res;
675
0
local $_;
676
0
foreach $_ (@args) {
677
0
0
if(ref($self->{_handle_default}->[$_]) eq 'ARRAY') {
678
0
push @res, join(',',@{$self->{_handle_default}->[$_]});
0
679
}
680
else {
681
0
0
push @res, $self->{_handle_default}->[$_]||'';
682
}
683
}
684
0
my $res = join(',', @res);
685
0
0
return $res if(defined($res));
686
0
return '';
687
}
688
689
######################################################################
690
691
=head1 WRITING A HANDLER
692
693
=head2 Design
694
695
In general, a handler has the following structure:
696
697
sub myhandler {
698
my($self,$callname,@args) = @_;
699
# ... some code ... #
700
return $res;
701
}
702
703
C<$self> contains a reference to the FormEngine object.
704
705
C<$callname> contains the name or synonym which was used to call the
706
handler. So it is possible to use the same handler for several,
707
similar jobs.
708
709
C<@args> contains the arguments which were passed to the handler (see
710
Skin.pm).
711
712
=head2 Install
713
714
Read L on how to make your handlers
715
available. To hardcode them into the skin edit its source code, also
716
read about the other skin packages.
717
718
=cut
719
720
1;
721
722
__END__