File Coverage

blib/lib/FormValidator/LazyWay/Utils.pm

Criterion	Covered	Total	%
statement	61	67	91.0
branch	28	36	77.7
condition	10	18	55.5
subroutine	8	8	100.0
pod	0	4	0.0
total	107	133	80.4

package FormValidator::LazyWay::Utils;

use strict;
use warnings;
use Scalar::Util;
use Perl6::Junction qw/any/;

sub check_profile_syntax {
    my $profile = shift;

    ( ref $profile eq 'HASH' )
        or die "Invalid input profile: needs to be a hash reference\n";

    my @invalid;
    {
        my @valid_profile_keys = (
            qw/
                required
                optional
                defaults
                want_array
                stash
                lang
                level
                dependency_groups
                dependencies
                use_fixed_method
                /
        );

        for my $key ( keys %$profile ) {
            next if $key =~ m/^use_/;
            push @invalid, $key unless ( $key eq any(@valid_profile_keys) );
        }

        local $" = ', ';
        if (@invalid) {
            die "Invalid input profile: keys not recognised [@invalid]\n";
        }
    }

    return 1;
}

sub remove_empty_fields {
    my $valid = shift;

    for my $field ( keys %{$valid} ) {
        if ( ref $valid->{$field} ) {
            next if ref $valid->{$field} ne 'ARRAY';
            for ( my $i = 0; $i < scalar @{ $valid->{$field} }; $i++ ) {
                $valid->{$field}->[$i] = undef
                    unless ( defined $valid->{$field}->[$i]
                    and length $valid->{$field}->[$i]
                    and $valid->{$field}->[$i] !~ /^\x00$/ );
            }

            my @tmp_valid = ();
            for my $item( @{ $valid->{$field} } ) {
                push @tmp_valid , $item if defined $item;
            }
            $valid->{$field} = \@tmp_valid;

            # If all fields are empty, we delete it.
            delete $valid->{$field}
                unless grep { defined $_ } @{ $valid->{$field} };
        }
        else {
            delete $valid->{$field}
                unless ( defined $valid->{$field}
                and length $valid->{$field}
                and $valid->{$field} !~ /^\x00$/ );
        }
    }

    $valid;
}

sub arrayify {

    # if the input is undefined, return an empty list
    my $val = shift;
    defined $val or return ();

# if it's a reference, return an array unless it points to an empty array. -mls
    if ( ref $val eq 'ARRAY' ) {
        $^W = 0;    # turn off warnings about undef
        return ( any(@$val) ne undef ) ? @$val : ();
    }

# if it's a string, return an array unless the string is missing or empty. -mls
    else {
        return ( length $val ) ? ($val) : ();
    }
}

# Figure out whether the data is a hash reference of a param-capable object and return it has a hash
sub get_input_as_hash {
    my $data = shift;
    require Scalar::Util;

    # This checks whether we have an object that supports param
    if ( Scalar::Util::blessed($data) && $data->can('param') ) {
        my %return;
        for my $k ( $data->param() ) {

            # we expect param to return an array if there are multiple values
            my @v;

          # CGI::Simple requires us to call 'upload()' to get upload data,
          # while CGI/Apache::Request return it on calling 'param()'.
          #
          # This seems quirky, but there isn't a way for us to easily check if
          # "this field contains a file upload" or not.
            if ( $data->isa('CGI::Simple') ) {
                @v = $data->upload($k) || $data->param($k);
            }
            else {
                @v = $data->param($k);
            }

            # we expect param to return an array if there are multiple values
            $return{$k} = scalar(@v) > 1 ? \@v : $v[0];
        }
        return \%return;
    }

    # otherwise, it's already a hash reference
    elsif ( ref $data eq 'HASH' ) {

        # be careful to actually copy array references
        my %copy = %$data;
        for ( grep { ref $data->{$_} eq 'ARRAY' } keys %$data ) {
            my @array_copy = @{ $data->{$_} };
            $copy{$_} = \@array_copy;
        }

        return \%copy;
    }
    else {
        die
            "FormValidator::LazyWay->validate() or check() called with invalid input data structure.";
    }
}
1;

=head1 NAME

FormValidator::LazyWay::Util - FormValidator::LazyWay Util functions

=head1 AUTHOR

Tomohiro Teranishi

=cut