| 1 | package FormValidator::LazyWay::Utils; |
|---|
| 2 | |
|---|
| 3 | use strict; |
|---|
| 4 | use warnings; |
|---|
| 5 | use Scalar::Util; |
|---|
| 6 | use Perl6::Junction qw/any/; |
|---|
| 7 | |
|---|
| 8 | sub 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 | |
|---|
| 44 | sub 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 | |
|---|
| 72 | sub 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 |
|---|
| 91 | sub 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 | } |
|---|
| 138 | 1; |
|---|
| 139 | |
|---|
| 140 | =head1 NAME |
|---|
| 141 | |
|---|
| 142 | FormValidator::LazyWay::Util - FormValidator::LazyWay Util functions |
|---|
| 143 | |
|---|
| 144 | =head1 AUTHOR |
|---|
| 145 | |
|---|
| 146 | Tomohiro Teranishi<tomohiro.teranishi@gmail.com> |
|---|
| 147 | |
|---|
| 148 | =cut |
|---|