view release on metacpan or  search on metacpan

inc/Params/Check.pm  view on Meta::CPAN

    while (@atmpl) {
        
        my $key = shift @atmpl;
        my $href = shift @atmpl;
        
        push @positions, $key;
        $tmpl{_convert_case($key)} = $href;
        
        for ( @{ $href->{synonyms} || [] } ) {
            $synonyms{ _convert_case($_) } = $key;
        };
        
        undef $href->{synonyms};
    };
    return (\%tmpl, \@positions, \%synonyms);
}

### Canonicalise key (lowercase, and strip leading dashes if desired) ###
sub _canon_key {
    my $key = _convert_case( +shift );
    $key =~ s/^-// if $STRIP_LEADING_DASHES;
    return $key;
}


### check if the $key is required, and if so, whether it's in $args ###
sub _hasreq {
    my ($key, $tmpl, $args ) = @_;
    my $reqs = _listreqs($tmpl);

    return $reqs->{$key}
            ? exists $args->{$key}
                ? 1
                : undef
            : 1;
}

### Return a hash of $tmpl keys with default values => defaults
### make sure to even include undefined ones, so that 'exists' will dwym
sub _hashdefs {
    my $tmpl = shift;

    my %hash =  map {
                    $_ => defined $tmpl->{$_}->{default}
                                ? $tmpl->{$_}->{default}
                                : undef
                } keys %$tmpl;

    return \%hash;
}

### check if the key exists in $data ###
sub _iskey {
    my ($key, $tmpl) = @_;
    return $tmpl->{$key} ? 1 : undef;
}

sub _who_was_it {
    my $level = shift || 0;

    return (caller(2 + $level))[3] || 'ANON'
}

sub _safe_eq {
    my($a, $b) = @_;

    if ( defined($a) && defined($b) ) {
        return $a eq $b;
    }
    else {
        return defined($a) eq defined($b);
    }
}

sub _sanity_check {
    my $tmpl = shift;
    my $rv = {};
    
    while( my($key,$href) = each %$tmpl ) {
        for my $type ( keys %$href ) {
            unless( grep { $type eq $_ } @known_keys ) {
                _store_error(
                    loc(q|Template type '%1' not supported [at key '%2']|, $type, $key), 1, 1
                );     
            }               
        }
        $rv->{_convert_case($key)} = $href;
    }
    return $rv;
}    

sub _convert_case {
    my $key = shift;
    
    return $PRESERVE_CASE ? $key : lc $key;
}

{   my $ErrorString = '';

    sub _store_error {
        my $err     = shift;
        my $verbose = shift || 0;
        my $offset  = shift || 0;
        my $level   = 1 + $offset;
    
        local $Carp::CarpLevel = $level;
        
        carp $err if $verbose;
        
        $ErrorString .= $err . "\n";
    }
    
    sub _clear_error {
        $ErrorString = '';
    }
    
    sub last_error { $ErrorString }    
}

1;