File Coverage

blib/lib/Dancer/Plugin/Deferred.pm

Criterion	Covered	Total	%
statement	24	52	46.1
branch	0	8	0.0
condition	0	19	0.0
subroutine	8	13	61.5
pod			n/a
total	32	92	34.7

use 5.008001;
use strict;
use warnings;

package Dancer::Plugin::Deferred;
# ABSTRACT: Defer messages or data across redirections
our $VERSION = '0.003'; # VERSION

use Carp qw/croak/;
use URI;
use URI::QueryParam;

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

my $conf;

register 'deferred' => sub {
  my ( $self, $key, $value ) = plugin_args(@_);
  $conf ||= _get_conf();

  my $id = _get_id();

  # message data is flat "dpd_$id" to avoid race condition with
  # another session
  my $data = session( $conf->{session_key_prefix} . $id ) || {};

  # set value or destructively retrieve it
  if ( defined $value ) {
    $data->{$key} = $value;
  }
  else {
    $value = var( $conf->{var_keep_key} ) ? $data->{$key} : delete $data->{$key};
  }

  # store remaining data or clear it if no deferred messages are left
  if ( keys %$data ) {
    session $conf->{session_key_prefix} . $id => $data;
    var $conf->{var_key}                      => $id;
  }
  else {
    session $conf->{session_key_prefix} . $id => undef;
    var $conf->{var_key}                      => undef;
  }

  return $value;
};

# destructively return all keys
register 'all_deferred' => \&_get_all_deferred;

sub _get_all_deferred {
  $conf ||= _get_conf();
  my $id = _get_id();
  my $data = session( $conf->{session_key_prefix} . $id ) || {};
  unless ( var $conf->{var_keep_key} ) {
    session $conf->{session_key_prefix} . $id => undef;
    var $conf->{var_key}                      => undef;
  }
  return $data;
}

register 'deferred_param' => \&_get_deferred_param;

sub _get_deferred_param {
  my ($arg) = @_;
  $conf ||= _get_conf();
  var $conf->{var_keep_key} => 1;
  return ( $conf->{params_key} => var $conf->{var_key} );
}

hook 'before_template' => sub {
  my $data = shift;
  $conf ||= _get_conf();
  $data->{ $conf->{template_key} } = _get_all_deferred();
};

hook 'before' => sub {
  $conf ||= _get_conf();
  my $id = params->{ $conf->{params_key} };
  var( $conf->{var_key} => $id )
    if $id;
};

hook 'after' => sub {
  my $response = shift;
  $conf ||= _get_conf();
  if ( var( $conf->{var_key} ) && $response->status =~ /^3/ ) {
    my $u = URI->new( $response->header("Location") );
    $u->query_param( _get_deferred_param() );
    $response->header( "Location" => $u );
  }
};

# not crypto strong, but will be stored in session, which should be
sub _get_id {
  $conf ||= _get_conf();
  return var( $conf->{var_key} )
    || sprintf( "%08d", int( rand(100_000_000) ) );
}

sub _get_conf {
  return {
    var_key            => 'dpdid',
    var_keep_key       => 'dpd_keep',
    params_key         => 'dpdid',
    session_key_prefix => 'dpd_',
    template_key       => 'deferred',
    %{ plugin_setting() },
  };
}

register_plugin for_versions => [ 1, 2 ];

1;


# vim: ts=2 sts=2 sw=2 et:

__END__