File Coverage

lib/Egg/Plugin/Response/Redirect.pm
Criterion Covered Total %
statement 9 40 22.5
branch 0 10 0.0
condition 0 37 0.0
subroutine 3 7 42.8
pod 1 1 100.0
total 13 95 13.6


line stmt bran cond sub pod time code
1             package Egg::Plugin::Response::Redirect;
2             #
3             # Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
4             #
5             # $Id: Redirect.pm 337 2008-05-14 12:30:09Z lushe $
6             #
7 1     1   452 use strict;
  1         2  
  1         31  
8 1     1   5 use warnings;
  1         2  
  1         42  
9              
10             our $VERSION= '3.01';
11              
12             {
13 1     1   5 no warnings 'redefine';
  1         1  
  1         615  
14 0     0     *Egg::Response::handler::redirect_body= sub { shift->e->redirect_body(@_) };
15             };
16              
17             sub _setup {
18 0     0     my($e)= @_;
19 0   0       my $conf = $e->config->{plugin_response_redirect} ||= {};
20 0   0       my $style= $conf->{style} ||= {};
21              
22 0   0       $conf->{default_url} ||= '/';
23 0   0       $conf->{default_wait} ||= 0;
24 0   0       $conf->{default_msg} ||= 'Processing was completed.';
25              
26 0   0       $style->{body}
27             ||= q{ background:#FFEDBB; text-align:center; };
28 0   0       $style->{h1}
29             ||= q{ font:bold 20px sans-serif; margin:0px; margin-left:0px; };
30 0   0       $style->{div}
31             ||= q{ background:#FFF7ED; padding:10px; margin:50px;}
32             . q{ font:normal 12px sans-serif; border:#D15C24 solid 3px;}
33             . q{ text-align:left; };
34              
35 0           $e->next::method;
36             }
37             sub redirect_body {
38 0     0 1   my $e= shift;
39 0           $e->finished('200 OK');
40 0           $e->response->body($e->__redirect_body(@_));
41             }
42             sub __redirect_body {
43 0     0     my $e= shift;
44 0           my($res, $c)= ($e->response, $e->config);
45 0           my $cr = $c->{plugin_response_redirect};
46 0           my $style = $cr->{style};
47              
48 0   0       my $url = shift || $cr->{default_url};
49 0   0       my $msg = shift || $cr->{default_msg};
50 0 0         my $attr = $_[0] ? (ref($_[0]) ? $_[0]: {@_}): {};
    0          
51 0 0         my $wait = defined($attr->{wait}) ? $attr->{wait}: $cr->{default_wait};
52 0 0         my $onload= $attr->{onload} ? qq{ onload="$attr->{onload}"}: "";
53 0   0       my $more = $attr->{more} || "";
54 0 0         my $alert = ! $attr->{alert} ? "": <<END_SCRIPT;
55             <script type="text/javascript"><!-- //
56             window.onload= alert('${msg}');
57             // --></script>
58             END_SCRIPT
59              
60 0   0       my $body_style= $attr->{body_style} || $style->{body};
61 0   0       my $div_style = $attr->{div_style} || $style->{div};
62 0   0       my $h1_style = $attr->{h1_style} || $style->{h1};
63              
64 0   0       my $clang = $res->content_language($c->{content_language} || 'en');
65 0   0       my $ctype = $res->content_type($c->{content_type} || 'text/html');
66              
67 0           <<END_OF_HTML;
68             <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
69             "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
70             <html xmlns="http://www.w3.org/1999/xhtml" lang="${clang}">
71             <head>
72             <meta http-equiv="content-language" content="${clang}" />
73             <meta http-equiv="Content-Type" content="${ctype}" />
74             <meta http-equiv="Content-Style-Type" content="text/css" />
75             <meta http-equiv="refresh" content="${wait};url=${url}" />
76             ${alert}
77             <style type="text/css">
78             body { ${body_style} }
79             div { ${div_style} }
80             h1 { ${h1_style} }
81             </style>
82             </head>
83             <body${onload}>
84             <div>
85             <h1>${msg}</h1>
86             <a href="${url}">- Please click here when forwarding fails...</a>
87             </div>
88             ${more}
89             </body>
90             </html>
91             END_OF_HTML
92             }
93              
94             1;
95              
96             __END__
97              
98             =head1 NAME
99              
100             Egg::Plugin::Response::Redirect - Output of redirect screen etc.
101              
102             =head1 SYNOPSIS
103              
104             use Egg qw/ Response::Redirect /;
105            
106             __PACKAGE__->egg_startup(
107             plugin_redirect => {
108             default_url => '/',
109             default_wait => 0,
110             default_msg => 'Processing was completed.',
111             style => {
112             body => ' ..... ',
113             h1 => ' ..... ',
114             div => ' ..... ',
115             },
116             },
117             );
118            
119             # redirect screen is output and processing is ended.
120             $e->redirect_body('/hoge_page', 'complete ok.', alert => 1 );
121            
122             # The HTML source of redirect screen is acquired.
123             my $html= $e->redirect_body_source('/hoge_page', 'complete ok.', alert => 1 );
124              
125             =head1 DESCRIPTION
126              
127             It is a plugin that outputs the redirect screen.
128              
129             =head1 CONFIGURATION
130              
131             The configuration is done by 'plugin_redirect'.
132              
133             plugin_redirect => {
134             ........
135             ...
136             },
137              
138             =head2 default_url => [DEFAULT_URL]
139              
140             When URL at the redirect destination is unspecification, it uses it.
141              
142             Default is '/'.
143              
144             =head2 default_wait => [WAIT_TIME]
145              
146             When waiting time until redirecting is generated is unspecification, it uses it.
147              
148             Default is '0',
149              
150             =head2 default_msg => [REDIRECT_MESSAGE]
151              
152             When redirect message is unspecification, it uses it.
153              
154             Default is 'Processing was completed.'.
155              
156             =head2 style => [HASH]
157              
158             The screen style is set with HASH.
159              
160             =head3 body => [BODY_STYLE]
161              
162             The entire basic setting of screen.
163              
164             Default:
165             background : #FFEDBB;
166             text-align : center;
167              
168             =head3 h1 => [H1_STYLE]
169              
170             Style of E<lt>h1E<gt>.
171              
172             Default:
173             font : bold 20px sans-serif;
174             margin : 0px;
175             margin-left : 0px;'.
176              
177             =head3 div => [DIV_STYLE]
178              
179             Style of E<lt>divE<gt>.
180              
181             Default:
182             background : #FFF7ED;
183             padding : 10px;
184             margin : 50px;
185             font : normal 12px sans-serif;
186             border : #D15C24 solid 3px;
187             text-align : left;
188              
189             =head1 METHODS
190              
191             =head2 redirect_body_source ( [URL], [MESSAGE], [OPTION_HASH] )
192              
193             The HTML source of redirect screen is returned.
194              
195             When URL is unspecification, 'default_url' of the configuration is used.
196              
197             When MESSAGE is unspecification, 'defautl_msg' of the configuration is used.
198              
199             The following options are accepted with OPTION_HASH.
200              
201             =head3 wait => [WAIT_TIME]
202              
203             Waiting time until redirecting is generated.
204              
205             'default_wait' of the configuration is used at the unspecification.
206              
207             $e->redirect_body_source(0, 0, wait => 1 );
208              
209             =head3 alert => [BOOL]
210              
211             When the screen is displayed, the alert of the JAVA script is generated.
212              
213             MESSAGE is displayed in this alert.
214              
215             $e->redirect_body_source(0, 0, alert => 1 );
216              
217             =head3 onload_func => [ONLOAD_FUNCTION]
218              
219             Onload is added to E<lt>bodyE<gt> when given.
220              
221             $e->redirect_body_source(0, 0, onload_func => 'onload_script()' );
222              
223             =head3 body_style => [STYLE]
224              
225             style->{body} of the configuration is used when omitting it.
226              
227             =head3 h1_style => [STYLE]
228              
229             style->{h1} of the configuration is used when omitting it.
230              
231             =head3 div_style => [STYLE]
232              
233             style->{div} of the configuration is used when omitting it.
234              
235             =head2 redirect_body ( [URL], [MESSAGE], [OPTION_HASH] )
236              
237             $e-E<gt>response-E<gt>redirect is setup.
238              
239             And, the return value of 'redirect_body_source' method is set in $e-E<gt>response-E<gt>body.
240              
241             The argument extends to 'redirect_body_source' method as it is.
242              
243             =head1 SEE ALSO
244              
245             L<Egg::Release>,
246             L<Egg::Response>,
247              
248             =head1 AUTHOR
249              
250             Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
251              
252             =head1 COPYRIGHT AND LICENSE
253              
254             Copyright (C) 2008 Bee Flag, Corp. E<lt>L<http://egg.bomcity.com/>E<gt>.
255              
256             This library is free software; you can redistribute it and/or modify
257             it under the same terms as Perl itself, either Perl version 5.8.6 or,
258             at your option, any later version of Perl 5 you may have available.
259              
260             =cut
261