~ubuntu-branches/debian/sid/libembperl-perl/sid

« back to all changes in this revision

Viewing changes to Embperl/Form/Validate.pm

  • Committer: Bazaar Package Importer
  • Author(s): Gunnar Wolf, Jonathan Yu, Damyan Ivanov, Ryan Niebur, gregor herrmann, Gunnar Wolf
  • Date: 2009-10-15 11:43:24 UTC
  • mfrom: (1.2.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20091015114324-2rnqzsj9jmpwd9nt
Tags: 2.3.0-1
[ Jonathan Yu ]
* New upstream release
  + SSI syntax now behaves more like mod_include
  + Improved XHTML/XML support
  + Fix to correctly retrieve Cookie header under apache2
  + Fix segfault when a value of an input attribute is removed
* Bringing this package under the pkg-perl group (Closes: #543609)
* Updated d/watch with CPAN search site
* Standards-Version 3.8.3
  + Remove version dependency on perl
  + Add Vcs-* and Homepage fields
* Drop version dependency on:
  + apache2-prefork-dev (>= 2.2.3-3.3) [oldstable 2.2.3-4]
  + apache2-mpm-prefork (>= 2.2.3-3.3) [oldstable  2.2.3-4]
  + libapache2-mod-perl2 (>= 2.0.2-2.3) [oldstable 2.0.2-2.4]
* Remove libcgi-pm-perl | perl-modules (>= 5.8.0) | libcgi-perl,
  which is always satisfied by perl
* Add extensive patches to fix POD errors and add whatis entries
* Add a patch to remove some Unicode data from POD; it was causing
  an obscure error with `AE' (thanks Ryan52!)

[ Damyan Ivanov ]
* debian/rules: fix target dependencies

[ Ryan Niebur ]
* Update jawnsy's email address
* Update ryan52's email address

[ gregor herrmann ]
* Split out all changes to upstream code into proper patches managed by
  quilt.
* Add patch cgi_pm.patch by Niko Tyni to avoid FTBFS if a newer CGI.pm is
  present at test time (closes: #521971).
* Update debian/copyright.
* debian/rules:
  - clean up a bit
  - call make with "-j1", the upstream build system is not parallel-build safe
  - add support for DEB_BUILD_OPTIONS nocheck
* Change Section to "perl".
* Remove dbinitembperlapache (created by test suite).

[ Gunnar Wolf ]
* Updated README.Debian to reflect the current reality re: thread
  safety, dropping mentions of obsolete mod_perl v1 and mentioning the
  deprecation of embperl itself
* Reload Apache if a2enmod/a2dismod was called in postinst/prerm
* Added Suggests: apache2-mpm-prefork, as it is the closer we can get to
  get the non-threaded versions of Apache2 by default besides
  documenting, which is already done in README.Debian. (Closes: #412521)

Show diffs side-by-side

added added

removed removed

Lines of Context:
10
10
#   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
11
11
#   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
12
12
#
13
 
#   $Id: Validate.pm 294769 2005-08-13 19:43:05Z richter $
 
13
#   $Id: Validate.pm 474140 2006-11-13 04:41:09Z richter $
14
14
#
15
15
###################################################################################
16
16
 
74
74
 
75
75
The following methods are available:
76
76
 
77
 
=head2 $epf = Embperl::Form::Validate -> new ($rules [, $form_id ], [$default_language]);
 
77
=head2 $epf = Embperl::Form::Validate -> new ($rules [, $form_id ], [$default_language], [$charset]);
78
78
 
79
79
Constructor for a new form validator. Returns a reference to a
80
80
Embperl::Form::Validate object.
98
98
language to use when no messages are available in the desired language.
99
99
Defaults to 'en'.
100
100
 
 
101
=item $charset
 
102
 
 
103
Pass 'utf-8' in case you want utf-8 messages.
 
104
 
101
105
=back
102
106
 
103
107
=cut
106
110
    {
107
111
    my $invokedby = shift;
108
112
    my $class = ref($invokedby) || $invokedby;
109
 
    my ($frules, $form_id, $default_language) = @_ ;
 
113
    my ($frules, $form_id, $default_language, $charset) = @_ ;
110
114
 
111
115
    my $self = {
112
116
                 form_id          => $form_id || 'forms[0]', # The name 
113
117
                 frules           => $frules || [],          # \@frules
114
118
                 default_language => $default_language || 'en',
 
119
                 charset          => $charset || 'iso8859-15',
115
120
               };
116
121
    bless($self, $class);
117
122
    $self->init;
359
364
    my ($self, $id, $key, $name, $msg, $param, $typeobj, $pref, $epreq) = @_ ;
360
365
 
361
366
    my $language = $pref -> {language} ;
362
 
    my $default_language = $pref -> {default_language} ;
 
367
    my $default_language = $pref -> {default_language} || $self -> {default_language} ;
 
368
    my $charset = $pref -> {charset} ;
363
369
    my $txt ;
364
370
 
365
371
    $name ||=  $epreq?$epreq -> gettext($key):$key ;
368
374
        my @names ;
369
375
        foreach my $n (@$name)
370
376
            {
371
 
            push @names, ref $n ? ($n -> {$language} || $n -> {$default_language} || (each %$n)[1] || $key):$n ; 
 
377
            push @names, ref $n ? ($n -> {"$language.$charset"} || $n -> {"$default_language.$charset"} || $n -> {$language} || $n -> {$default_language} || (each %$n)[1] || $key):$n ; 
372
378
            }
373
379
        $name = join (', ', @names) ;
374
380
        }
375
381
    else
376
382
        {
377
 
        $name = ref $name ? ($name -> {$language} || $name -> {$default_language} || (each %$name)[1] || $key):$name ; 
 
383
        $name = ref $name ? ($name -> {"$language.$charset"} || $name -> {"$default_language.$charset"} || $name -> {$language} || $name -> {$default_language} || (each %$name)[1] || $key):$name ; 
378
384
        }
379
385
 
380
386
    if ($msg)
381
387
        {
382
 
        $txt = ref $msg ? ($msg -> {$language} || $msg -> {$default_language} || (each %$msg)[1] || undef):$msg ; 
 
388
        $txt = ref $msg ? ($msg -> {"$language.$charset"} || $msg -> {"$default_language.$charset"} || $msg -> {$language} || $msg -> {$default_language} || (each %$msg)[1] || undef):$msg ; 
383
389
        }
384
390
    else
385
391
        {
386
 
        $txt = $typeobj -> getmsg ($id, $language, $default_language) ;
 
392
        $txt = $typeobj -> getmsg ($id, "$language.$charset", "$default_language.$charset") ;
 
393
        $txt ||= $typeobj -> getmsg ($id, $language, $default_language) ;
387
394
        }
388
395
    $txt = $epreq -> gettext($id) if (!$txt && $epreq) ;
389
396
    $txt ||= "Missing Message $id: %0 %1 %2 %3" ;                 
444
451
    $epreq ||= $Embperl::req ;
445
452
    $pref -> {language} ||= $epreq -> param -> language if ($epreq) ;
446
453
    $pref -> {default_language} ||= $self -> {default_language} ;
 
454
    $pref -> {charset} ||= $self -> {charset} ;
447
455
 
448
456
    my $result = $self -> validate ($fdat, $pref, $epreq) ;
449
457
    return [] if (!@$result) ;
634
642
    $pref  ||= {} ;
635
643
    $pref -> {language} ||= $epreq -> param -> language if ($epreq) ;
636
644
    $pref -> {default_language} ||= $self -> {default_language} ;
 
645
    $pref -> {charset} ||= $self -> {charset} ;
637
646
    
638
647
    my $script ;
639
648
    $script = $self -> gather_script_code ($self->{frules}, $pref, $epreq) ;
906
915
 
907
916
=item must_contain_one_of
908
917
 
 
918
=item checked
 
919
 
 
920
Checkbox must be selected
 
921
 
 
922
=item notchecked
 
923
 
 
924
Checkbox must not be selected
 
925
 
909
926
=back
910
927
 
911
928