← Back to branch summary

~ubuntu-branches/ubuntu/precise/libcgi-formbuilder-perl/precise

« back to all changes in this revision

Viewing changes to lib/CGI/FormBuilder/Source/File.pm

  • Committer: Package Import Robot
  • Author(s): Jonas Smedegaard
  • Date: 2011-09-11 02:55:17 UTC
  • mfrom: (1.1.6 upstream)
  • Revision ID: package-import@ubuntu.com-20110911025517-nhr6j6fwwc9xc4l1
Tags: 3.06-1
* New upstream release.
* Use CDBS perl-makemaker.mk (not deprecated perlmodule.mk).
  Tighten build-dependency on CDBS.
* Update copyright file:
  + Fix use Comment field (not License-Comments).
  + Quote license names in comments.
* Add patch cherry-picked upstream to fix testsuite.
* Update package relations:
  + Build-depend on and suggest libcgi-ssi-perl.
  + Make suggestions unversioned and drop conflicts: satisfied even in
    oldstable.
  + Maintain all relations using CDBS in rules file.
* Stop preserving cruft no long shipped upstream.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/CGI/FormBuilder/Source/File.pm
1
1
 
2
2
###########################################################################
3
 
# Copyright (c) 2000-2006 Nate Wiger <nate@wiger.org>. All Rights Reserved.
4
 
# Please visit www.formbuilder.org for tutorials, support, and examples.
 
3
# Copyright (c) Nate Wiger http://nateware.com. All Rights Reserved.
 
4
# Please visit http://formbuilder.org for tutorials, support, and examples.
5
5
###########################################################################
6
6
 
7
7
package CGI::FormBuilder::Source::File;
30
30
use CGI::FormBuilder::Util;
31
31
 
32
32
our $REVISION = do { (my $r='$Revision: 100 $') =~ s/\D+//g; $r };
33
 
our $VERSION = '3.0501';
 
33
our $VERSION = '3.06';
34
34
 
35
35
# Begin "real" code
36
36
sub new {
57
57
 
58
58
    my $refield = 0;
59
59
    my @file;
 
60
    my $utf8 = 0;   # parse file as utf8
60
61
 
61
62
    debug 1, "parsing $file as input source";
62
63
    if (ref $file eq 'SCALAR') {
76
77
        next if /^\s*\[\%\s*\#|^\s*-*\%\]/;   # TT comments too
77
78
        chomp;
78
79
        my($term, $line) = split /\s*:\s*/, $_, 2;
 
80
        $utf8 = 1 if $term eq 'charset' && $line =~ /^utf/;  # key off charset to decode value
 
81
        $line = Encode::decode('utf-8', $line) if $utf8;
79
82
 
80
83
        # here string term-inator (har)
81
84
        if ($here) {
131
134
            }
132
135
 
133
136
            my @val;
134
 
            if ($term =~ /^js/ || $term eq 'messages') {
 
137
            if ($term =~ /^js/ || $term =~ /^on[a-z]/ || $term eq 'messages' || $term eq 'comment') {
135
138
                @val = $line;   # verbatim
136
139
            } elsif ($line =~ s/^\\(.)//) {
137
140
                # Reference - this is tricky. Go all the way up to
156
159
                @val = split /\s*,\s*/, $line;
157
160
 
158
161
                # m=Male, f=Female -> [m,Male], [f,Female]
159
 
                for (@val) {
160
 
                    $_ = [ split /\s*=\s*/, $_, 2 ] if /=/;
 
162
                for (my $i=0; $i < @val; $i++) {
 
163
                    $val[$i] = [ split /\s*=\s*/, $val[$i], 2 ] if $val[$i] =~ /=/;
161
164
                }
162
165
            }
163
166
 
164
167
            # only arrayref on multi values b/c FB is "smart"
165
168
            if ($ptr->{$term}) {
166
169
                $ptr->{$term} = (ref $ptr->{$term})
167
 
                                    ? [ @{$ptr->{$term}}, @val ] : @val > 1 ? \@val : $val[0];
 
170
                                    ? [ @{$ptr->{$term}}, @val ] : @val > 1 ? \@val :
 
171
                                      ref($val[0]) eq 'ARRAY' ? \@val : $val[0];
168
172
            } else {
169
 
                $ptr->{$term} = @val > 1 ? \@val : $val[0];
 
173
                $ptr->{$term} = @val > 1 ? \@val : ref($val[0]) eq 'ARRAY' ? \@val : $val[0];
170
174
            }
171
175
            $inval = 1;
172
176
        } else {
454
458
 
455
459
=head1 AUTHOR
456
460
 
457
 
Copyright (c) 2005-2006 Nathan Wiger <nate@wiger.org>. All Rights Reserved.
 
461
Copyright (c) L<Nate Wiger|http://nateware.com>. All Rights Reserved.
458
462
 
459
463
This module is free software; you may copy this under the terms of
460
464
the GNU General Public License, or the Artistic License, copies of