File Coverage

lib/Egg/Plugin/Mason.pm
Criterion Covered Total %
statement 12 41 29.2
branch 0 18 0.0
condition 0 20 0.0
subroutine 4 12 33.3
pod 1 1 100.0
total 17 92 18.4


line stmt bran cond sub pod time code
1             package Egg::Plugin::Mason;
2             #
3             # Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
4             #
5             # $Id: Mason.pm 337 2008-05-14 12:30:09Z lushe $
6             #
7 1     1   546 use strict;
  1         3  
  1         45  
8 1     1   5 use warnings;
  1         4  
  1         101  
9              
10             our $VERSION= '3.01';
11              
12             sub mason {
13 0   0 0 1   $_[0]->{mason} ||= Egg::Plugin::Mason::handler->new(@_);
14             }
15              
16             package Egg::Plugin::Mason::handler;
17 1     1   22 use strict;
  1         3  
  1         31  
18 1     1   6 use base qw/ Egg::Base /;
  1         2  
  1         541  
19              
20             __PACKAGE__->mk_accessors(qw/
21             attr code_first code_action code_final is_error
22             is_complete complete_topic complete_info
23             /);
24              
25             sub prepare {
26 0     0     my $ms= shift;
27 0 0         my $attr= $_[0] ? ($_[1] ? {@_}: $_[0]): {};
    0          
28 0           my $e= $ms->e;
29 0 0         $e->page_title($attr->{page_title}) if $attr->{page_title};
30 0 0         $e->response->no_cache(1) if $attr->{no_cache};
31 0 0         if (my $expir= $attr->{expires}) {
32 0           $e->response->is_expires($expir);
33 0           $e->response->last_modified($expir);
34             }
35 0 0         if (my $dbname= $attr->{commit_ok}) {
36 0 0         $e->dbh($dbname eq '1' ? undef: $dbname)->commit_ok(1);
37             }
38 0   0 0     $ms->{code_first} = $attr->{code_first} || sub { 0 };
  0            
39 0   0 0     $ms->{code_action}= $attr->{code_action} || sub { 0 };
  0            
40 0   0 0     $ms->{code_final} = $attr->{code_final} || sub { 0 };
  0            
41 0           $ms->{attr}= $attr;
42 0           $ms;
43             }
44             sub exec {
45 0 0 0 0     $_[0]->code_first->() || $_[0]->code_action->() || $_[0]->code_final->();
46             }
47             sub complete {
48 0     0     my $ms= shift;
49 0   0       $ms->{complete_topic}= shift || q{Complete !!};
50 0   0       $ms->{complete_info}= shift
51             || q{<p class="info"><a href="/">Please click.</p>};
52 0           $ms->{is_complete}= 1;
53             }
54             sub error_complete {
55 0     0     my $ms= shift;
56 0   0       $ms->{complete_topic}= shift || q{Sorry !!};
57 0   0       $ms->{complete_info} = shift
58             || q{<p class="info"><a href="/">Please click.</p>};
59 0           $ms->{is_error}= 1;
60 0 0         shift || 0;
61             }
62              
63             1;
64              
65             __END__
66              
67             =head1 NAME
68              
69             Egg::Plugin::Mason - Plugin for Egg::View::Mason
70              
71             =head1 SYNOPSIS
72              
73             package MyApp;
74             use Egg qw/
75             Mason
76             Net::Scan
77             MailSend
78             FillInForm
79             /;
80              
81             Example template
82              
83             <%init>
84             my $ms= $e->mason->prepare(
85             page_title => 'Hoge',
86             no_cache => 1,
87             commit_ok => 1,
88             );
89             $ms->code_first(sub {
90             my $scan= $e->port_scan(qw/ 192.168.1.1 25 /);
91             return 0 if $scan->is_success;
92             $ms->complete('Mail host is stopping.');
93             });
94             $ms->code_action(sub {
95             $e->referer_check(1) || return 0;
96             ............
97             ....
98             $e->mail->send;
99             $ms->complete('Mail was sent.');
100             });
101             $ms->code_final(sub {
102             $e->fillin_ok(1);
103             });
104             $ms->exec;
105             </%init>
106             %
107             <html>
108             <body>
109             % if ($ms->is_complete) {
110             <h1><% $ms->complete_topic %></h1>
111             % } else {
112             <form method="POST" action= ...... >
113             .........
114             ....
115             </form>
116             % } # $ms->complete end.
117             </body>
118             </html>
119              
120             =head1 DESCRIPTION
121              
122             It is a plugin convenient when using it with the template of L<HTML::Mason>.
123              
124             First of all, a basic setting is done by the prepare method.
125              
126             And, the code reference defined to 'code_first', 'code_action', 'code_final' as
127             call the exec method is evaluated and processing is completed.
128              
129             =head1 METHODS
130              
131             =head2 mason
132              
133             Egg::Plugin::Mason::handler ¥ª¥Ö¥¸¥§¥¯¥È¤òÊÖ¤·¤Þ¤¹¡£
134              
135             =head1 HANDLER METHODS
136              
137             L<Egg::Base> has been succeeded to.
138              
139             =head2 prepare ([ATTR_HASH])
140              
141             Prior is set.
142              
143             As for ATTR_HASH, the following keys are accepted.
144              
145             my $ms= $e->mason->prepare(
146             page_title => 'home page',
147             expires => '+1D',
148             );
149              
150             =over 4
151              
152             =item * page_title
153              
154             It is a character string set to $e-E<gt>page_title.
155              
156             =item * no_cache
157              
158             $e-E<gt>response-E<gt>no_cache is set.
159              
160             =item * expires
161              
162             $e-E<gt>response-E<gt>is_expires and $e-E<gt>response-E<gt>last_modified are set.
163              
164             =item * commit_ok
165              
166             $e-E<gt>dbh-E<gt>commit_ok is done.
167              
168             Only being able to use L<Egg::Model::DBI> is effective.
169              
170             =item * code_first, code_action, code_final
171              
172             The code reference processed with exec is set.
173              
174             =back
175              
176             =head2 exec
177              
178             The code of code_first, code_action, and code_final set beforehand is processed.
179              
180             When undefined is returned, each code interrupts processing by the code.
181              
182             $e->exec;
183              
184             =head2 code_first, code_action, code_final
185              
186             Accessor to code reference to process it with exec.
187              
188             =head2 complete ([TOPIC_STR], [INFO_STR])
189              
190             The completion message etc. are set and '1' is returned.
191              
192             The default when TOPIC_STR is not obtained is 'Complete !!'.
193              
194             The default when INFO_STR is not obtained is
195             'E<lt>p class="info"E<gt>E<lt>a href="/"E<gt>Please click.E<lt>/pE<gt>'.
196              
197             $e->complete('is completed', <<END_INFO);
198             <a href="/">It returns to top page.</a>
199             END_INFO
200              
201             =head2 error_complete ([TOPIC_STR], [INFO_STR])
202              
203             The completion message etc. are set and 0 is returned.
204              
205             The default when TOPIC_STR is not obtained is 'Sorry !!'.
206              
207             Default when INFO_STR is not obtained is
208             'E<lt>p class =" info "E<gt>E<lt>a href ="/"E<gt>Please click.E<lt>/pE<gt>'.
209              
210             my $data= $e->get_data || return $e->error_complete('is error.', <<END_INFO);
211             <h2>The error occurred.</h2>
212             <p><a href="/">It returns to top page.</a></p>
213             END_INFO
214              
215             =head2 is_complete
216              
217             If 'complete' method is called, it becomes effective.
218              
219             =head2 is_error
220              
221             If 'error_complete' method is called, it becomes effective.
222              
223             =head2 complete_topic
224              
225             The first argument of 'complete' method or 'error_complete' method is set.
226              
227             =head2 complete_info
228              
229             The second argument of 'complete' method or 'error_complete' method is set.
230              
231             =head1 SEE ALSO
232              
233             L<Egg::Release>,
234             L<Egg::Base>,
235             L<HTML::Mason>,
236              
237             =head1 AUTHOR
238              
239             Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
240              
241             =head1 COPYRIGHT AND LICENSE
242              
243             Copyright (C) 2008 Bee Flag, Corp. E<lt>L<http://egg.bomcity.com/>E<gt>.
244              
245             This library is free software; you can redistribute it and/or modify
246             it under the same terms as Perl itself, either Perl version 5.8.6 or,
247             at your option, any later version of Perl 5 you may have available.
248              
249             =cut
250