File Coverage

blib/lib/Egg/View/Mail/Plugin/PortCheck.pm
Criterion Covered Total %
statement 9 21 42.8
branch 0 4 0.0
condition 0 9 0.0
subroutine 3 5 60.0
pod 1 1 100.0
total 13 40 32.5


line stmt bran cond sub pod time code
1             package Egg::View::Mail::Plugin::PortCheck;
2             #
3             # Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
4             #
5             # $Id: PortCheck.pm 285 2008-02-28 04:20:55Z lushe $
6             #
7 2     2   626 use strict;
  2         4  
  2         68  
8 2     2   10 use warnings;
  2         6  
  2         79  
9 2     2   12 use Carp qw/ croak /;
  2         5  
  2         656  
10              
11             our $VERSION = '0.01';
12              
13             sub _setup {
14 0     0     my($class, $e)= @_;
15 0 0         $e->isa('Egg::Plugin::Net::Scan')
16             || die q{I want setup 'Egg::Plugin::Net::Scan'.};
17 0           my $c= $class->config;
18 0   0       $c->{scan_host} ||= 'localhost';
19 0   0       $c->{scan_port} ||= 25;
20 0   0       $c->{scan_timeout} ||= 3;
21 0           $class->mk_accessors('scan');
22 0           $class->next::method($e);
23             }
24             sub send {
25 0     0 1   my $self= shift;
26 0           my $c = $self->config;
27 0   0       my $res = $self->scan || do {
28             my $scan= $self->e->port_scan
29             (@{$c}{qw/ scan_host scan_port /}, timeout=> $c->{scan_timeout} );
30             $self->scan($scan);
31             };
32 0 0         $res->is_success ? $self->next::method(@_): 0;
33             }
34              
35             1;
36              
37             __END__
38              
39             =head1 NAME
40              
41             Egg::View::Mail::Plugin::PortCheck - The operation of the mail server is checked before Mail Sending.
42              
43             =head1 SYNOPSIS
44              
45             my $mail= $e->view('mail_label');
46            
47             $mail->send( ........ ) || do {
48            
49             unless ($mail->scan->is_success) {
50            
51             .... The mail server is not operating.
52            
53             }
54            
55             };
56              
57             =head1 DESCRIPTION
58              
59             It is MAIL plugin that checks the operation of the mail server before Mail Sending.
60              
61             When 'PortCheck' is passed to 'setup_plugin' method, it is built in.
62              
63             package MyApp::View::Mail::MyComp;
64             .........
65            
66             __PACKAGE__->setup_plugin(qw/ PortCheck /);
67              
68             It is necessary to set up it and L<Egg::Plugin::Net::Scan>.
69              
70             package MyApp;
71             use Egg qw/ Net::Scan /;
72              
73             =head1 CONFIGURATION
74              
75             =head3 scan_host
76              
77             Host name to be checked.
78              
79             Default is 'localhost'.
80              
81             =head3 scan_port
82              
83             Port number to be checked.
84              
85             Default is '25'.
86              
87             =head3 scan_timeout
88              
89             Time to wait for answer from check object.
90              
91             Default is '3'.
92              
93             =head1 METHODS
94              
95             =head2 send ([MAIL_DATA_HASH])
96              
97             Mail is transmitted.
98              
99             If the check object is not operating, 0 is returned and processing is interrupted.
100              
101             Please adjust the built-in order when competing with other components for which
102             'send' method is used.
103              
104             __PACKAGE__->setup_plugin(qw/
105             Lot
106             PortCheck
107             /);
108              
109             =head2 scan
110              
111             The object returned from L<Egg::Plugin::Net::Scan> is stored.
112              
113             if (my $scan= $mail->scan) {
114             $e->stash->{error_message}= $scan->is_error;
115             }
116              
117             =head1 SEE ALSO
118              
119             L<Egg::Release>,
120             L<Egg::View::Mail>,
121             L<Egg::View::Mail::Base>,
122             L<Egg::Plugin::Net::Scan>,
123              
124             =head1 AUTHOR
125              
126             Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
127              
128             =head1 COPYRIGHT AND LICENSE
129              
130             Copyright (C) 2008 Bee Flag, Corp. E<lt>L<http://egg.bomcity.com/>E<gt>, All Rights Reserved.
131              
132             This library is free software; you can redistribute it and/or modify
133             it under the same terms as Perl itself, either Perl version 5.8.6 or,
134             at your option, any later version of Perl 5 you may have available.
135              
136             =cut
137