File Coverage

blib/lib/Dancer2/Plugin/Negotiate.pm

Criterion	Covered	Total	%
statement	48	50	96.0
branch	18	26	69.2
condition	4	7	57.1
subroutine	9	10	90.0
pod			n/a
total	79	93	84.9

use strict;
use warnings;

package Dancer2::Plugin::Negotiate;

# ABSTRACT: Content negotiation plugin for Dancer2

use Dancer2::Plugin;

use HTTP::Negotiate;

our $VERSION = '0.001';    # VERSION

sub choose_variant {
    my $dsl      = shift;
    my $app      = $dsl->app;
    my $variants = [];
    while ( my ( $variant, $options ) = ( shift, shift ) ) {
        last unless defined $variant and defined $options;
        push @$variants => [
            $variant,             $options->{Quality}, $options->{Type},
            $options->{Encoding}, $options->{Charset}, $options->{Language},
            $options->{Size}
        ];
    }
    HTTP::Negotiate::choose( $variants, $app->request->headers, );
}

sub apply_variant {
    my ( $dsl, %variants ) = @_;
    my $app     = $dsl->app;
    my $variant = scalar choose_variant(@_);
    return unless defined $variant;
    my %options = %{ $variants{$variant} };
    my $R       = $app->response;
    $R->header( 'Content-Type' => $options{Type} ) if defined $options{Type};
    $R->header( 'Content-Encoding' => $options{Encoding} )
      if defined $options{Encoding};
    $R->header( 'Content-Charset' => $options{Charset} )
      if defined $options{Charset};
    $R->header( 'Content-Language' => $options{Language} )
      if defined $options{Language};
    $variant;
}

sub _langmap {
    my $grep = shift || sub { 1 };
    my $langs = plugin_setting->{languages} || {};
    return grep defined, map {
        my $opt = {
            Language => scalar( ref $_ eq 'HASH' ? ( keys %$_ )[0]   : $_ ),
            Quality  => scalar( ref $_ eq 'HASH' ? ( values %$_ )[0] : 1 )
        };
        my $id = lc $opt->{Language};
        $grep->($opt) ? ( $id => $opt ) : undef;
    } @$langs;
}

sub negotiate {
    my ( $dsl, $tplname, @rest ) = @_;
    my $app     = $dsl->app;
    my $engine  = $app->engine('template');
    my @langmap = _langmap(
        sub {
            my $lang = shift->{Language};
            my $view = $engine->view_pathname( $tplname . '.' . $lang );
            defined $view and -e $view ? 1 : 0;
        }
    );
    my $lang = apply_variant( $dsl, 0, {}, @langmap );
    $tplname .= '.' . $lang if $lang;
    if (wantarray) {
        return ( $tplname, @rest );
    }
    else {
        return $tplname;
    }
}

register
  choose_variant => \&choose_variant,
  { is_global => 0 };
register
  apply_variant => \&apply_variant,
  { is_global => 0 };
register
  negotiate => \&negotiate,
  { is_global => 0 };

register_plugin;

1;

__END__