home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / MailSender.pm < prev    next >
Encoding:
Perl POD Document  |  2003-09-27  |  4.1 KB  |  176 lines
  1. package Log::Dispatch::Email::MailSender;
  2.  
  3. # By: Joseph Annino
  4. # (c) 2002
  5. # Licensed under the same terms as Perl
  6. #
  7.  
  8. use strict;
  9.  
  10. use Log::Dispatch::Email;
  11.  
  12. use base qw( Log::Dispatch::Email );
  13. use fields qw( buffer buffered from subject to smtp );
  14.  
  15. use Carp ();
  16. use Mail::Sender ();
  17.  
  18. use vars qw[ $VERSION ];
  19.  
  20. $VERSION = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /: (\d+)\.(\d+)/;
  21.  
  22. 1;
  23.  
  24. sub new
  25. {
  26.     my $proto = shift;
  27.     my $class = ref $proto || $proto;
  28.  
  29.     my %p = @_;
  30.  
  31.     my $smtp = delete $p{smtp} || 'localhost';
  32.  
  33.     my $self = $class->SUPER::new(%p);
  34.  
  35.     $self->{smtp} = $smtp;
  36.  
  37.     return $self;
  38. }
  39.  
  40. sub send_email
  41. {
  42.     my $self = shift;
  43.     my %p = @_;
  44.  
  45.     eval
  46.     {
  47.         my $sender =
  48.             Mail::Sender->new( { from => $self->{from} || 'LogDispatch@foo.bar',
  49.                                  replyto => $self->{from} || 'LogDispatch@foo.bar',
  50.                                  to => ( join ',', @{ $self->{to} } ),
  51.                                  subject => $self->{subject},
  52.                                  smtp => $self->{smtp},
  53.                                } );
  54.  
  55.         die "Error sending mail ($sender): $Mail::Sender::Error"
  56.             unless ref $sender;
  57.  
  58.         ref $sender->MailMsg( { msg => $p{message} } )
  59.             or die "Error sending mail: $Mail::Sender::Error";
  60.     };
  61.  
  62.     warn $@ if $@ && $^W;
  63. }
  64.  
  65. __END__
  66.  
  67. =head1 NAME
  68.  
  69. Log::Dispatch::Email::MailSender - Subclass of Log::Dispatch::Email that uses the Mail::Sender module
  70.  
  71. =head1 SYNOPSIS
  72.  
  73.   use Log::Dispatch::Email::MailSender;
  74.  
  75.   my $email =
  76.       Log::Dispatch::Email::MailSender->new
  77.           ( name => 'email',
  78.             min_level => 'emerg',
  79.             to => [ qw( foo@bar.com bar@baz.org ) ],
  80.             subject => 'Oh no!!!!!!!!!!!',
  81.             smtp => 'mail.foo.bar' );
  82.  
  83.   $email->log( message => 'Something bad is happening', level => 'emerg' );
  84.  
  85. =head1 DESCRIPTION
  86.  
  87. This is a subclass of Log::Dispatch::Email that implements the
  88. send_email method using the Mail::Sender module.
  89.  
  90. =head1 METHODS
  91.  
  92. =over 4
  93.  
  94. =item * new
  95.  
  96. This method takes a hash of parameters.  The following options are
  97. valid:
  98.  
  99. =over 8
  100.  
  101. =item * name ($)
  102.  
  103. The name of the object (not the filename!).  Required.
  104.  
  105. =item * min_level ($)
  106.  
  107. The minimum logging level this object will accept.  See the
  108. Log::Dispatch documentation for more information.  Required.
  109.  
  110. =item * max_level ($)
  111.  
  112. The maximum logging level this obejct will accept.  See the
  113. Log::Dispatch documentation for more information.  This is not
  114. required.  By default the maximum is the highest possible level (which
  115. means functionally that the object has no maximum).
  116.  
  117. =item * subject ($)
  118.  
  119. The subject of the email messages which are sent.  Defaults to "$0:
  120. log email"
  121.  
  122. =item * to ($ or \@)
  123.  
  124. Either a string or a list reference of strings containing email
  125. addresses.  Required.
  126.  
  127. =item * from ($)
  128.  
  129. A string containing an email address.  This is optional and may not
  130. work with all mail sending methods.
  131.  
  132. NOTE: The Mail::Sender module requires an address be passed to it to
  133. set this in the mail it sends.  We pass in 'LogDispatch@foo.bar' as
  134. the default.
  135.  
  136. =item * buffered (0 or 1)
  137.  
  138. This determines whether the object sends one email per message it is
  139. given or whether it stores them up and sends them all at once.  The
  140. default is to buffer messages.
  141.  
  142. =item * smtp ($)
  143.  
  144. A string containing the network address of the SMTP server to use for
  145. sending the email.  This defaults to localhost.
  146.  
  147. =item * callbacks( \& or [ \&, \&, ... ] )
  148.  
  149. This parameter may be a single subroutine reference or an array
  150. reference of subroutine references.  These callbacks will be called in
  151. the order they are given and passed a hash containing the following keys:
  152.  
  153.  ( message => $log_message, level => $log_level )
  154.  
  155. The callbacks are expected to modify the message and then return a
  156. single scalar containing that modified message.  These callbacks will
  157. be called when either the C<log> or C<log_to> methods are called and
  158. will only be applied to a given message once.
  159.  
  160. =back
  161.  
  162. =item * log_message( level => $, message => $ )
  163.  
  164. Sends a message if the level is greater than or equal to the object's
  165. minimum level.
  166.  
  167. =back
  168.  
  169. =head1 AUTHORS
  170.  
  171. Joseph Annino. <jannino@jannino.com>
  172.  
  173. Dave Rolsky, <autarch@urth.org>
  174.  
  175. =cut
  176.