root/lang/perl/FormValidator-LazyWay/trunk/lib/FormValidator/LazyWay/Utils.pm @ 16419

Revision 16419, 4.0 kB (checked in by tomyhero, 5 years ago)

lang/perl/FormValidator-LazyWay? : dependency_groupsを実装しました。

Line 
1package FormValidator::LazyWay::Utils;
2
3use strict;
4use warnings;
5use Scalar::Util;
6use Perl6::Junction qw/any/;
7
8sub check_profile_syntax {
9    my $profile = shift;
10
11    ( ref $profile eq 'HASH' )
12        or die "Invalid input profile: needs to be a hash reference\n";
13
14    my @invalid;
15    {
16        my @valid_profile_keys = (
17            qw/
18                required
19                optional
20                defaults
21                want_array
22                stash
23                lang
24                level
25                dependency_groups
26                dependencies
27                /
28        );
29
30        for my $key ( keys %$profile ) {
31            next if $key =~ m/^use_/;
32            push @invalid, $key unless ( $key eq any(@valid_profile_keys) );
33        }
34
35        local $" = ', ';
36        if (@invalid) {
37            die "Invalid input profile: keys not recognised [@invalid]\n";
38        }
39    }
40
41    return 1;
42}
43
44sub remove_empty_fields {
45    my $valid = shift;
46
47    for my $field ( keys %{$valid} ) {
48        if ( ref $valid->{$field} ) {
49            next if ref $valid->{$field} ne 'ARRAY';
50            for ( my $i = 0; $i < scalar @{ $valid->{$field} }; $i++ ) {
51                $valid->{$field}->[$i] = undef
52                    unless ( defined $valid->{$field}->[$i]
53                    and length $valid->{$field}->[$i]
54                    and $valid->{$field}->[$i] !~ /^\x00$/ );
55            }
56
57            # If all fields are empty, we delete it.
58            delete $valid->{$field}
59                unless grep { defined $_ } @{ $valid->{$field} };
60        }
61        else {
62            delete $valid->{$field}
63                unless ( defined $valid->{$field}
64                and length $valid->{$field}
65                and $valid->{$field} !~ /^\x00$/ );
66        }
67    }
68
69    $valid;
70}
71
72sub arrayify {
73
74    # if the input is undefined, return an empty list
75    my $val = shift;
76    defined $val or return ();
77
78# if it's a reference, return an array unless it points to an empty array. -mls
79    if ( ref $val eq 'ARRAY' ) {
80        $^W = 0;    # turn off warnings about undef
81        return ( any(@$val) ne undef ) ? @$val : ();
82    }
83
84# if it's a string, return an array unless the string is missing or empty. -mls
85    else {
86        return ( length $val ) ? ($val) : ();
87    }
88}
89
90# Figure out whether the data is a hash reference of a param-capable object and return it has a hash
91sub get_input_as_hash {
92    my $data = shift;
93    require Scalar::Util;
94
95    # This checks whether we have an object that supports param
96    if ( Scalar::Util::blessed($data) && $data->can('param') ) {
97        my %return;
98        for my $k ( $data->param() ) {
99
100            # we expect param to return an array if there are multiple values
101            my @v;
102
103          # CGI::Simple requires us to call 'upload()' to get upload data,
104          # while CGI/Apache::Request return it on calling 'param()'.
105          #
106          # This seems quirky, but there isn't a way for us to easily check if
107          # "this field contains a file upload" or not.
108            if ( $data->isa('CGI::Simple') ) {
109                @v = $data->upload($k) || $data->param($k);
110            }
111            else {
112                @v = $data->param($k);
113            }
114
115            # we expect param to return an array if there are multiple values
116            $return{$k} = scalar(@v) > 1 ? \@v : $v[0];
117        }
118        return \%return;
119    }
120
121    # otherwise, it's already a hash reference
122    elsif ( ref $data eq 'HASH' ) {
123
124        # be careful to actually copy array references
125        my %copy = %$data;
126        for ( grep { ref $data->{$_} eq 'ARRAY' } keys %$data ) {
127            my @array_copy = @{ $data->{$_} };
128            $copy{$_} = \@array_copy;
129        }
130
131        return \%copy;
132    }
133    else {
134        die
135            "FormValidator::LazyWay->validate() or check() called with invalid input data structure.";
136    }
137}
1381;
139
140=head1 NAME
141
142FormValidator::LazyWay::Util - FormValidator::LazyWay Util functions
143
144=head1 AUTHOR
145
146Tomohiro Teranishi<tomohiro.teranishi@gmail.com>
147
148=cut
Note: See TracBrowser for help on using the browser.