File Coverage

blib/lib/Catalyst/ActionRole/NoSSL.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package Catalyst::ActionRole::NoSSL;
2              
3 1     1   1845 use Moose::Role;
  0            
  0            
4             with 'Catalyst::ActionRole::RequireSSL::Role';
5             use namespace::autoclean;
6             our $VERSION = '0.07';
7              
8             =head1 NAME
9              
10             Catalyst::ActionRole::NoSSL - Force an action to be plain.
11              
12             =head1 VERSION
13              
14             version 0.07
15              
16             =head1 SYNOPSIS
17              
18             package MyApp::Controller::Foo;
19              
20             use parent qw/Catalyst::Controller::ActionRole/;
21              
22             sub bar : Local Does('RequireSSL') { ... }
23             sub bar : Local Does('NoSSL') { ... }
24            
25             =cut
26              
27             around execute => sub {
28             my $orig = shift;
29             my $self = shift;
30             my ($controller, $c) = @_;
31              
32             if($c->req->secure && $self->check_chain($c) &&
33             ( $c->req->method ne "POST" ||
34             $c->config->{require_ssl}->{ignore_on_post} )) {
35             my $uri = $c->req->uri->clone;
36             $uri->scheme('http');
37             $c->res->redirect( $uri );
38             $c->detach();
39             } else {
40             $self->$orig( @_ );
41             }
42             };
43              
44             1;
45              
46             =head1 AUTHOR
47              
48             Simon Elliott <cpan@papercreatures.com>
49              
50             =head1 THANKS
51              
52             Andy Grundman, <andy@hybridized.org> for the original RequireSSL Plugin
53              
54             t0m (Tomas Doran), zamolxes (Bogdan Lucaciu)
55              
56             =head1 COPYRIGHT & LICENSE
57              
58             Copyright 2009 by Simon Elliott
59              
60             This program is free software; you can redistribute it and/or modify it under
61             the same terms as Perl itself.