File Coverage

blib/lib/Egg/View/Mail/Base.pm
Criterion Covered Total %
statement 12 12 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 16 16 100.0


line stmt bran cond sub pod time code
1             package Egg::View::Mail::Base;
2             #
3             # Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
4             #
5             # $Id: Base.pm 328 2008-04-17 13:16:47Z lushe $
6             #
7 2     2   696 use strict;
  2         4  
  2         74  
8 2     2   9 use warnings;
  2         6  
  2         58  
9 2     2   12 use Carp qw/ croak /;
  2         3  
  2         150  
10 2     2   11 use base qw/ Egg::Base Egg::Component /;
  2         83  
  2         1778  
11              
12             our $VERSION = '0.03';
13              
14             sub setup_plugin {
15             my $class= shift;
16             $class->isa_register(1, "Egg::View::Mail::Plugin::$_")
17             for (ref($_[0]) eq 'ARRAY' ? @{$_[0]}: @_);
18             $class->isa_terminator(__PACKAGE__);
19             $class;
20             }
21             sub setup_mailer {
22             my $class = shift;
23             my $m_name= shift || croak q{I want mailer name.};
24             my @comps;
25             if (@_) { push @comps, $_ for (ref($_[0]) eq 'ARRAY' ? @{$_[0]}: @_) }
26             $class->isa_register
27             (1, $_, "Egg::View::Mail::$_") for (@comps, "Mailer::$m_name");
28             $class->isa_terminator(__PACKAGE__);
29             $class;
30             }
31             sub setup_template {
32             my $class = shift;
33             my $view_name= shift || croak q{I want view name.};
34             my $template = shift || "";
35             $class->mk_classdata('default_template');
36             $class->default_template($template);
37             no strict 'refs'; ## no critic.
38             no warnings 'redefine';
39             *{"${class}::___view"}=
40             sub { $_[0]->{___view} ||= $_[0]->e->view($view_name) };
41             $class;
42             }
43             sub send {
44             my $self= shift;
45             $self->mail_send( $self->create_mail_data(@_) );
46             }
47             sub create_mail_data {
48             my $self= shift;
49             my $data= { %{$self->config},
50             %{ $_[0] ? ($_[1] ? {@_}: $_[0]) : croak q{I want mail data.} },
51             };
52             $data->{body}= $self->create_mail_body($data);
53             $data;
54             }
55             sub create_mail_body {
56             my($self, $data)= @_;
57             \<<END_BODY;
58             @{[ $self->create_mail_header($data) ]}
59             @{[ ${$self->__get_mailbody($data)} ]}
60             END_BODY
61             }
62             sub create_mail_header {
63             my($self, $data)= @_;
64             <<END_HEADER;
65             Content-Type: text/plain
66             To: $data->{to}
67             From: $data->{from}
68             Subject: $data->{subject}
69             X-Mailer: $data->{x_mailer}
70             END_HEADER
71             }
72             sub __init_mailbody {
73             my($self, $data)= @_;
74             return ($data->{template} or ! $data->{body}) ? do {
75             $self->can('___view')
76             || croak q{I want setup of 'setup_template' method.};
77             my $param= { %{$self->config}, %$data };
78             my $tmpl = $data->{template} || $self->default_template
79             || croak q{I want 'template'.};
80             my $view= $self->___view;
81             @{$view->params}{keys %$param}= values %$param;
82             $view->render($tmpl);
83             }: do {
84             ref($data->{body}) eq 'ARRAY' ? \join "\n\n", @{$data->{body}}
85             : ref($data->{body}) eq 'SCALAR' ? $data->{body} : \$data->{body};
86             };
87             }
88             *__get_mailbody= \&__init_mailbody;
89              
90             1;
91              
92             __END__
93              
94             =head1 NAME
95              
96             Egg::View::Mail::Base - Base class for MAIL controller.
97              
98             =head1 SYNOPSIS
99              
100             package MyApp::View::Mail::MyController;
101             use base qw/ Egg::View::Mail::Base /;
102            
103             __PACKAGE__->config( ...... );
104            
105             __PACKAGE__->setup_mailer( SMTP => qw/ MIME::Entity / );
106              
107             =head1 DESCRIPTION
108              
109             It is a base class to succeed to from the MAIL controller who generates it in
110             the helper script.
111              
112             see L<Egg::Helper::View::Mail>.
113              
114             =head1 METHODS
115              
116             In addition, L<Egg::Base> and L<Egg::Component> have been succeeded to.
117              
118             =head2 setup_plugin ([PLUGIN_LIST])
119              
120             It is made to use by building the plug-in into the MAIL controller.
121             The name that omits the part of 'Egg::View::Mail::Plugin' is passed to PLUGIN_LIST
122             by the list.
123              
124             __PACKAGE__->setup_plugin(qw/
125             PortCheck
126             Signature
127             /);
128              
129             There is a thing that the competition of the method is generated by the built-in
130             order, it doesn't operate normally, and the result of the expectation is not
131             obtained. Please adjust the built-in order to solve it.
132              
133             =head2 setup_mailer ([MAILER_NAME] => [COMP_LIST])
134              
135             The component that does processing that actually transmits mail is built in.
136              
137             L<Egg::View::Mail::Mailer::CMD> and L<Egg::View::Mail::Mailer::SMTP> are included
138             in this package.
139              
140             The name that omits the part of 'Egg::View::Mail::Mailer' to MAILER_NAME is passed.
141              
142             __PACKAGE__->setup_mailer('SMTP');
143              
144             In addition, other components can be specified for COMP_LIST if necessary.
145             Please pass the name that omits the part of 'Egg::View::Mail' by the list.
146              
147             __PACKAGE__->setup_mailer( CMD => qw/
148             MIME::Entity
149             Encode::ISO2022JP
150             / );
151              
152             There is a thing that the competition of the method is generated by the
153             component as well as 'setup_plugin'.
154              
155             =head2 setup_template ( [VIEW_LABEL] => [DEFAULT_TEMPLATE] )
156              
157             When the content of mail is generated with a template, the template used by the
158             template engine and default is set.
159              
160             __PACKAGE__->setup_template( Mason => 'mail/text.tt' );
161              
162             The argument and the configuration passed to 'send' method are set in the
163             parameter of the template engine. It is possible to access it by '$p' from
164             among the template engine.
165              
166             To Address : <% $p->{to} %>
167             From Address : <% $p->{from} %>
168              
169             =head2 send ([MAIL_DATA_HASH])
170              
171             It prepares, and transmit mail processing is passed to 'mail_send' method of
172             Mailer system component.
173              
174             MAIL_DATA_HASH overwrites the configuration.
175              
176             Therefore, the item that can be specified becomes it as well as the
177             configuration.
178              
179             'body' or 'template' is always necessary.
180             However, this is not necessary if the template of default is set by 'setup_template'
181             either.
182              
183             $mail->send( body => <<END_BODY );
184             Will the movie go to see ?
185             END_BODY
186            
187             Or
188            
189             $mail->send( template => 'mail.tt' );
190              
191             The SCALAR reference and ARRAY can be passed to 'body'.
192              
193             # Changing line enters between each element when passing it with ARRAY.
194             $mail->send( body => [qw/ Will the movie go to see ? /] );
195            
196             # If you pass it by the SCALAR reference ...
197             $mail->send( body => \"Will the movie go to see ?\n" );
198              
199             =head2 create_mail_data (MAIL_DATA_HASH)
200              
201             The data to do Mail Sending is made.
202              
203             After merging MAIL_DATA_HASH with the configuration and making the content of
204             the transmission, this method returns the data.
205              
206             =head2 create_mail_body (MAIL_DATA_HASH)
207              
208             The content of the transmission including the mail header is returned.
209              
210             The processing of this method is not practicable. Please build in
211             L<Egg::View::Mail::MIME::Entity>.
212              
213             =head2 create_mail_header (MAIL_DATA_HASH)
214              
215             A basic mail header is returned.
216              
217             =head2 SEE ALSO
218              
219             L<Egg::Release>,
220             L<Egg::Base>,
221             L<Egg::Component>,
222             L<Egg::View::Mail>,
223             L<Egg::View::Mail::MIME::Entity>,
224             L<Egg::Helper::View::Mail>,
225              
226             =head2 AUTHOR
227              
228             Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
229              
230             =head2 COPYRIGHT AND LICENSE
231              
232             Copyright (C) 2008 Bee Flag, Corp. E<lt>L<http://egg.bomcity.com/>E<gt>, All Rights Reserved.
233              
234             This library is free software; you can redistribute it and/or modify
235             it under the same terms as Perl itself, either Perl version 5.8.6 or,
236             at your option, any later version of Perl 5 you may have available.
237              
238             =cut
239