File Coverage

blib/lib/Sledge/Plugin/RedirectReferer.pm
Criterion Covered Total %
statement 19 30 63.3
branch 0 6 0.0
condition n/a
subroutine 5 8 62.5
pod 0 1 0.0
total 24 45 53.3


line stmt bran cond sub pod time code
1             package Sledge::Plugin::RedirectReferer;
2 1     1   28069 use strict;
  1         2  
  1         43  
3 1     1   18 use warnings;
  1         2  
  1         31  
4 1     1   1046 use URI;
  1         7853  
  1         59  
5              
6             our $VERSION = '0.04';
7             our $LAST_URL_KEY = '_last_url';
8              
9             sub import {
10 1     1   9 my $self = shift;
11 1         2 my $pkg = caller;
12              
13 1     1   8 no strict 'refs';
  1         2  
  1         311  
14 1         7 *{"$pkg\::redirect_referer"} = sub {
15 0     0   0 my ($self , $url) = @_;
16 0 0       0 my $redirect_url = $self->session->param( $LAST_URL_KEY ) ? $self->session->param( $LAST_URL_KEY )
17             : $self->r->header_in('Referer');
18 0 0       0 if ( $redirect_url ) {
19 0         0 my $uri = URI->new($redirect_url);
20 0 0       0 if ( $uri->host eq $self->r->hostname ) {
21 0         0 return $self->redirect($uri->path_query);
22             } else {
23 0         0 return $self->redirect($uri->as_string);
24             }
25             } else {
26 0         0 return $self->redirect($url);
27             }
28 1         6 };
29              
30 1         5 *{"$pkg\::last_access_url"} = sub {
31 0     0   0 shift->session->param( $LAST_URL_KEY );
32 1         4 };
33              
34 1         34 $pkg->register_hook(
35             AFTER_OUTPUT => \&store_url,
36             );
37             }
38              
39             sub store_url {
40 0     0 0   my $self = shift;
41 0           $self->session->param( $LAST_URL_KEY => $self->current_url );
42             }
43              
44             =head1 NAME
45              
46             Sledge::Plugin::RedirectReferer - referer redirect plugin for Sledge
47              
48             =head1 VERSION
49              
50             This documentation refers to Sledge::Plugin::RedirectReferer version 0.04
51              
52             =head1 SYNOPSIS
53              
54             package Your::Pages;
55             use Sledge::Plugin::RedirectReferer;
56              
57             sub dispatch_index {
58             my $self = shift;
59             return $self->redirect_referer('/if/non/referer');
60             }
61              
62             =head1 METHODS
63              
64             =head2 redirect_referer
65              
66             This method redirect referer.
67              
68             =head2 last_access_url
69              
70             This method get your last access url.
71              
72             =head1 AUTHOR
73              
74             Atsushi Kobayashi, C<< >>
75              
76             =head1 BUGS
77              
78             Please report any bugs or feature requests to
79             C, or through the web interface at
80             L.
81             I will be notified, and then you'll automatically be notified of progress on
82             your bug as I make changes.
83              
84             =head1 SUPPORT
85              
86             You can find documentation for this module with the perldoc command.
87              
88             perldoc Sledge::Plugin::RedirectReferer
89              
90             You can also look for information at:
91              
92             =over 4
93              
94             =item * AnnoCPAN: Annotated CPAN documentation
95              
96             L
97              
98             =item * CPAN Ratings
99              
100             L
101              
102             =item * RT: CPAN's request tracker
103              
104             L
105              
106             =item * Search CPAN
107              
108             L
109              
110             =back
111              
112             =head1 ACKNOWLEDGEMENTS
113              
114             =head1 COPYRIGHT & LICENSE
115              
116             Copyright 2006 Atsushi Kobayashi, all rights reserved.
117              
118             This program is free software; you can redistribute it and/or modify it
119             under the same terms as Perl itself.
120              
121             =cut
122              
123             1
124             # End of Sledge::Plugin::RedirectReferer