File Coverage

blib/lib/Dancer/Plugin/Params/Normalization.pm

Criterion	Covered	Total	%
statement	7	7	100.0
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	10	100.0

#
# This file is part of Dancer-Plugin-Params-Normalization
#
# This software is copyright (c) 2011 by Damien "dams" Krotkine.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
package Dancer::Plugin::Params::Normalization;
{
  $Dancer::Plugin::Params::Normalization::VERSION = '0.52';
}

# ABSTRACT: A plugin for normalizing query parameters in Dancer

use Dancer ':syntax';
use Dancer::Plugin;

my $conf = plugin_setting;

# method that does nothing. It's optimized to nothing at compile time
my $void = sub(){};

# set the params_filter
my $params_filter = sub () { 1; };
if (defined $conf->{params_filter}) {
    my $re = $conf->{params_filter};
    $params_filter = sub {
        return scalar($_[0] =~ /$re/) };
}

# method that loops on a hashref and apply a given method on its keys
my $apply_on_keys = sub {
    my ($h, $func) = @_;
    my $new_h = {};
    while (my ($k, $v) = each (%$h)) {
        my $new_k = $params_filter->($k) ? $func->($k) : $k;
        exists $new_h->{$new_k} && ! ($conf->{no_conflict_warn} || 0)
          and warn "paramater names conflict while doing normalization of parameters '$k' : it produces '$new_k', which alreay exists.";
        $new_h->{$new_k} = $v;
    }
    return $new_h;
};


# default normalization method is passthrough (do nothing)
my $normalization_fonction = $void;
if (defined $conf->{method} && $conf->{method} ne 'passthrough') {
	my $method;
    if      ($conf->{method} eq 'lowercase') {
        $method = sub { my ($h) = @_; $apply_on_keys->($h, sub { lc($_[0]) } ) };
    } elsif ($conf->{method} eq 'uppercase') {
        $method = sub { my ($h) = @_; $apply_on_keys->($h, sub { uc($_[0]) } ) };
    } elsif ($conf->{method} eq 'ucfirst') {
        $method = sub { my ($h) = @_; $apply_on_keys->($h, sub { ucfirst($_[0]) } ) };
    } else {
        my $class = $conf->{method};
        my $class_name = $class;
        $class_name =~ s!::|'!/!g;
        $class_name .= '.pm';
        if ( ! $class->can('new') ) {
            eval { require $class_name };
            $@ and die "error while requiring custom normalization class '$class' : $@";
        }
        my $abstract_classname = __PACKAGE__ . '::Abstract';
        $class->isa(__PACKAGE__ . '::Abstract')
          or die "custom normalization class '$class' doesn't inherit from '$abstract_classname'";
        my $instance = $class->new();
        # using a custom normalization is incompatible with params filters
        defined $conf->{params_filter}
          and die "your configuration contains a 'params_filter' fields, and a custom 'method' normalization class name. The two fields are incompatible";
        # todo : use *method = \&{$class->normalize} or somethin'
        $method = sub { $instance->normalize($_[0]) };
    }

    my $params_types = $conf->{params_types};
    # default value
    defined $params_types
      or $params_types = [ qw(query body) ];
    ref $params_types eq 'ARRAY'
      or die "configuration field 'params_types' should be an array";

    my %params_types = map { $_ => 1 } @$params_types;
    my $params_type_query = delete $params_types{query};
    my $params_type_body = delete $params_types{body};
    my $params_type_route = delete $params_types{route};
    keys %params_types
      and die "your configuration contains '" . join(', ', keys %params_types) .
        "' as 'params_types' field(s), but only these are allowed : 'query', 'body', 'route'";

    $normalization_fonction = sub {
        my ($new_query_params,
            $new_body_params,
            $new_route_params) = map { scalar(params($_)) } qw(query body route);
        $params_type_query and $new_query_params = $method->($new_query_params);
        $params_type_body and $new_body_params = $method->($new_body_params);
        $params_type_route and $new_route_params = $method->($new_route_params);

        request->{params} = {};

        request->_set_query_params($new_query_params);
        request->_set_body_params($new_body_params);
        request->_set_route_params($new_route_params);
    };
}

if (defined $conf->{general_rule}) {
    $conf->{general_rule} =~ /^always$|^ondemand$/
      or die 'configuration field general_rule must be one of : always, ondemand';
    if ($conf->{general_rule} eq 'ondemand') {
        register normalize => sub{ $normalization_fonction->() };
    } else {
        hook before => $normalization_fonction;
    }
} else {
    hook before => $normalization_fonction;
}

register_plugin;

1;

__END__