libmail-bulkmail-perl-3.12.orig/0040755000175000017500000000000010001603674015232 5ustar jojojojolibmail-bulkmail-perl-3.12.orig/Bulkmail/0040755000175000017500000000000010001603675016773 5ustar jojojojolibmail-bulkmail-perl-3.12.orig/Bulkmail/DummyServer.pm0100644000175000017500000001244407771636776021651 0ustar jojojojopackage Mail::Bulkmail::DummyServer; # Copyright and (c) 2003 James A Thomason III (jim@jimandkoka.com). All rights reserved. # Mail::Bulkmail::DummyServer is distributed under the terms of the Perl Artistic License. =pod =head1 NAME Mail::Bulkmail::DummyServer - dummy class for dummy server objects =head1 AUTHOR Jim Thomason, jim@jimandkoka.com =head1 DESCRIPTION Mail::Bulkmail::DummyServer is a drop in replacement for Mail::Bulkmail::Server. Sometimes you just want to test things on your end - make sure your list iterates properly, make sure your mail merge is functioning fine, make sure your logging functions are correct, whatever. And in those cases, you probably don't want to worry about futzing around with your SMTP relay and sending junk messages through it that you don't care about. Not to mention the fact that those probably will need to be inspected and deleted later. A hassle for debugging. Enter DummyServer. This is a subclass of Mail::Bulkmail::Server that behaves exactly the same except for the fact that it doesn't actually connect to a server. Instead, it sends all data that would be going to the server to a file instead. This file should be specified in the conf file. #in your conf file define package Mail::Bulkmail::DummyServer dummy_file = ./my.dummy.file Now, instead of sending commands to your SMTP relay, they'll get sent to ./my.dummy.file for easy inspection at a later date. =cut use Mail::Bulkmail::Server; @ISA = qw(Mail::Bulkmail::Server); $VERSION = '3.12'; use strict; use warnings; =pod =head1 CLASS ATTRIBUTES =over 11 =item dummy_file Stores the dummy_file that you want to output your data to. =back =cut __PACKAGE__->add_attr('dummy_file'); # this is used for tied filehandles to internally hold the dummy socket __PACKAGE__->add_attr('_socket'); =pod =head1 METHODS =over 11 =item connect "connects" to your DummyServer. Actually, internally it ties a filehandle onto this package. Yes, this thing has a (minimal) implementation of a tied handle class to accomplish this feat. This method is known to return MBDu001 - server won't say EHLO =cut sub connect { my $self = shift; local $\ = "\015\012"; local $/ = "\015\012"; my $h = $self->gen_handle(); tie *$h, "Mail::Bulkmail::DummyServer", $self; $self->socket($h); #We're either given a domain, or we'll build it based on who the message is from my $domain = $self->Domain; print $h "EHLO $domain"; my $response = <$h> || ""; return $self->error("Server won't say EHLO: $response", "MBDu001") if ! $response || $response =~ /^[45]/; $self->connected(1); return $self; }; # TIEHANDLE, as usual, ties a filehandle onto this class. It reads the file that is defined # _in_the_conf_file at Mail::Bulkmail::DummyServer->dummy_file, tries to open it (dies with an # error if it can't), and then ties our filehandle to the just opened file. sub TIEHANDLE { my $class = shift; my $self = shift; my $file = $self->dummy_file(); my $handle = Mail::Bulkmail::Object->gen_handle(); open ($handle, ">>$file") || die $!; return $class->new('_socket' => $handle); }; # in case our filehandle is fetched, just display some minimal information, namely the fact # that we're in DummyServer, and the name of the dummy file sub FETCH { return "DummyServer at file : " . shift->_socket; }; # prints to our dummy file. Uses sendmail crlfs, and tacks on a note that we're starting # a new message if we get a RSET command sub PRINT { my $f = shift->_socket; local $\ = "\015\012"; local $/ = "\015\012"; if ($_[0] eq 'RSET'){ print $f "--------NEW MESSAGE (connection reset)-------" if $f; }; print $f @_ if $f; return 1; }; sub FILENO { my $f = shift->_socket; my $n = fileno($f); }; # We can't read from this file, it's output only. However, we need to return something since # talk_and_respond is expecting to read information from its SMTP socket sub READLINE { return "250 bullshit all happy-happy" . scalar localtime() . "\015\012"; }; # closes our filehandle sub CLOSE { my $f = shift->_socket; close $f if $f; return 1; }; =pod =item disconnect overloaded disconnect method. Wipes out the internal socket as usual, but doesn't try to say RSET or QUIT to the server. disconnect can also disconnect quietly, i.e., it won't try to issue a RSET and then quit before closing the socket. $server->disconnect(); #issues RSET and quit $server->disconnect('quietly'); #issues nothing =back =cut sub disconnect { my $self = shift; my $quietly = shift; return $self unless $self->connected(); $self->talk_and_respond('RSET') unless $quietly; #just to be polite $self->talk_and_respond('quit') unless $quietly; if (my $socket = $self->socket) { close $socket; $socket = undef; }; $self->socket(undef); $self->connected(0); return $self; }; 1; __END__ =pod =head1 SEE ALSO Mail::Bulkmail::Server =head1 COPYRIGHT (again) Copyright and (c) 2003 James A Thomason III (jim@jimandkoka.com). All rights reserved. Mail::Bulkmail::DummyServer is distributed under the terms of the Perl Artistic License. =head1 CONTACT INFO So you don't have to scroll all the way back to the top, I'm Jim Thomason (jim@jimandkoka.com) and feedback is appreciated. Bug reports/suggestions/questions/etc. Hell, drop me a line to let me know that you're using the module and that it's made your life easier. :-) =cut libmail-bulkmail-perl-3.12.orig/Bulkmail/Dynamic.pm0100644000175000017500000014206407771636776020755 0ustar jojojojopackage Mail::Bulkmail::Dynamic; # Copyright and (c) 1999, 2000, 2001, 2002, 2003 James A Thomason III (jim@jimandkoka.com). All rights reserved. # Mail::Bulkmail::Dynamic is distributed under the terms of the Perl Artistic License. =pod =head1 NAME Mail::Bulkmail::Dynamic - platform independent mailing list module for mail merges and dynamically built messages =head1 AUTHOR Jim Thomason, jim@jimandkoka.com =head1 SYNOPSIS my $bulk = Mail::Bulkmail::Dynamic->new( "merge_keys" => [qw(BULK_EMAIL name id address city state zip)], "merge_delimiter" => "::", "LIST" => "~/my.list.txt", "From" => "'Jim Thomason'", "Subject" => "This is a test message", "Message" => "Here is my test message" ) || die Mail::Bulkmail->error(); $bulk->bulkmail() || die $bulk->error; Don't forget to set up your conf file! =head1 DESCRIPTION Mail::Bulkmail 1.00 had a thing called "filemapping", it was to allow you to dynamically populate certain variables into your message. Put in people's names, or the like. 2.00 renamed "filemapping" to the correct term - "mail merging", and also added in the ability to dynamically create your message, if so desired. So you could very easily send out completely different messages to everyone on your list, if so desired. But 2.00 also added a *lot* of processing overhead, most of which was unfortunately in the form of voodoo. i.e., I seem to recall lots of testing, debugging, etc. until I finally reached a point where the code worked and I sent it off. Not quite sure how it worked, mind you, but happy with the fact that it worked nonetheless. 3.00 strips that ability out of Mail::Bulkmail, cleans it up, and places it here. This has a few advantages. For one thing, if you're not doing any mailmerging, then you don't have to worry about any of the overhead of building hashes, doing checks, internally handling things, and so on. There wasn't a tremendous amount of useless work done in that case, but it was enough to be noticed. So now use Mail::Bulkmail if you're not doing mail merges, and Mail::Bulkmail::Dynamic if you are. And the other thing is that the code is cleaned up a B. I actually know and understand how it all works now, and it functions much better than previous versions did. Faster, more efficient, and so on. =cut use Mail::Bulkmail; @ISA = qw(Mail::Bulkmail); $VERSION = '3.12'; use strict; use warnings; =pod =head1 ATTRIBUTES =over 11 =item log_all_data boolean flag, 1/0. Mail::Bulkmail has an easy job logging its list items - they're always guaranteed to be single email addresses. Mail::Bulkmail::Dynamic has a harder time, since it's usually an email address and some other data. 'jim@jimandkoka.com::Jim Thomason::24' or ['jim@jimandkoka.com', "Jim Thomason", "24"] or { "BULK_EMAIL" => 'jim@jimandkoka.com', "name" => "Jim Thomason", "age" => "24" } Most of that is obviously not simple scalar data and needs to be logged differently. If log_all_data is set to 0, then only the email address will be logged and everything is fine. However, if log_all_data is 1, then a hashref containing all of the data is returned (regardless of the type of data structure you initially handed in). Obviously, you will then need to deal with logging yourself, either by logging to an arrayref or (better) to a function call. Logging to a file with log_all_data set to 1 will just give you a useless list of "HASH(0x7482)" and the like. All pieces may be used simultaneously. So in one mailing, you can use merge_keys, dynamic_message_data, dynamic_header_data, and global_merge. =cut __PACKAGE__->add_attr('log_all_data'); =pod =item merge_keys This should be much easier to use and understand than it was in prior versions. Okay, let's start off with the simple case, you have a file that contains a list of email addresses: foo@bar.com bob@hope.com john@junior.com And you set up a list with Mail::Bulkmail to mail to them. Your message is something like this: "Hi there. Things are great in my world, how's yours?" This works fine for a while, people are happy, everything's dandy. But then, you decide that it would be nice to personalize your email messages in some fashion. So you switch to Mail::Bulkmail::Dynamic. You'll need more information in your list of addresses now. foo@bar.com::Mr. Foo me@there.com::Bob Hope john@junior.com::John Jr. And then you'll need to define your merge_keys. merge_keys is an arrayref that defines how the data in your file is structured: merge_keys => [qw(BULK_EMAIL <>)] That tells Mail::Bulkmail::Dynamic that the first item in your list is the email address, and the second one is your name. Please note that the email address B be called "BULK_EMAIL", that's the keyword that the module looks for to find the address to send to. The rest of your keys may be named anything you'd like, but avoid naming keys starting with "BULK_", because those are reserved for my use internally and I may add more special keys like that in the future. (You'll also need to make sure that your merge_delimiter is set to "::", see merge_delimiter, below). Now you can change your message to the following: "Hi there, <>. Things are great in my world, how's yours?" This will send out the messages, respectively: Hi there, Mr. Foo. Things are great in my world, how's yours? Hi there, Bob Hope. Things are great in my world, how's yours? Hi there, John Junior. Things are great in my world, how's yours? And voila. Customization. you may include as much data as you'd like: merge_keys = [qw(<> BULK_EMAIL <> <> <> <>)] #in your list: Jim Thomason::jim@jimandkoka.com::IL::24::Programming Perl::titanium powerbook #and then your message. Dear <>, How've you been? I see that your email address is still BULK_EMAIL. Are you still living in <>? And you're still <>, right? Do you still enjoy <>? Well, email me back a message from your <>. And that's all there is to it. Just be sure to remember that any keys you define will get clobbered *anywhere* in the message. merge_keys => [qw(BULK_EMAIL name)] LIST => [qw(jim@jimandkoka.com::Jim)] "Hi there, name. I've always liked your name." You *probably* want that message to populate as: "Hi there, Jim. I've always liked your name." But it will populate as: "Hi there, Jim. I've always liked your Jim." Which doesn't make sense. So just make sure your keys aren't anywhere else in your message. For example, merge_keys => [qw(BULK_EMAIL )] LIST => [qw(jim@jimandkoka.com::Jim)] "Hi there, . I've always liked your name." Your list data may be a delimited scalar, as we've been using in our examples: jim@jimandkoka.com::Jim::24 Or an arrayref: ['jim@jimandkoka.com', 'Jim', '24'] In both of those cases, the order of the data is important. Each data element matches up to a particular key. So be sure that your data is actually in the same order as defined in your merge_keys array. Alternatively, you can also just store your data in a hash and pass that in: { 'BULK_EMAIL' => 'jim@jimandkoka.com', '' => 'Jim', '' => '24' } This is the one case where your merge_keys values will be ignored, and a mailmerge will be done with the key/value pairs passed in that hashtable. Passing in a hashtable is the fastest in terms of internal processing, but there may be additional work on your end to generate the hash. When reading from a file, you should always use delimited strings (since that's what'd be in your file anyway), but from other sources you can experiment with hashrefs or arrayrefs and see which is faster for your uses. mail merges apply to B message B header information. So it's valid to do: $dynamic->Subject("Hello there, "); And have the mail merge pick that up. Note that the merge will be performed in an arbitrary order, independent of what's specified in merge_keys. So don't expect to have one piece of the merge populate into your message before another one. =cut __PACKAGE__->add_attr('merge_keys'); =pod =item merge_delimiter If you're reading in from a file, you can't have arrayrefs, hashrefs, whatever. They don't store nicely in text. So your data will probably be a delimited string. In that case, you need to know the delimiter. Set it with merge_delimiter. #in your list jim@jimandkoka.com::Jim #then $dynamic->merge_delimiter("::"); #in your list jim@jimandkoka.com-+-Jim #then $dynamic->merge_delimiter('-+-'); #in your list jim@jimandkoka.com,Jim #then $dynamic->merge_delimiter(','); Just be sure that your delimiting string occurs *only* as the delimiter and is never embedded in your data. No escaping of a delimiter is possible. =cut __PACKAGE__->add_attr("merge_delimiter"); =pod =item global_merge It can be useful to to do a mail merge with non-address specific data. For example, you may want to put today's date in your subject. But it's silly (if not impossible) to populate that data out to all of your addresses. This is where the global_merge comes in. $dynamic->global_merge( { "" => scalar localtime } ); or, at creation: my $dynamic = Mail::Bulkmail::Dynamic->new( "global_merge" => { "" => scalar localtime } ); will now change to today's date in your message. "Hello, list member. This is the list for " This is a hash table that populates merge data B individual mail merge items. There is no way to use the same key for both a global_merge and a per-address merge. The global merge will always pick it up and the individual merge will miss it. So, as always, use different keys. =cut __PACKAGE__->add_attr('global_merge'); =pod =item dynamic_message_data Mail merges are all well and good, they store unique information about a unique email address. But sometimes you want to group together several users and send them the same information based upon some other criteria. That's where dynamic_message_data comes in handy. This is probably easiest explained via examples. dynamic_message_data is a hashref of hashrefs, such as this: $dynamic->dynamic_message_data( { '' => { 'over70' => 'napping', '40-50' => 'amassing wealth', '20-40' => 'working', 'under20' => 'playing' }, '' => { 'hates_animals' => "I see you hate animals.", "likes_animals" => "I see you like animals.", "loves_animals" => "I see you love animals." }, '' => { 'yes' => 'Hi there, ', 'no' => 'Hi there' } } ); Now then, your merge keys could be defined as such: ->merge_keys([qw(BULK_EMAIL BULK_DYNAMIC_MESSAGE)]); Your list would be: foo@bar.com::Mr. Foo::23::=20-40;=hates_animals;=yes me@there.com::Bob Hope::78::=over70;=likes_animals;=no john@junior.com::John Jr.::14::=under20;=likes_animals;=yes And finally, your message would be: . Judging by your age, which is , you should enjoy . Oh, and The messages sent out would be, respectively: Hi there, Mr. Foo. Judging by your age, which is 23, you should enjoy working. Oh, and I see you hate animals. Hi there. Judging by your age, which is 78, you should enjoy napping. Oh, and I see you like animals. Hi there, John Jr.. Judging by your age, which is 14, you should enjoy playing. Oh, and I see you like animals. See? easy as pie. Your dynamic message should be specified in your merge_keys as BULK_DYNAMIC_MESSAGE, and should be a delimited string (in this case). agegroup=20-40;=hates_animals;=yes You can specify what delimiters you'd like to use. In this case, your dynamic_message_delimiter is ';', and your dynamic_message_value_delimiter is '='. More clearly, this information translates to the following: => 20-40 => hates_animals => yes Please note that angle brackets are not required, they're just useful for clarity in our example. This is also perfectly acceptable: $dynamic->dynamic_message_data( { 'agegroup' => { 'over70' => 'napping', '40-50' => 'amassing wealth', '20-40' => 'working', 'under20' => 'playing' } } ); me@there.com::Bob Hope::78::agegroup=over70 As long as you use the same keys, you're fine. So you should be able to easily see that we'll look up the message associated with being in the agegroup of 20-40, the animallover that hates_animals, and then personilized with a choice of 'yes'. Dynamic message creation is done before mail merging, so you are more than welcome to put mail merge tokens inside your dynamic message, as we did above with the "" token, which may include the mail merge token of "". Don't use the same tokens for mailmerges and dynamic messages, since the system may get confused. Alternatively, instead of a delimited string, you may pass in an arrayref of strings: [qw(agegroup=20-40 =hates_animals =yes)] or an arrayref of arrayrefs: [[qw(agegroup 20-40)], [qw( hates_animals)], [qw( yes)]] or a hashref: { agegroup => 20-40 animallover => hates_animals personilized => yes } Passing in a hashtable is the fastest in terms of internal processing, but there may be additional work on your end to generate the hash. When reading from a file, you should always use delimited strings (since that's what'd be in your file anyway), but from other sources you can experiment with hashrefs or arrayrefs and see which is faster for your uses. dynamic messages apply to B message information. use dynamic_header_data for dynamic pieces in headers. Note that the dynamic message creation will be performed in an arbitrary order. So don't expect to have one piece of the dynamic message populate into your message before another one. There is one special key for dynamic_message_data, "_default". $dynamic->dynamic_message_data( { '' => { 'over70' => 'napping', '40-50' => 'amassing wealth', '20-40' => 'working', 'under20' => 'playing', '_default' => 'You have not specified an age group' }, '' => { 'hates_animals' => "I see you hate animals.", "likes_animals" => "I see you like animals.", "loves_animals" => "I see you love animals.", "_default" => "I don't know how you feel about animals" }, '' => { 'yes' => 'Hi there, ', 'no' => 'Hi there', } } ); It should be fairly obvious - if that key is not specified, then the _default value is used. Using our earlier example, with the following list: foo@bar.com::Mr. Foo::23::=20-40 And the same message of: . Judging by your age, which is , you should enjoy . Oh, and The messages sent out would be, respectively: . Judging by your age, which is 23, you should enjoy working. Oh, and I don't know how you feel about animals. Note that since was specified, we used that value. Since was not specified, the default was used, and since was not specified and has no default, it was simply wiped out. =cut __PACKAGE__->add_attr('dynamic_message_data'); =pod =item dynamic_message_delimiter If you're reading in from a file, you can't have arrayrefs, hashrefs, whatever. They don't store nicely in text. So your data will probably be a delimited string. In that case, you need to know the delimiter. Set it with dynamic_message_delimiter. Note that your dynamic message data is just an entry in your merge data. We'll assume a merge_delimiter of '::' and a dynamic_message_value_delimiter of '=' for these examples ->merge_keys([qw(BULK_EMAIL BULK_DYNAMIC_MESSAGE)]); #in your list jim@jimandkoka.com::Jim::agegroup=20-40;animallover=yes #then $dynamic->dynamic_message_delimiter(";"); #in your list jim@jimandkoka.com::Jim::agegroup=20-40&animallover=yes #then $dynamic->dynamic_message_delimiter('&'); #in your list jim@jimandkoka.com::Jim::agegroup=20-40,,animallover=yes #then $dynamic->dynamic_message_delimiter(',,'); Just be sure that your delimiting string occurs *only* as the delimiter and is never embedded in your data. No escaping of a delimiter is possible. =cut __PACKAGE__->add_attr("dynamic_message_delimiter"); =pod =item dynamic_message_value_delimiter If you're reading in from a file, you can't have arrayrefs, hashrefs, whatever. They don't store nicely in text. So your data will probably be a delimited string. In that case, you need to know the delimiter. Set it with dynamic_message_delimiter. Note that your dynamic message data is just an entry in your merge data. We'll assume a merge_delimiter of '::' and a dynamic_message_delimiter of ';' for these examples ->merge_keys([qw(BULK_EMAIL BULK_DYNAMIC_MESSAGE)]); #in your list jim@jimandkoka.com::Jim::agegroup=20-40;animallover=yes #then $dynamic->dynamic_message_value_delimiter("="); #in your list jim@jimandkoka.com::Jim::agegroup:=20-40;animallover:=yes #then $dynamic->dynamic_message_value_delimiter(':='); #in your list jim@jimandkoka.com::Jim::agegroup--20-40;animallover--yes #then $dynamic->dynamic_message_value_delimiter('--'); Just be sure that your delimiting string occurs *only* as the delimiter and is never embedded in your data. No escaping of a delimiter is possible. =cut __PACKAGE__->add_attr("dynamic_message_value_delimiter"); =pod =item dynamic_header_data Mail merges are all well and good, they store unique information about a unique email address. But sometimes you want to group together several users and send them the same information based upon some other criteria. That's where dynamic_message_data comes in handy. dynamic_header_data is virtually identical to dynamic_message_data in terms of behavior, but it operates on the message header instead of the message instelf. This is probably easiest explained via examples. dynamic_header_data is a hashref of hashrefs, such as this: $dynamic->dynamic_header_data( { 'Subject' => { 'polite' => "Hello, sir", "impolite" => "Hello", "rude" => "Hey, jerk-off" }, 'Reply-To' => { 'useful' => 'return@myaddress.com', 'semiuseful' => 'filteredreturn@myaddress.com', 'useless' => 'nowhere@noemail.com' }, 'X-Type' => { 'premium' => "All Services are available", "gold" => "Most servies are available", "none" => "No services are available" } } ); Now then, your merge keys could be defined as such: ->merge_keys([qw(BULK_EMAIL BULK_DYNAMIC_MESSAGE BULK_DYNAMIC_HEADERS)]); Your list would be: foo@bar.com::Mr. Foo::23::agegroup=20-40;animallover=hates_animals;personalized=yes::Subject=polite;Reply-To:useful;X-Type:gold me@there.com::Bob Hope::78::agegroup=over70;animallover=likes_animals;personalized=no::Subject=rude;Reply-To:useful;X-Type:premium john@junior.com::John Jr.::14::agegroup=under20;animallover=likes_animals;personalized=yes::Subject=impolite;Reply-To:useless;X-Type:none The messages sent out would have the following headers, respectively: Subject : Hello, sir Reply-To: return@myaddress.com X-Type : Most services are available Subject : Hey, jerk-off Reply-To: return@myaddress.com X-Type : All Services are available Subject : Hello Reply-To: nowhere@noemail.com X-Type : No services are available See? easy as pie. Your dynamic headers should be specified in your merge_keys as BULK_DYNAMIC_HEADERS, and should be a delimited string (in this case). Subject=polite;Reply-To=useful;X-Type=gold You can specify what delimiters you'd like to use. In this case, your dynamic_header_delimiter is ';', and your dynamic_header_value_delimiter is '='. More clearly, this information translates to the following: Subject => polite Reply-To => useful X-Type => gold Note that unlike dynamic_message_data, the key in this case is not used to substitute out a string in your headers (or message), the key is used to name the header that is appended on the message. Dynamic header creation is done before mail merging, so you are more than welcome to put mail merge tokens inside your dynamic headers. Don't use the same tokens for mailmerges and dynamic headers, since the system may get confused. Alternatively, instead of a delimited string, you may pass in an arrayref of strings: [qw(Subject=polite Reply-To=useful X-Type:gold)] or an arrayref of arrayrefs: [[qw(Subject polite)], [qw(Reply-To useful)], [qw(X-Type gold)]] or a hashref: { Subject => polite Reply-To => useful X-Type => gold } Passing in a hashtable is the fastest in terms of internal processing, but there may be additional work on your end to generate the hash. When reading from a file, you should always use delimited strings (since that's what'd be in your file anyway), but from other sources you can experiment with hashrefs or arrayrefs and see which is faster for your uses. dynamic headers apply to B header information. use dynamic_message_data for dynamic pieces in messages. Note that the dynamic header creation will be performed in an arbitrary order. So don't expect to have one piece of the dynamic header populate into your message before another one. There is one special key for dynamic_header_data, "_default". $dynamic->dynamic_message_data( { 'Subject' => { 'polite' => "Hello, sir", "impolite" => "Hello", "rude" => "Hey, jerk-off", '_default' => "Default subject", }, 'Reply-To' => { 'useful' => 'return@myaddress.com', 'semiuseful' => 'filteredreturn@myaddress.com', 'useless' => 'nowhere@noemail.com', '_default" => 'reply@to.com' }, 'X-Type' => { 'premium' => "All Services are available", "gold" => "Most servies are available", "none" => "No services are available" } } ); Behavior is similar to that of _default in dynamic_message_data. If a header is specified, it is used. If no value is specified, it will attempt to use the _default value. But, in this case, if there is no value passed and no default, then the header just won't be set. Unless it is one of the speciality headers, such as From. In that case, it will attempt a specific dynamic_message_data value for From, then the "_default" value in dynamic_message_data for from, and then finally the ->From value itself. If there's a header specified in ->dynamic_header_data, it will be preferred to use over one set via ->header. i.e., the order that a header will be checked is: 1) Is there a specific header key for the header? (Subject => polite) 2) Is there a default header key for the header? (Subject => _default) 3) Is this a specialty header (i.e., ->From), and is that set? ($bulk->From()) 4) Is there a generic, non-dynamic header set? (->header('Foo')) Headers will not be set more than once, no matter how many places you specify them. =cut __PACKAGE__->add_attr('dynamic_header_data'); =pod =item dynamic_header_delimiter If you're reading in from a file, you can't have arrayrefs, hashrefs, whatever. They don't store nicely in text. So your data will probably be a delimited string. In that case, you need to know the delimiter. Set it with dynamic_header_delimiter. Note that your dynamic header data is just an entry in your merge data. We'll assume a merge_delimiter of '::' and a dynamic_header_value_delimiter of '=' for these examples ->merge_keys([qw(BULK_EMAIL BULK_DYNAMIC_HEADERS)]); #in your list jim@jimandkoka.com::Jim::Subject=polite;Reply-To=useful #then $dynamic->dynamic_message_delimiter(";"); #in your list jim@jimandkoka.com::Jim::Subject=polite&Reply-To=useful #then $dynamic->dynamic_message_delimiter('&'); #in your list jim@jimandkoka.com::Jim::Subject=polite,,Reply-To=useful #then $dynamic->dynamic_message_delimiter(',,'); Just be sure that your delimiting string occurs *only* as the delimiter and is never embedded in your data. No escaping of a delimiter is possible. =cut __PACKAGE__->add_attr("dynamic_header_delimiter"); =pod =item dynamic_header_value_delimiter If you're reading in from a file, you can't have arrayrefs, hashrefs, whatever. They don't store nicely in text. So your data will probably be a delimited string. In that case, you need to know the delimiter. Set it with dynamic_header_delimiter. Note that your dynamic header data is just an entry in your merge data. We'll assume a merge_delimiter of '::' and a dynamic_header_delimiter of ';' for these examples ->merge_keys([qw(BULK_EMAIL BULK_DYNAMIC_HEADERS)]); #in your list jim@jimandkoka.com::Jim::Subject=polite;Reply-To=useful #then $dynamic->dynamic_message_value_delimiter("="); #in your list jim@jimandkoka.com::Jim::Subject:=polite;Reply-To:=useful #then $dynamic->dynamic_message_value_delimiter(':='); #in your list jim@jimandkoka.com::Jim::Subject--polite;Reply-To--useful #then $dynamic->dynamic_message_value_delimiter('--'); Just be sure that your delimiting string occurs *only* as the delimiter and is never embedded in your data. No escaping of a delimiter is possible. =cut __PACKAGE__->add_attr("dynamic_header_value_delimiter"); =pod =item quotemeta boolean flag. 1/0 While mailmerging, you can specify keys that would contain regex meta data. For example: ->merge_keys [qw(*name* BULK_EMAIL)] Would generate an error, because the * character has special meaning to a regex. With quotemeta turned on, you can use that as a token because it will be quoted when used in the regex. It is B recommended that you leave quotemeta set to 1. Set it to 0 only if you really know what you're doing. =cut __PACKAGE__->add_attr('quotemeta'); =pod =item use_envelope In this subclass, use_envelope is a method that will always return 0. For Dynamic messages, it's impossible to use the envelope. Sorry, gang, if you want to use mail merges, then you can't use the added speed that the envelope provides you with. And it only makes sense, because envelope sending sends the exact same message to multiple people. If you're doing a mail merge, then you're customizing each message, so it wouldn't make sense to send that thing to multiple people. For raw speed, use Mail::Bulkmail and use_envelope => 1. For mail merges, use this. =cut sub use_envelope { return 0}; =pod =back =head1 METHODS =over 11 =item extractEmail extractEmail is an overridden method from Mail::Bulkmail. Most of the time when you're in Mail::Bulkmail::Dynamic, the data structure that's passed around internally is a hashref, and the email address is at the key BULK_EMAIL. This extracts that key and returns it. Again, this method is used internally and is not something you need to worry about. This method is known to be able to return: MBD001 - no BULK_EMAIL defined =cut sub extractEmail { my $self = shift; my $data = shift; #if this is a hash, then we'll assume that we want the BULK_EMAIL key out of it. if (ref $data eq "HASH"){ #return the BULK_EMAIL key if we have it, an error otherwise if ($data->{"BULK_EMAIL"}){ return $self->valid_email($data->{"BULK_EMAIL"}); } else { return $self->error("No BULK_EMAIL defined", "MBD001"); }; } #otherwise, it's assumed to be a single email address, so we just use the super method else { return $self->SUPER::extractEmail($data, @_); }; }; =item extractSender extractSender is an overridden method from Mail::Bulkmail. Most of the time when you're in Mail::Bulkmail::Dynamic, the data structure that's passed around internally is a hashref, and the sender is at the key BULK_SENDER. This extracts that key and returns it. Again, this method is used internally and is not something you need to worry about. This method is known to be able to return: MBD015 - no BULK_SENDER defined =cut sub extractSender { my $self = shift; my $data = shift; #if this is a hash, then we'll assume that we want the BULK_SENDER key out of it. if (ref $data eq "HASH"){ #return the BULK_SENDER key if we have it, an error otherwise if ($data->{"BULK_SENDER"}){ return $self->valid_email($data->{"BULK_SENDER"}); } } #otherwise, it's assumed to be a single email address, so we just use the super method return $self->SUPER::extractSender($data, @_); }; =item extractReplyTo extractReplyTo is an overridden method from Mail::Bulkmail. Most of the time when you're in Mail::Bulkmail::Dynamic, the data structure that's passed around internally is a hashref, and the email address is at the key BULK_REPLYTO. This extracts that key and returns it. Again, this method is used internally and is not something you need to worry about. This method is known to be able to return: MBD016 - no BULK_REPLYTO defined =cut sub extractReplyTo { my $self = shift; my $data = shift; #if this is a hash, then we'll assume that we want the BULK_REPLYTO key out of it. if (ref $data eq "HASH"){ #return the BULK_REPLYTO key if we have it, an error otherwise if ($data->{"BULK_REPLYTO"}){ return $self->valid_email($data->{"BULK_REPLYTO"}); } } #otherwise, it's assumed to be a single email address, so we just use the super method return $self->SUPER::extractReplyTo($data, @_); }; =pod =item buildHeaders Another overridden method from Mail::Bulkmail. This one constructs headers and also includes any dynamic headers, if they have been specified in BULK_DYNAMIC_HEADERS. And, finally, it will do a mail merge on all headers (first global, then individual). Still called internally and still something you don't need to worry about. This ->buildHeaders cannot accept the optional second headers_hash parameter This method is known to be able to return: MBD013 - cannot bulkmail w/o From MBD014 - cannot bulkmail w/o To =cut sub buildHeaders { my $self = shift; my $data = shift; my $headers = undef; $headers .= "Date: " . $self->Date . "\015\012"; # keep track of the headers that we have set from dynamic_header_data my $set = {}; if (ref $data eq "HASH" && $data->{"BULK_DYNAMIC_HEADERS"}){ foreach my $key (keys %{$self->dynamic_header_data}) { my $subkey = $data->{"BULK_DYNAMIC_HEADERS"}->{$key} || '_default'; my $val = $self->dynamic_header_data->{$key}->{$subkey}; next if ! defined $val || $val !~ /\S/; next if $set->{$key}++; $headers .= $key . ": " . $val . "\015\012"; }; }; #now, we take care of our regular headers, including the ones that could return errors if not present unless ($set->{"From"}){ if (my $from = $self->From){ $headers .= "From: " . $from . "\015\012"; } else { return $self->error("Cannot bulkmail...no From address", "MBD013"); }; }; $headers .= "Subject: " . $self->Subject . "\015\012" if ! $set->{"Subject"} && defined $self->Subject && $self->Subject =~ /\S/; unless ($set->{"To"}){ if (my $to_hash = $self->extractEmail($data)){ my $to = $to_hash->{'original'}; $headers .= "To: $to\015\012"; } else { return $self->error("Cannot bulkmail...no To address", "MBD014"); }; }; my $sender_hash = $self->extractSender($data); if (! $set->{"Sender"} && defined $sender_hash) { $headers .= "Sender: " . $sender_hash->{'original'} . "\015\012"; } my $reply_to_hash = $self->extractReplyTo($data); if (! $set->{"ReplyTo"} && defined $reply_to_hash) { $headers .= "Reply-To: " . $reply_to_hash->{'original'} . "\015\012"; }; #we're always going to specify at least a list precedence $headers .= "Precedence: " . ($self->Precedence || 'list') . "\015\012" unless $set->{"Precedence"}; unless ($self->{"Content-type"}){ if ($self->_headers->{"Content-type"}){ $headers .= "Content-type: " . $self->_headers->{"Content-type"} . "\015\012"; } else { if ($self->HTML){ $headers .= "Content-type: text/html\015\012"; } else { $headers .= "Content-type: text/plain\015\012"; }; }; }; #done with our default headers foreach my $key (keys %{$self->_headers}) { next if $key eq 'Content-type'; my $val = $self->_headers->{$key}; next if ! defined $val || $val !~ /\S/; next if $set->{$key}++; $headers .= $key . ": " . $val . "\015\012"; }; #do our global value merge if ($self->global_merge){ #iterate through the keys of the global_merge hash, and swap them with the relevant values #this is part of our mail merge, but not the main customization foreach my $key (keys %{$self->global_merge}){ my $val = $self->global_merge->{$key} || ''; my $key = $self->quotemeta() ? "\Q$key\E" : $key; $headers =~ s/$key/$val/g; }; }; #if we have a mail merge, then do it. if (ref $data eq "HASH"){ #iterate through the keys of the merge_hash, and swap them with the relevant values #this is our mailmerge foreach my $key (keys %$data){ next if ref $data->{$key}; my $val = $data->{$key} || ''; my $key = $self->quotemeta() ? "\Q$key\E" : $key; $headers =~ s/$key/$val/g; }; }; # I'm taking credit for the mailing, dammit! $headers .= "X-Bulkmail: " . $Mail::Bulkmail::Dynamic::VERSION . "\015\012"; $headers = $self->_force_wrap_string($headers, 'start with a blank', 'no blank lines'); $headers .= "\015\012"; #blank line between the header and the message return \$headers; }; =pod =item buildMessage Another overridden method from Mail::Bulkmail. This one constructs the message and also includes any dynamic message content, if it has been specified in BULK_DYNAMIC_MESSAGE. And, finally, it will do a mail merge on the message (first global, then individual). Still called internally and still something you don't need to worry about. This method is known to be able to return: MBD012 - cannot build message w/o message =cut sub buildMessage { my $self = shift; my $data = shift; #Mail::Bulkmail builds the message for us just fine, then we'll do the mail merge into it. my $message = $self->Message() || return $self->error("Cannot build message w/o message", "MBD012"); #first of all, dynamically build a message, if so desired if (ref $data eq "HASH" && $data->{"BULK_DYNAMIC_MESSAGE"}){ foreach my $key (keys %{$self->dynamic_message_data}) { my $subkey = $data->{"BULK_DYNAMIC_MESSAGE"}->{$key} || '_default'; my $val = $self->dynamic_message_data->{$key}->{$subkey} || ''; my $key = $self->quotemeta() ? "\Q$key\E" : $key; $message =~ s/$key/$val/g; }; }; #do our global value merge if ($self->global_merge){ #iterate through the keys of the global_merge hash, and swap them with the relevant values #this is part of our mail merge, but not the main customization foreach my $key (keys %{$self->global_merge}){ my $val = $self->global_merge->{$key} || ''; my $key = $self->quotemeta() ? "\Q$key\E" : $key; $message =~ s/$key/$val/g; }; }; #if we have a mail merge, then do it. if ($self->merge_keys || ref $data eq 'HASH'){ #iterate through the keys of the merge_hash, and swap them with the relevant values #this is our mailmerge foreach my $key (keys %$data){ next if ref $data->{$key}; my $val = $data->{$key} || ''; my $key = $self->quotemeta() ? "\Q$key\E" : $key; $message =~ s/$key/$val/g; }; }; #sendmail-ify our line breaks $message =~ s/(?:\r?\n|\r\n?)/\015\012/g; $message = $self->_force_wrap_string($message); #double any periods that start lines $message =~ s/^\./../gm; #and force a CRLF at the end, unless one is already present $message .= "\015\012" unless $message =~ /\015\012$/; $message .= "."; return \$message; }; =pod =item preprocess Overridden from Mail::Bulkmail, preprocesses the data returned from getNextLine($bulk->LIST) and makes sure that Mail::Bulkmail::Dynamic knows how to work with it. Constructs the internal data structures to handle mail merges, dynamic messages, and dynamic headers, for any of those items that are in use. Still called internally and still not something you need to worry about. =cut sub preprocess { my $self = shift; my $data = shift; #make sure it's a reference $data = $self->SUPER::preprocess($data) || return undef; #build the mail merge hash, if necessary if ($self->merge_keys){ my $original = $data; $data = $self->buildMergeHash($data) || return undef; $data->{"BULK_ORIGINAL"} ||= $original if ref $original ne "HASH"; }; #if we have a dynamic message component, then build the dynamic message data if (ref $data eq "HASH" && $self->dynamic_message_data){ $data->{"BULK_DYNAMIC_MESSAGE"} = $self->SUPER::preprocess($data->{"BULK_DYNAMIC_MESSAGE"}) || return undef; $data->{"BULK_DYNAMIC_MESSAGE"} = $self->buildDynamicMessageHash($data->{"BULK_DYNAMIC_MESSAGE"}) || return undef; }; #if we have a dynamic header component, then build the dynamic header data if (ref $data eq "HASH" && $self->dynamic_header_data){ $data->{"BULK_DYNAMIC_HEADERS"} = $self->SUPER::preprocess($data->{"BULK_DYNAMIC_HEADERS"}) || return undef; $data->{"BULK_DYNAMIC_HEADERS"} = $self->buildDynamicHeaderHash($data->{"BULK_DYNAMIC_HEADERS"}) || return undef; }; return $data; }; =pod =item buildMessageHash Given a delimited string, arrayref, or hashref, formats it according to the information contained in merge_keys and returns it. Called internally, and not something you should worry about. This method is known to be able to return: MBD002 - no merge_delimiter MBD003 - different number of keys and values MBD004 - cannot bulid merge hash =cut sub buildMergeHash { my $self = shift; my $data = shift; #if it's a hashref, then just return it. We'll use that as the keys AND values and #completely ignore whatever's in merge_keys #we're putting this first because it should be the most common case if (ref $data eq 'HASH'){ return $data; } # okay, if it's a string, then we want to split it on the merge_delimiter, and use that # as an array of values with the merge_keys elsif (ref $data eq "SCALAR"){ my $delimiter = quotemeta($self->merge_delimiter()) || return $self->error("Cannot split without a merge_delimiter", "MBD002"); my @values = split(/$delimiter/, $$data, scalar @{$self->merge_keys}); return $self->error("I won't attempt a mail merge unless there are the same number of keys and values", "MBD003") unless @values == @{$self->merge_keys}; #we need to create the hash to return my $mergehash = {}; foreach my $key (@{$self->merge_keys}){ $mergehash->{$key} = shift @values; }; return $mergehash; } #arrays behave just like strings, but we don't need to split the string into an arrayref first elsif (ref $data eq 'ARRAY'){ return $self->error("I won't attempt a mail merge unless there are the same number of keys and values", "MBD003") unless @$data == @{$self->merge_keys}; #we need to create the hash to return my $mergehash = {}; #I'm not going to shift off of @$data, because I want to leave the arrayref intact, but it'd be #wasteful to de-reference it here and shift off the copy. So we'll just increment through it my $i = 0; foreach my $key (@{$self->merge_keys}){ $mergehash->{$key} = $data->[$i++]; }; return $mergehash; } #and, finally, if it's none of the above, then we can't deal with it, so return an error. else { return $self->error("Cannot build merge hash...I don't know what a $data is", "MBD004"); }; }; =pod =item buildDynamicMessageHash Given a delimited string, arrayref, or hashref, formats it according to the information contained in dynamic_message_data and returns it. Called internally, and not something you should worry about. This method is known to be able to return: MBD005 - cannot split w/o dynamic_message_delimiter MBD006 - cannot split w/o dynamic_message_value_delimiter MBD007 - invalid dynamic message key MBD008 - cannot build dynamic message hash =cut sub buildDynamicMessageHash { my $self = shift; my $data = shift; #if it's a hashref, then just return it, so that's our keys and values #we're putting this first because it should be the most common case if (ref $data eq 'HASH'){ return $data; } # okay, if it's a string, then we want to split it on the merge_delimiter, and use that # as an array of values with the merge_keys elsif (ref $data eq "SCALAR"){ my $delimiter = quotemeta($self->dynamic_message_delimiter()) || return $self->error("Cannot split without a dynamic_message_delimiter", "MBD005"); my $eqdelimiter = quotemeta($self->dynamic_message_value_delimiter()) || return $self->error("Cannot split without a dynamic_message_value_delimiter", "MBD006"); my @values = split(/$delimiter/, $$data); #we need to create the hash to return my $dynamicmessagehash = {}; foreach my $pair (@values){ my ($key, $value) = split(/$eqdelimiter/, $pair); return $self->error("Invalid dynamic message key : $key", "MBD007") unless exists $self->dynamic_message_data->{$key}; $dynamicmessagehash->{$key} = $value; }; return $dynamicmessagehash; } #arrays behave just like strings, but we don't need to split the string into an arrayref first elsif (ref $data eq 'ARRAY'){ #we need to create the hash to return my $dynamicmessagehash = {}; foreach my $pair (@$data){ my ($key, $value); if (ref $pair){ ($key, $pair) = @$pair; } else { my $eqdelimiter = quotemeta($self->dynamic_message_value_delimiter()) || return $self->error("Cannot split without a dynamic_message_value_delimiter", "MBD006"); ($key, $pair) = split(/$eqdelimiter/, $pair); }; $dynamicmessagehash->{$key} = $value; }; return $dynamicmessagehash; } #and, finally, if it's none of the above, then we can't deal with it, so return an error. else { return $self->error("Cannot build dynamic message hash...I don't know what a $data is", "MBD008"); }; }; =pod =item buildDynamicHeaderHash Given a delimited string, arrayref, or hashref, formats it according to the information contained in dynamic_header_data and returns it. Called internally, and not something you should worry about. This method is known to be able to return: MBD008 - cannot split w/o dynamic_header_delimiter MBD009 - cannot split w/o dynamic_header_value_delimiter MBD010 - invalid dynamic header key MBD011 - cannot build dynamic header hash =cut sub buildDynamicHeaderHash { my $self = shift; my $data = shift || {}; #if it's a hashref, then just return it. so that's our keys and values #we're putting this first because it should be the most common case if (ref $data eq 'HASH'){ return $data; } # okay, if it's a string, then we want to split it on the merge_delimiter, and use that # as an array of values with the merge_keys elsif (ref $data eq "SCALAR"){ my $delimiter = quotemeta($self->dynamic_header_delimiter()) || return $self->error("Cannot split without a dynamic_header_delimiter", "MBD008"); my $eqdelimiter = quotemeta($self->dynamic_header_value_delimiter()) || return $self->error("Cannot split without a dynamic_header_value_delimiter", "MBD009"); my @values = split(/$delimiter/, $$data); #we need to create the hash to return my $dynamicheaderhash = {}; foreach my $pair (@values){ my ($key, $value) = split(/$eqdelimiter/, $pair); return $self->error("Invalid dynamic header key : $key", "MBD010") unless exists $self->dynamic_header_data->{$key}; $dynamicheaderhash->{$key} = $value; }; return $dynamicheaderhash; } #arrays behave just like strings, but we don't need to split the string into an arrayref first elsif (ref $data eq 'ARRAY'){ #we need to create the hash to return my $dynamicheaderhash = {}; foreach my $pair (@$data){ my ($key, $value); if (ref $pair){ ($key, $pair) = @$pair; } else { my $eqdelimiter = quotemeta($self->dynamic_header_value_delimiter()) || return $self->error("Cannot split without a dynamic_header_value_delimiter", "MBD009"); ($key, $pair) = split(/$eqdelimiter/, $pair); }; $dynamicheaderhash->{$key} = $value; }; return $dynamicheaderhash; } #and, finally, if it's none of the above, then we can't deal with it, so return an error. else { return $self->error("Cannot build dynamic header hash...I don't know what a $data is", "MBD011"); }; }; =pod =item convert_to_scalar convert_to_scalar is still used exclusively internally here, and you still don't need to worry about it. The difference is that this time, our data passed in is not just a simple email address - it's a hash. If log_all_data is set to true, then you get back the data in the form that you had originally passed it, arrayref, hashref, or delimited string. Alternatively, the user can decide to just log the email address, if the dynamic and merge information are not important. =cut sub convert_to_scalar { my $self = shift; my $value = shift; if ($self->log_all_data()){ my $v2 = ref $value eq 'HASH' ? ($value->{"BULK_ORIGINAL"} || $value) : $value; return ref $v2 eq "SCALAR" ? $$v2 : $v2; } else { return ref $value eq 'HASH' ? $value->{"BULK_EMAIL"} : $self->SUPER::convert_to_scalar($value); }; }; 1; __END__ =pod =back =head1 EXAMPLES #simple mailing with a list called "./list.txt". Note that this is inefficient, since we're not merging we #could just use Mail::Bulkmail instead. my $bulk = Mail::Bulkmail::Dynamic->new( "LIST" => "./list.txt", "Subject" => "A test message", "Message" => "This is my test message", "From" => 'me@mydomain.com', "Reply-To" => 'replies@mydomain.com' ) || die Mail::Bulkmail::Dynamic->error(); $bulk->bulkmail || die $bulk->error; #simple merge example. Assume that this is your list file: test1@yourdomain.com::Person #1 test2@yourdomain.com::Person #2 test3@yourdomain.com::Person #3 my $bulk = Mail::Bulkmail::Dynamic->new( "LIST" => "./list.txt", "Subject" => "A test message", "Message" => "This is my test message just for you. And your name is NAME.", "From" => 'me@mydomain.com', "Reply-To" => 'replies@mydomain.com', "merge_keys" => [qw(BULK_EMAIL NAME)] ) || die Mail::Bulkmail::Dynamic->error(); $bulk->bulkmail || die $bulk->error; #simple dynamic message example. Assume that this is your list file: test1@yourdomain.com::Person #1::personal_message=mess1 test2@yourdomain.com::Person #2::personal_message=mess2 test3@yourdomain.com::Person #3::personal_message=mess3 my $bulk = Mail::Bulkmail::Dynamic->new( "LIST" => "./list.txt", "Subject" => "A test message", "Message" => "This is my test message. And here's something personalized for you : personal_message", "From" => 'me@mydomain.com', "Reply-To" => 'replies@mydomain.com', "merge_keys" => [qw(BULK_EMAIL NAME)], "dynamic_message_data" => { "message" => { "mess1" => "Greetings, NAME", "mess2" => "Hello there, "NAME", "mess3" => "Hiya, NAME" } } ) || die Mail::Bulkmail::Dynamic->error(); $bulk->bulkmail || die $bulk->error; #simple dynamic message example with two dynamic components. Assume that this is your list file: test1@yourdomain.com::Person #1::personal_message=mess1;addendum=one test2@yourdomain.com::Person #2::personal_message=mess2;addendum=two test3@yourdomain.com::Person #3::personal_message=mess3;addendum=three my $bulk = Mail::Bulkmail::Dynamic->new( "LIST" => "./list.txt", "Subject" => "A test message", "Message" => "This is my test message. And here's something personalized for you : personal_message. addendum", "From" => 'me@mydomain.com', "Reply-To" => 'replies@mydomain.com', "merge_keys" => [qw(BULK_EMAIL NAME)], "dynamic_message_data" => { "message" => { "mess1" => "Greetings, NAME", "mess2" => "Hello there, "NAME", "mess3" => "Hiya, NAME" }, 'addendum' => { 'one' => 'You have received addendum #1', 'two' => "You're getting addendum number two", "three" => "3 is what you get" } } ) || die Mail::Bulkmail::Dynamic->error(); $bulk->bulkmail || die $bulk->error; #simple dynamic message example with a dynamic message, and a dynamic header component. Assume that this is your list file: test1@yourdomain.com::Person #1::personal_message=mess1;addendum=one::Subject=subject1 test2@yourdomain.com::Person #2::personal_message=mess2;addendum=two::Subject=subject1 test3@yourdomain.com::Person #3::personal_message=mess3;addendum=three::Subject=subject3 my $bulk = Mail::Bulkmail::Dynamic->new( "LIST" => "./list.txt", "Subject" => "A test message", "Message" => "This is my test message. And here's something personalized for you : personal_message. addendum", "From" => 'me@mydomain.com', "Reply-To" => 'replies@mydomain.com', "merge_keys" => [qw(BULK_EMAIL NAME)], "dynamic_message_data" => { "message" => { "mess1" => "Greetings, NAME", "mess2" => "Hello there, "NAME", "mess3" => "Hiya, NAME" }, 'addendum' => { 'one' => 'You have received addendum #1', 'two' => "You're getting addendum number two", "three" => "3 is what you get" } }, "dynamic_header_data" => { "Subject" => { "subject1" => "you're getting test message #1", "subject2" => "you're getting test message #2", "subject3" => "you're getting test message #3" } } ) || die Mail::Bulkmail::Dynamic->error(); $bulk->bulkmail || die $bulk->error; =head1 SEE ALSO Mail::Bulkmail, Mail::Bulkmail::Server =head1 COPYRIGHT (again) Copyright and (c) 1999, 2000, 2001, 2002, 2003 James A Thomason III (jim@jimandkoka.com). All rights reserved. Mail::Bulkmail::Dynamic is distributed under the terms of the Perl Artistic License. =head1 CONTACT INFO So you don't have to scroll all the way back to the top, I'm Jim Thomason (jim@jimandkoka.com) and feedback is appreciated. Bug reports/suggestions/questions/etc. Hell, drop me a line to let me know that you're using the module and that it's made your life easier. :-) =cut libmail-bulkmail-perl-3.12.orig/Bulkmail/Object.pm0100644000175000017500000012304507771636776020575 0ustar jojojojopackage Mail::Bulkmail::Object; #Copyright and (c) 1999, 2000, 2001, 2002, 2003 James A Thomason III (jim@jimandkoka.com). All rights reserved. #Mail::Bulkmail::Object is distributed under the terms of the Perl Artistic License. # SCROLL DOWN TO @conf_files ARRAY TO CONFIGURE IT =pod =head1 NAME Mail::Bulkmail::Object - used to create subclasses for Mail::Bulkmail. =head1 AUTHOR Jim Thomason, jim@jimandkoka.com =head1 DESCRIPTION Older versions of this code used to be contained within the Mail::Bulkmail package itself, but since 3.00 now has all of the code compartmentalized, I couldn't leave this in there. Well, technically I *could*, but I didn't like that. It's wasteful to make Mail::Bulkmail::Server a subclass of Mail::Bulkmail, for instance, since they don't share any methods, attributes, whatever. Well, none beyond the standard object methods that I like to use. Hence this module was born. Of course, you don't have to use this to create subclasses, but you'll run the risk of making something with an inconsistent interface vs. the rest of the system. That'll confuse people and make them unhappy. So I recommend subclassing off of here to be consistent. Of course, you may not like these objects, but they do work well and are consistent. Consistency is very important in interface design, IMHO. =cut $VERSION = '3.12'; use Socket; no warnings 'portable'; use 5.6.0; #use Data::Dumper (); #sub dump { # my $self = shift; # return Data::Dumper::Dumper($self); #}; use strict; use warnings; =pod =head1 SET-UP You'll need to specify your conf files. There is the @conf_files array, toss in as many conf files as you'd like my @conf_files = qw( /etc/mail.bulkmail.cfg /etc/mail.bulkmail.cf2 ); It'll just silently ignore any conf files that aren't present, so don't expect any errors. That's to allow you to place multiple conf files in for use on multiple servers and then not worry about them. Multiple conf files are in significance order. So if mail.bulkmail.cfg and mail.bulkmail.cf2 both define a value for 'foo', then the one in mail.bulkmail.cfg is used. And so on, conf files listed earlier are more important. There is no way for a program to later look at a less significant conf value. =cut #you'll need to specify your conf files { my @conf_files = qw( ); =pod =head1 METHODS =over 11 =item conf_files conf_files returns your conf_files array. my @conf_files = $class->conf_files(); You can also programmatically add a new conf_file this way. $class->conf_files('/path/to/new/conf.file', '/path/to/other/conf.file'); #, etc However, it'd be better to specify your conf file at use time. use Mail::Bulkmail::Object 3.00 "/path/to/conf.file"; This also (naturally) works in all subclasses. use Mail::Bulkmail 3.00 "/path/to/conf.file"; use Mail::Bulkmail::Dynamic 3.00 "/path/to/conf/file"; and so on. Note that adding on via ->conf_files or importing puts onto the FRONT of the @conf_files array, i.e., those conf files are more significant. So, @conf_files = qw(/path/to/file /path/to/file2); use Mail::Bulkmail::Object 3.00 "/path/to/file3" "/path/to/file4"; Mail::Bulkmail::Object->conf_files("/path/to/file5", "/path/to/file6"); print Mail::Bulkmail::Object->conf_files; #prints out /path/to/file5 /path/to/file6 /path/to/file3 /path/to/file4 /path/to/file path/to/file2 Note that you don't *need* conf files, you can still specify all information at construction time, or via mutators, or whatever. But a conf file can make your life a lot easier. =cut sub conf_files { my $self = shift; unshift @conf_files, $_ foreach reverse @_; return @conf_files; }; # the importer looks to any arguments specified at import and puts them # on the FRONT of the conf_files array. sub import { my $class = shift; unshift @conf_files, $_ foreach reverse @_; return 1; }; }; # You really probably don't want to change this # If the conf file doesn't have a package defined, then it will assume that it's in the package defined here # in this case, Mail::Bulkmail::Object my $default_package = __PACKAGE__; =item add_attr add_attr adds object attributes to the class. Okay, now we're going to get into some philosophy. First of all, let me state that I *love* Perl's OO implementation. I usually get smacked upside the head when I say that, but I find it really easy to use, work with, manipulate, and so on. And there are things that you can do in Perl's OO that you can't in Java or C++ or the like. Perl, for example, can have *totally* private values that are completely inaccessible (lexicals, natch). private vars in the other languages can be redefined or tweaked or subclassed or otherwise gotten around in some form. Not Perl. And I obviously just adore Perl anyway. I get funny looks when I tell people that I like perl so much because it works the way I think. That bothers people for some reason. Anyway, as much as I like how it works, I don't like the fact that there's no consistent object type. An object is, of course, a blessed ((thingie)) (scalar, array, code, hash, etc) reference. And there are merits to using any of those things, depending upon the situation. Hashes are easy to work with and most similar to traditional objects. $object->{$attribute} = $value; And whatnot. Arrays are much faster (typically 33% in tests I've done), but they suck to work with. $object->[15] = $value; #the hell is '15'? ( by the way, you can make this easier with variables defined to return the value, i.e. $object->[$attribute] = $value; #assuming $attribute == 15 ) Scalars are speciality and coderefs are left to the magicians. Don't get me wrong, coderefs as objects are nifty, but they can be tricky to work with. So, I wanted a consistent interface. I'm not going to claim credit for this idea, since I think I originally read it in Object Oriented Programming in Perl (Damien's book). In fact, I think the error reporting method I use was also originally detailed in there. Anyway, I liked it a lot and decided I'd implement my own version of it. Basically, attributes are accessed and mutated via methods. $object->attribute($value); For all attributes. This way, the internal object can be whatever you'd like. I used to use mainly arrays for the speed boost, but lately I use hashes a lot because of the ease of dumping and reading the structure for debugging purposes. But, with this consistent interface of using methods to wrapper the attributes, I can change the implementation of the object (scalar, array, hash, code, whatever) up in this module and *nothing* else needs to change. Say you implemented a giant system in OO perl. And you chose hashrefs as your "object". But then you needed a big speed boost later, which you could easily get by going to arrays. You'd have to go through your code and change all instances of $object->{$attribute} to $object->[15] or whatever. That's an awful lot of work. With everything wrappered up this way, changes can be made in the super object class and then automagically populate out everywhere with no code changes. Spiffy stuff. There are some disadvantages, there is a little more overhead for doing the additional method call, but it's usually negligible. And you can't do nice things like: $object->{$attribute}++; you'd have to do $object->attribute($object->attribute + 1); Which is annoying. But I think it's offset by the consistent interface regardless of what your underlying object is. Enough with the philosophy, though. You need to know how this works. It's easy enough: package Some::Class; Some::Class->add_attr('foo'); Now your Some::Class objects have a foo attribute, which can be accessed as above. If called with a value, it's the mutator which sets the attribute to the new value and returns the new value. If called without one, it's the accessor which returns the value. my $obj = Some::Class->new(); $obj->foo('bar'); print $obj->foo(); #prints bar print $obj->foo('boo'); #prints boo print $obj->foo(); #prints boo add_attr calls should only be in your module. B. And they really should be defined up at the top. Internally, an add_attr call creates a function inside your package of the name of the attribute which reflects through to the internal _accessor method which handles the mutating and accessing. There is another syntax for add_attr, to define a different internal accessor: Some::Class->add_attr(['foo', 'other_accessor']); This creates method called 'foo' which talks to a separate accessor, in this case "other_accessor" instead of going to _accessor. This is useful if you want to create a validating method on your attribute. Additionally, it creates a normal method going to _accessor called '_foo', which is assumed to be the internal attribute slot your other accessor with use. In generall, for a given "attribute", "_attribute" will be created for internal use. "other_accessor" will get the object as the first arg (as always) and the name of the internal method as the second. Example: Some::Class->add_attr(['foo', 'other_accessor']); $obj->foo('bee'); sub other_accessor { my $self = shift; my $method = shift; # "_foo", in this example if (@_){ my $val = shift; # "bee", in this example if ($val == 7){ return $self->$method($val); } else { return $self->error("Cannot store value...foo must be 7!"); }; } else { return $self->$method(); }; }; And, finally, you can also pass in additional arguments as static args if desired. Some::Class->add_attr(['foo', 'other_accessor'], 'bar'); $obj->foo('bee'); sub other_accessor { my $self = shift; my $method = shift; my $static = shift; #'bar' in our example my $value = shift; #'bee' in our example . . . }; All easy enough. Refer to any subclasses of this class for further examples. =cut sub add_attr { my $pkg = shift; my $method = shift; my $accessor = "_accessor"; my @static_args = @_; if (ref $method){ ($method, $accessor) = @$method; no strict 'refs'; my $internal_method = '_' . $method; $pkg->add_attr($internal_method); no strict 'refs'; *{$pkg . "::$method"} = sub {shift->$accessor($internal_method, @static_args, @_)}; } else { no strict 'refs'; *{$pkg . "::$method"} = sub {shift->$accessor($method, @static_args, @_)}; }; return $method; }; =pod =item add_class_attr This is similar to add_attr, but instead of adding object attributes, it adds class attributes. You B have object and class attributes with the same name. This is by design. (error is a special case) Some::Class->add_attr('foo'); #object attribute foo Some::Class->add_class_attr('bar'): #class attribute bar print $obj->foo(); print Some::Class->bar(); Behaves the same as an object method added with add_attr, mutating with a value, accessing without one. Note that add_class_attr does not have the capability for additional internal methods or static values. If you want those on a class method, you'll have to wrapper the class attribute yourself on a per case basis. Note that you can access class attributes via an object (as expected), but it's frowned upon since it may be confusing. class attributes are automatically initialized to any values in the conf file upon adding, if present. =cut sub add_class_attr { my $pkg = shift; my $method = shift; my $f = q{ { my $attr = undef; sub { my $pkg = shift; $attr = shift if @_; return $attr; } } }; no strict 'refs'; *{$pkg . "::$method"} = eval $f; #see if there's anything in the conf file my $conf = $pkg->read_conf_file || die "Conf file error : " . $pkg->error . " " . $pkg->errcode; if ($conf->{$pkg}->{$method}){ $pkg->$method($conf->{$pkg}->{$method}); }; if (@_){ $pkg->$method(@_); }; return $method; }; =pod =item add_tricke_class_attr It's things like this why I really love Perl. add_trickle_class_attr behaves the same as add_class_attr with the addition that it will trickle the attribute down into any class as it is called. This is useful for subclasses. Watch: package SuperClass; SuperClass->add_class_attr('foo'); SuperClass->foo('bar'); package SubClass; @ISA = qw(SuperClass); print SubClass->foo(); #prints bar print SuperClass->foo(); #prints bar print SuperClass->foo('baz'); #prints baz print SubClass->foo(); #prints baz print SubClass->foo('dee'); #prints dee print SuperClass->foo(); #prints dee See? The attribute is still stored in the super class, so changing it in a subclass changes it in the super class as well. Usually, this behavior is fine, but sometimes you don't want that to happen. That's where add_trickle_class_attr comes in. Its first call will snag the value from the SuperClass, but then it will have its own attribute that's separate. Again, watch: package SuperClass; SuperClass->add_trickle_class_attr('foo'); SuperClass->foo('bar'); package SubClass; @ISA = qw(SuperClass); print SubClass->foo(); #prints bar print SuperClass->foo(); #prints bar print SuperClass->foo('baz'); #prints baz print SubClass->foo(); #prints bar print SubClass->foo('dee'); #prints dee print SuperClass->foo(); #prints baz This is useful if you have an attribute that should be unique to a class and all subclasses. These are equivalent: package SuperClass; SuperClass->add_class_attr('foo'); package SubClass SubClass->add_class_attr('foo'); and package SuperClass; SuperClass->add_trickle_class_attr('foo'); You'll usually just use add_class_attr. Only use trickle_class_attr if you know you need to, since you rarely would. There is a *slight* bit of additional processing required for trickled accessors. trickled class attributes are automatically initialized to any values in the conf file upon adding, if present. =cut sub add_trickle_class_attr { my $pkg = shift; my $method = shift; my $f = qq{ { my \$attr = undef; my \$internalpkg = "$pkg"; my \$method = "$method"; sub { my \$pkg = shift; \$pkg = ref \$pkg ? ref \$pkg : \$pkg; #use as a class or regular method if (\@_ && \$pkg ne \$internalpkg){ my \$func = \$method; \$pkg->add_trickle_class_attr(\$func); \$pkg->\$func(\$internalpkg->\$func); #inherit the superclass class value return \$pkg->\$func(\@_); } else { \$attr = shift if \@_; return \$attr; } } } }; no strict 'refs'; *{$pkg . "::$method"} = eval $f; #if it's an internal attribute, then don't look in the conf file unless ($method =~ /^_/){ #see if there's anything in the conf file my $conf = $pkg->read_conf_file || die "Conf file error : " . $pkg->error . " " . $pkg->errcode; if ($conf->{$pkg}->{$method}){ $pkg->$method($conf->{$pkg}->{$method}); }; if (@_){ $pkg->$method(@_); }; }; return $method; }; # _accessor is the main accessor method used in the system. It defines the most simple behavior as to how objects are supposed # to work. If it's called with no arguments, it returns the value of that attribute. If it's called with arguments, # it sets the object attribute value to the FIRST argument passed and ignores the rest # # example: # my $object; # print $object->attribute7(); #prints out the value of attribute7 # print $object->attribute7('foo'); #sets the value of attribute7 to 'foo', and prints 'foo' # print $object->attribute7(); #prints out the value of attribute7, which is now known to be foo # # All internal accessor methods should behave similarly, read the documentation for add_attr for more information # # accessor is known to return errorcode MBO001 - not a class attribute, if it is accessed by a class sub _accessor { my $self = shift; my $prop = shift; return $self->error("Not a class attribute", "MBO001") unless ref $self; $self->{$prop} = shift if @_; return $self->{$prop}; }; =pod =item error and errcode error rocks. All error reporting is set and relayed through error. It's a standard accessor, and an *almost* standard mutator. The difference is that when used as a mutator, it returns undef (or an empty list) instead of the value mutated to. If a method fails, it is expected to return undef (or an empty list) and set error. example: sub someMethod { my $self = shift; my $value = shift; if ($value > 10){ return 1; #success } else { return $self->error("Values must be greater than 10"); }; }; $object->someMethod(15) || die $object->error; #succeeds $object->someMethod(5) || die $object->error; #dies with an error..."Values must be greater than 10" Be warned if your method can return '0', this is a valid successful return and shouldn't give an error. But most of the time, you're fine with "true is success, false is failure" As you can see in the example, we mutate the error attribute to the value passed, but it returns undef. However, error messages can change and can be difficult to parse. So we also have an error code, accessed by errcode. This is expected to be consistent and machine parseable. It is mutated by the second argument to ->error example: sub someMethod { my $self = shift; my $value = shift; if ($value > 10){ return 1; #success } else { return $self->error("Values must be greater than 10", "ERR77"); }; }; $object->someMethod(15) || die $object->error; #succeeds $object->someMethod(5) || die $object->errcode; #dies with an error code ... "ERR77" If your code is looking for an error, read the errcode. if a human is looking at it, display the error. Easy as pie. Both classes and objects have error methods. my $obj = Some::Class->new() || die Some::Class->error(); $obj->foo() || die $obj->error(); Note that error is a special method, and not just a normal accessor or class attribute. As such: my $obj = Some::Class->new(); Some::Class->error('foo'); print $obj->error(); #prints undef print Some::Class->error(); #prints foo i.e., you will B get a class error message by calling ->error on an object. There is also an optional third paramenter..."not logged", which sounds horribly ugly, I know. But it is a bit of an after-market hack, so it's to be expected. The third argument does what you'd think, it prevents the error message from being logged. $self->error("This is an error message", "code", "not logged"); Any true value may be passed for the 3rd argument, but something that makes it obvious what it's doing is recommended, hence my use of 'not logged'. This is useful for bubbling up errors. $class->error($self->error, $self->errcode, 'not logged'); The reason is that the error was already logged when it was stored in $self. So you'd end up logging it twice in your error file, which is very confusing. So it's recommended to use the three argument form for errors that are bubbling up, but not elsewhere. As of 3.06, if an error is returned in a list context, an empty list will be returned instead of undef. undef is still returned in a scalar context. =cut sub error { my $self = shift; my $errormethod = ref $self ? "_obj_error" : "_pkg_error"; my $codemethod = ref $self ? "_obj_errcode" : "_pkg_errcode"; if (@_){ my $error = shift; my $code = shift; my $nolog = shift || 0; $self->$errormethod($error); $self->$codemethod(defined $code ? $code : undef); $self->logToFile($self->ERRFILE, "error: $error" . (defined $code ? "\tcode : $code" : '')) if !$nolog && $self->ERRFILE && $error; return; } else { return $self->$errormethod(); }; }; =pod =item errcode errcode is an accessor ONLY. You can only mutate the errcode via error, see above. print $obj->errcode; Both objects and classes have errcode methods. my $obj = Some::Class->new() || die Some::Class->errcode(); $obj->foo() || die $obj->errcode(); Where possible, the pod will note errors that a method is known to be able to return. Please note that this will B be an all inclusive list of all error codes that may possibly ever be returned by this method. Only error codes generated by a particular method will be listed. =cut sub errcode { my $self = shift; my $method = ref $self ? "_obj_errcode" : "_pkg_errcode"; return $self->$method(@_); }; =pod =item errstring errstring is just a quick alias for: $bulk->error . ": " . $bulk->errcode; Nothing more. =cut sub errstring { my $self = shift; return (defined $self->error ? $self->error : '') . "...with code (" . (defined $self->errcode ? $self->errcode : '') . ")"; }; =pod =item errvals similar to errstring, but returns the error and errcode in an array. This is great for bubbling up error messages. $attribute = $obj->foo() || return $self->error($obj->errvals); =cut sub errvals { my $self = shift; my @return = (); if (defined $self->error) { push @return, $self->error; } elsif (defined $self->errcode) { push @return, undef; }; if (defined $self->errcode) { push @return, $self->errcode; }; return @return; }; =pod =item read_conf_file read_conf_file will read in the conf files specified in the @conf_files array up at the top. You can also pass in a list of conf files to read, in most to least significant order, same as the @conf_files array. my $conf = Mail::Bulkmail::Object->read_conf_file(); or my $conf = Mail::Bulkmail::Object->read_conf_file('/other/conf.file'); If you pass in a list of conf files, then the internal @conf_files array is bypassed. $conf is a hashref of hashrefs. the main keys are the package names, the values are the hashes of the values for that object. Example: #conf file define package Mail::Bulkmail use_envelope = 1 Trusting @= duplicates define package Mail::Bulkmail::Server Smtp = your.smtp.com Port = 25 $conf = { 'Mail::Bulkmail' => { 'use_envelope' => 1, 'Trusting' => ['duplicates'] }, 'Mail::Bulkmail::Server' => { 'Smtp' => 'your.smtp.com', 'Port' => 25 } }; read_conf_file is called at object initialization. Any defaults for your object are read in at this time. You'll rarely need to read the conf file yourself, since at object creation it is read and parsed and the values passed on. B The conf file is only re-read if it has been modified since the last time it was read. this method is known to be able to return MBO002 - Invalid conf file =cut { my $global_conf = {}; my $loaded = {}; sub read_conf_file { my $class = shift; my @confs = reverse(@_ ? @_ : $class->conf_files()); my $conf = @_ ? {} : $global_conf; foreach my $conf_file (@confs){ next unless -e $conf_file ; if (! $loaded->{$conf_file} || -M $conf_file <= 0){ my $pkg = $default_package; open (CONF, $conf_file) || next; while (my $line = ) { next if ! defined $line || $line =~ /^\s*#/ || $line =~ /^\s*$/; if ($line =~ /define package\s+(\S+)/){ $pkg = $1; next; }; $line =~ s/(?:^\s+|\s+$)//g; $line =~ /^(?:\s*(\d+)\s*:)?\s*(\w+)\s*(@?)=\s*(.+)/ || return $class->error("Invalid conf file : $line", "MBO002"); my ($user, $key, $array, $val) = ($1, $2, $3, $4); unless (defined $val){ ($user, $key, $array, $val) = ($user, $key, undef, $array); }; unless (defined $array){ ($user, $key, $array, $val) = (undef, $user, $array, $key); }; ($user, $key, $val) = (undef, $user, $key) unless defined $val; next if defined $user && $user != $>; $val = undef if $val eq 'undef'; $val = eval qq{return "$val"} if defined $val && $val =~ /^\\/; if ($array) { $conf->{$pkg}->{$key} ||= []; push @{$conf->{$pkg}->{$key}}, $val; } else { $conf->{$pkg}->{$key} = $val; }; }; #end while $loaded->{$conf_file} = 1 unless @_; }; #end if }; #end foreach return $conf; }; #end sub }; =pod =item gen_handle returns a filehandle in a different package. Useful for when you need to open filehandles and pass 'em around. my $handle = Mail::Bulkmail->gen_handle(); open ($handle, "/path/to/my/list"); my $bulk = Mail::Bulkmail->new( 'LIST' => $handle ); You never need to use gen_handle if you don't want to. It's used extensively internally, though. =cut { my $handle = 0; sub gen_handle { no strict 'refs'; my $self = shift; return \*{"Mail::BulkMail::Handle::HANDLE" . $handle++}; #You'll note that I don't want my #namespace polluted either }; }; =pod =item new Finally! The B. It's very easy, for a minimalist object, do this: my $obj = Class->new() || die Class->error(); Ta da! You have an object. Any attributes specified in the conf file will be loaded into your object. So if your conf file defines 'foo' as 'bar', then $obj->foo will now equal 'bar'. If you'd like, you can also pass in method/value pairs to the constructor. my $obj = Class->new( 'attribute' => '17', 'foo' => 'baz', 'method' => '88' ) || die Class->error(); This is (roughly) the same as: my $obj = Class->new() || die Class->error(); $obj->attribute(17) || die $obj->error(); $obj->foo('baz') || die $obj->error(); $obj->method(88) || die $obj->error(); Any accessors or methods you'd like may be passed to the constructor. Any unknown pairs will be silently ignored. If you pass a method/value pair to the constructor, it will override any equivalent method/value pair in the conf file. Additionally, if you need to set up values in your object, this is the place to do it. Note that setting default values should probably be done in the conf file, but if you need to populate a data structure into a method, do it here. package SubClass; @ISA = qw(SuperClass); sub new { return shift->new( 'servers' => [], 'connections' => {}, @_ ); }; This will cause your SubClass to use the normal constructor, but get default values of the empty data structures specified. =cut sub new { my $class = shift; my $self = bless {}, $class; return $self->init( @_ ) || $class->error($self->error, $self->errcode, 'not logged'); }; =pod =item init The object initializer. Arguably more important than the constructor, but not something you need to worry about. The constructor calls it internally, and you really shouldn't touch it or override it. But I wanted it here so you know what it does. Simply, it iterates through the conf file and mutates any of your object attributes to the value specified in the conf file. It then iterates through the hash you passed to ->new() and does the same thing, overriding any conf values, if necessary. init is smart enough to use all super class values defined in the conf file, in hierarchy order. So if your conf file contains: define package SuperClass foo = 'bar' And you're creating a new SubClass object, then it will get the default of foo = 'bar' as in the conf file, despite the fact that it was not defined for your own package. Naturally, the more significant definition is used. define package SuperClass foo = 'bar' define package SubClass foo = 'baz' SuperClass objects will default foo to 'bar', SubClass objects will default foo to 'baz' this method is known to be able to return MBO003 - could not initialize value to conf value MBO004 - could not initialize value to constructor value MBO006 - odd number of elements in hash assignment =cut sub init { my $self = shift; my $class = ref $self; # my %init = @_; my $conf = $self->read_conf_file || die "Conf file error : " . $self->error . " " . $self->errcode; #initialize our defaults from the conf file foreach my $pkg (@{$class->isa_path() || []}){ foreach my $method (keys %{$conf->{$pkg}}){ if ($self->can($method)){ $self->error(undef); $self->errcode(undef); my $return = $self->$method($conf->{$pkg}->{$method}) if $self->can($method); my $value = defined $conf->{$pkg}->{$method} ? $conf->{$pkg}->{$method} : 'value is undef'; return $self->error("Could not initilize method ($method) to value ($value)" . (defined $self->error ? " : " . $self->error : '') , ($self->errcode || "MBO003") ) unless defined $return; }; }; }; #initialize our defaults as passed in to the constructor # foreach my $method (keys %init){ while (@_) { my $method = shift; my $value = undef; if (@_){ $value = shift; } else { return $self->error("Odd number of elements in hash assignment", "MBO006"); }; if ($self->can($method)){ $self->error(undef); $self->errcode(undef); #my $return = $self->$method($init{$method}); my $return = $self->$method($value); #my $value = defined $init{$method} ? $init{$method} : 'value is undef'; my $errval = defined $value ? $value : 'value is undef'; return $self->error("Could not initilize method ($method) to value ($errval)" . (defined $self->error ? " : " . $self->error : '') , ($self->errcode || "MBO004") ) unless defined $return; }; }; return $self; }; =pod =item isa_path This is mainly used by the conf reader, but I wanted to make it publicly accessible. Given a class, it will return an arrayref containing all of the superclasses of that class, in inheritence order. Note that once a path is looked up for a class, it is cached. So if you dynamically change @ISA, it won't be reflected in the return of isa_path. Obviously, dynamically changing @ISA is frowned upon as a result. =cut { my $paths = {}; sub isa_path { my $class = shift; my $seen = shift || {}; return undef if $seen->{$class}++; return $paths->{$class} if $paths->{$class}; no strict 'refs'; my @i = @{$class . "::ISA"}; my @s = ($class); foreach my $super (@i){ next if $seen->{$super}; #my $super_isa = $super->can('isa_path') ? $super->isa_path($seen) : []; my $super_isa = isa_path($super, $seen); push @s, @$super_isa; }; @s = reverse @s; #we want to look at least significant first $paths->{$class} = \@s; return \@s; }; }; # _file_accessor is an internal accessor for accessing external information. Said external information can be in # the form of a file (either a globref or a string containing the path/to/the/file), an arrayref, or a coderef # It will open up path/to/file strings and create an internal filehandle. it also makes sure that all filehandles # are piping hot. Look at getNextLine and logToFile to see examples of how to deal with a value that is # set via _file_accessor # # _file_accessor expects a token to tell it which way the IO goes, either "<", ">", or ">>" # # i.e., __PACKAGE__->add_attr(["LIST", '_file_accessor'], "<"); # i.e., __PACKAGE__->add_attr(["GOOD", '_file_accessor'], ">>"); sub _file_accessor { my $self = shift; my $prop = shift; my $IO = shift; my $file = shift; if (defined $file){ if (! ref $file) { my $handle = $self->gen_handle(); if ($IO =~ /^(?:>>?|<)$/){ open ($handle, $IO . $file) || return $self->error("Could not open file $file : $!", "MB702"); select((select($handle), $| = 1)[0]); #Make sure the file is piping hot! return $self->$prop($handle); } else { return $self->error("Invalid IO : $IO, must be '>', '>>', '<'", "MB703"); }; } elsif (ref ($file) =~ /^(?:GLOB|ARRAY|CODE)$/){ select((select($file), $| = 1)[0]) if ref $file eq "GLOB"; #Make sure the file is piping hot! return $self->$prop($file); } else { return $self->error("File error. I don't know what a $file is", "MB701"); }; } else { return $self->$prop(); }; }; =pod =item getNextLine getNextLine is called on either a filehandleref, an arrayref, or a coderef $obj->getNextLine(\*FOO); will return the next line off of FOO; $obj->getNextLine(\@foo); will shift the next line off of @foo and return it. $obj->getNextLine(\&foo); will call foo($obj) and return whatever the function returns. Note that your bulkmail object is the first argument passed to your function. It's not called as a method, but the object is still the first argument passed. This is mainly used with attribues going through _file_accessor. package SomeClass; SomeClass->add_attr(['FOO', '_file_accessor'], "<"); my $obj = SomeClass->new( FOO => \&foo ) || die SomeClass->error(); my $val = $obj->getNextLine($obj->FOO); =cut sub getNextLine { my $self = shift; my $list = shift || $self->LIST() || return $self->error("Cannot get next line w/o list", "MB045"); if (ref $list eq "GLOB"){ my $email = scalar <$list>; return undef unless defined $email; chomp $email; return $email; } elsif (ref $list eq "ARRAY"){ return shift @$list; } elsif (ref $list eq "CODE"){ return $list->($self); } else { return $self->error("Cannot get next line...don't know what a $list is", "MB046"); }; }; =pod =item logToFile logToFile is the opposite of getNextLine, it writes out a value instead of reading it. logToFile is called on either a filehandleref, an arrayref, or a coderef $obj->logToFile(\*FOO, "bar"); will append a new line to FOO, "bar" $obj->logToFile(\@foo, "bar"); will push the value "bar" onto the end of @foo $obj->logToFile(\&foo, "bar"); will call foo($obj, "bar") Note that your bulkmail object is the first argument passed to your function. It's not called as a method, but the object is still the first argument passed. This is mainly used with attribues going through _file_accessor. package SomeClass; SomeClass->add_attr(['FOO', '_file_accessor'], ">>"); my $obj = SomeClass->new( FOO => \&foo ) || die SomeClass->error(); my $val = $obj->logToFile($obj->FOO, "valid address); Internally, logToFile calls convert_to_scalar on the value it is called with. This method is known to be able to return: MBO005 - cannot log to file =cut sub logToFile { my $self = shift; my $file = shift || return $self->error("Cannot log to file w/o file", "MB047"); my $value = shift; $value = $self->convert_to_scalar($value); if (ref $file eq "GLOB"){ print $file $value, "\015\012" if $value; return 1; } elsif (ref $file eq 'ARRAY'){ push @$file, $value; return 1; } elsif (ref $file eq "CODE"){ $file->($self, $value); return 1; } else { return $self->error("Cannot log to file...don't know what a $file is", "MBO005"); }; }; =pod =item convert_to_scalar called by logToFile. used to convert the value passed to a scalar. Mail::Bulkmail::Object's convert_to_scalar method will only handle scalars, it will dereference scalarrefs, or return scalar values. This method will also strip out any carriage returns or newlines within the scalar before returning it. If passed by reference, your original variable will not be modified. This is useful to subclass if you ever want to log values other than simple scalars =cut sub convert_to_scalar { my $self = shift; my $value = shift; my $v2 = ref $value ? $$value : $value; $v2 =~ s/[\015\012]//g if defined $v2; return $v2; }; #internal attributes, for storing error information # _obj_error is the object attribute slot for storing the most recent error that occurred. It is # set via the first argument to the ->error method when called with an object. # i.e., $obj->error('foo', 'bar'); #_obj_error is 'foo' __PACKAGE__->add_attr('_obj_error'); # _obj_errcode is the object attribute slot for storing the most recent error code that occurred. It is # set via the second argument to the ->error method when called with an object. # i.e., $obj->error('foo', 'bar'); #_obj_errcode is 'bar' __PACKAGE__->add_attr('_obj_errcode'); # _pkg_error is the class attribute slot for storing the most recent error that occurred. It is # set via the first argument to the ->error method when called with a class. # i.e., $class->error('foo', 'bar'); #_pkg_error is 'foo' __PACKAGE__->add_trickle_class_attr('_pkg_error'); # _pkg_errcode is the class attribute slot for storing the most recent error code that occurred. It is # set via the second argument to the ->error method when called with a class. # i.e., $class->error('foo', 'bar'); #_pkg_errcode is 'bar' __PACKAGE__->add_trickle_class_attr('_pkg_errcode'); #and for logging errors, if desired # _ERRFILE internally stores the ERRFILE parameter, if it is set. See the documentation for ERRFILE, below. # _ERRFILE needs to exist because add_class_attr and add_trickle_class_attr do not have add_attr's additional # powers to create attributes with non-standard accessors. __PACKAGE__->add_class_attr('_ERRFILE'); =pod =item ERRFILE This is an optional log file to keep track of any errors that occur. ERRFILE may be either a coderef, globref, arrayref, or string literal. If a string literal, then Mail::Bulkmail::Object will attempt to open that file (in append mode) as your log: $bulk->ERRFILE("/path/to/my/error.file"); If a globref, it is assumed to be an open filehandle in append mode: open (E, ">>/path/to/my/error.file"); $bulk->ERRFILE(\*E); if a coderef, it is assumed to be a function to call with the address as an argument: sub E { print "ERROR : ", shift, "\n"}; #or whatever your code is $bulk->ERRFILE(\&E); if an arrayref, then bad addresses will be pushed on to the end of it $bulk->ERRFILE(\@errors); Use whichever item is most convenient, and Mail::Bulkmail::Object will take it from there. It is recommended you turn on ERRFILE in a debugging envrionment, and leave it off in production. You probably shouldn't be getting errors in a production environment, but there may be internal errors that you're not even aware of, so you'll end up filling up that file. And there's the slight additional overhead. Keep it on in production if you know what you're doing, off otherwise. =cut sub ERRFILE { my $self = shift; if (@_){ my $file = shift; $self->_file_accessor("_ERRFILE", ">>", $file); } else { return $self->_ERRFILE(); }; }; 1; __END__ =pod =back =head1 CONF FILE specification Your conf files are very important. You did specify them up in the @conf_files list above, right? Of course you did. But now you need to know how they look. They're pretty easy. Each line of the conf file is a name = value pair. ERRFILE = /path/to/err.file Do not put the value in quotes, or they will be assigned. ERRFILE = /path/to/err.file #ERRFILE is /path/to/err.file ERRFILE = "/path/to/err.file" #ERRFILE is "/path/to/err.file" the conf file is analyzed by the object initializer, and then each value is passed to the appropriate object upon object creation. So, in this case your ERRFILE class_attribute would be set to ERRFILE leading and trailing whitespace is stripped. so these are all the same: ERRFILE = /path/to/err.file ERRFILE = /path/to/err.file ERRFILE = /path/to/err.file ^^^^^extra spaces Your conf file is read by read_conf_file. As you saw in the docs for read_conf_file, it creates a hashref. The top hashref has keys of package names, and the conf->{package} hashref is the name value pairs. To do that, you'll need to define which package you're looking at. define package SomeClass define package OtherClass ERRFILE = /path/to/err.file So ERRFILE is now defined for OtherClass, but not for SomeClass (unless of course, OtherClass is a sub-class of SomeClass) If you do not define a package, then the default package is assumed. Multiple entries in a conf file take the last one. define package SomeClass ERRFILE = /path/to/err.file ERRFILE = /path/to/err.other.file so SomeClass->ERRFILE is /path/to/err.other.file There is no way to programmatically access /path/to/err.file, the value was destroyed, even though it is still in the conf file. There is one magic value token...undef ERRFILE = undef This will set ERRFILE to the perl value 'undef', as opposed to the literal string "undef" Sometimes, you will want to give a conf entry multiple values. Then, use the @= syntax. define package SomeClass foo = 7 bar @= 8 bar @= 9 SomeClass->foo will be 7, SomeClass->bar will be [8, 9] There is no way to assign a value more complex than a scalar or an arrayref. Comments are lines that begin with a # #enter the SomeClass package define package SomeClass #connections stores the maximum number of connections we want connections = 7 If you want to get *really* fancy, you can restrict values to the user that is running the script. Use the :ID syntax for that. define package SomeClass #everyone else gets this value foo = 11 #user 87 gets this value 87:foo = 9 #user 93 gets this value 93:foo = 10 Note that a default value must be listed FIRST, or it will override any user specific values. =head1 SAMPLE CONF FILE #this is in the default package ERRFILE = /path/to/err.file define package Mail::Bulkmail::Server #set our Smtp Server Smtp = your.smtp.cpm #set our Port Port = 25 define package JIM::SubClass #store the IDs of the server objects we want to use by default servers @= 7 servers @= 19 servers @= 34 =head1 GRAMMAR In fact, we'll even get fancy, and specify an ABNF grammar for the conf file. CONFFILE = *(LINE "\n") ; a conf file consists of 0 or more lines LINE = ( DEFINE ; definition line / COMMENT ; comment line / EQUATION ; equation line / *(WSP) ; blank line ) "\n" ; followed by a newline character DEFINE = %b100 %b101 %b102 %b105 %b110 %b101 %b32 %b112 %b97 %b99 %b107 %b97 %b103 %b101 TEXT ; the literal string "define package" in lower case, followed by TEXT COMMENT = *(WSP) "#" TEXT EQUATION = *(WSP) (VARIABLE / USER_VARIABLE) *(WSP) EQUATION_SYMBOL *(WSP) VALUE *(WSP) USER_VARIABLE = USER *(WSP) ":" *(WSP) VARIABLE USER = 1*(DIGIT) EQUATION_SYMBOL = "=" / "@=" VALUE = *(TEXT) USER_VARIABLE = *(TEXT) TEXT = VISIBLE *(VISIBLE / WSP) [VISIBLE] VISIBLE = %d33-%d126 ; visible ascii characters =head1 SEE ALSO Mail::Bulkmail, Mail::Bulkmail::Server =head1 COPYRIGHT (again) Copyright and (c) 1999, 2000, 2001, 2002, 2003 James A Thomason III (jim@jimandkoka.com). All rights reserved. Mail::Bulkmail::Object is distributed under the terms of the Perl Artistic License. =head1 CONTACT INFO So you don't have to scroll all the way back to the top, I'm Jim Thomason (jim@jimandkoka.com) and feedback is appreciated. Bug reports/suggestions/questions/etc. Hell, drop me a line to let me know that you're using the module and that it's made your life easier. :-) =cut =cut libmail-bulkmail-perl-3.12.orig/Bulkmail/Server.pm0100644000175000017500000007646107771666314020635 0ustar jojojojopackage Mail::Bulkmail::Server; # Copyright and (c) 1999, 2000, 2001, 2002, 2003 James A Thomason III (jim@jimandkoka.com). All rights reserved. # Mail::Bulkmail::Server is distributed under the terms of the Perl Artistic License. =pod =head1 NAME Mail::Bulkmail::Server - handles server connections and communication for Mail::Bulkmail =head1 AUTHOR Jim Thomason, jim@jimandkoka.com =head1 SYNOPSIS my $server = Mail::Bulkmail::Server->new( 'Smtp' => 'your.smtp.com', 'Port' => 25 ) || die Mail::Bulkmail::Server->error(); #connect to the SMTP relay $server->connect || die $server->error(); #talk to the server my $response = $server->talk_and_respond("RSET"); =head1 DESCRIPTION Mail::Bulkmail::Server now handles server connections. Mail::Bulkmail 1.x and 2.x had all the server functionality built into the module itself. That was nice in terms of simplicity - one module, one connection, one server, and so on. But it had some downsides. For one thing, it only allowed for one connection. And since I wanted to allow multiple server connections in 3.00, that had to go. For another, it was a pain in the butt to change the server implementation. This way, you can easily write your own server class, drop it in here, and be off to the races. For example, the Mail::Bulkmail::DummyServer module for debugging purposes. This is not a module that you'll really need to access directly, since it is accessed internally by Mail::Bulkmail when it is needed. Specify the data you need in the conf file and the server_file attribute, and you won't ever need to touch this directly. =cut use Mail::Bulkmail::Object; @ISA = Mail::Bulkmail::Object; $VERSION = '3.12'; use Socket; use 5.6.0; use Data::Dumper (); use strict; use warnings; =pod =head1 ATTRIBUTES =over 11 =item Smtp stores the Smtp relay's address. $server->Smtp("your.smtp.com"); can either be an IP or a named address Smtp values should be set in your server file. =cut __PACKAGE__->add_attr('Smtp'); =pod =item Port stores the port on which you'll try to connect to the SMTP relay. Probably going to be 25, since that's the standard SMTP port. $server->Port(25); Port values should be set in either your server file, or a single default in your conf file. =cut __PACKAGE__->add_attr('Port'); =pod =item Domain When you connect to an SMTP server, you must say hello and state your domain. This is your domain that you use to say hello. $server->Domain('mydomain.com'); This should be the same name of the domain of the machine that you are connecting on. Domain should be set in your conf file. =cut __PACKAGE__->add_attr('Domain'); =pod =item Tries When you try to connect to an SMTP server via ->connect, you may have issues with creating the socket or making the connection. Tries specifies how many times you should re-try making the socket or making the connection before failing to connect. Make this a small number. $server->Tries(5); Tries should be set in your conf file. =cut __PACKAGE__->add_attr('Tries'); =pod =item max_connection_attempts This is similar to Tries, but this governs the number of times that you can call the ->connect method. When you have multiple servers in Mail::Bulkmail's ->servers array, there's no point in constantly re-trying to connect to a server that fails. it'll just slow you down. max_connection_attempts makes sure that you stop trying to connect to invalid servers. Make this a small number as well. $server->max_connection_attempts(7); max_connection_attempts should be set in your conf file. =cut __PACKAGE__->add_attr('max_connection_attempts'); =pod =item envelope_limit It's entirely likely that with a very large list you'll have a very large number of people in the same domain. For instance, there are an awful lot of people that have yahoo addresses. So, for example, say that you have a list of 100,000 people and 20,000 of them are in the yahoo.com domain and you're sending using the envelope. That means that the server at yahoo.com is going to receive one message with 20,000 people in the envelope! Now, this might be a bad thing. We don't know if the yahoo.com mail server will actually process a message with 20,000 envelope recipients. It may or may not and the only way to find out is to try it. If it does work, then great no worries. But if it doesn't, then you're stuck. If you stop using envelope sending, you sacrifice its major speed gains, but if you keep using it you can't send to yahoo.com. I fixes that. envelope_limit is precisely what it sounds like, it allows you to specify a limit on the number of recipients that will be specified in your envelope. That way, with our previous example, you can specify an envelope limit of 1000, for example. $bulk->envelope_limit(1000); This means that yahoo.com will get 20 messages, each with 1000 recipients in the envelope. Of course, this still may not be small enough, so you can tweak it as much as necessary. Setting an envelope limit does trade off some of the gains from using the envelope, but it's still over all a vast speed boost over not using it. envelope_limit should be set in your conf file. I recommend setting it to 100, but tweak it as necessary. Higher values allow you to send more information and do it faster, but you're more likely to run into server's that refuse that many recipients. Lower values are more compatible, but slightly slower. Set envelope_limit to 0 for an infinite limit. You should never have to set it below 100 (unless you're using an infinite limit), since RFC 2822 says that SMTP servers should always accept at least 100 recipients in the envelope =cut __PACKAGE__->add_attr('envelope_limit'); =pod =item max_messages max_messages sets the maximum number of messages to send to a particular server. This is mainly useful if you're bulkmailing to multiple servers. You may have a server that can take some of the load, but not much of it. Assume that your list has over 100,000 people on it, and you're using one primary SMTP relay and one smaller SMTP relay to help take some of the load off of the main one. Your primary SMTP server can handle lots of messages, but your smaller one can only take a smaller load. That'd a good place for max_messages. $aux_server->max_messages(10000); That way, your smaller server will relay no more than 10,000 messages. Set max_messages to 0 for an infinite number of messages to go through the server. It is recommended to set max_messages to 0. =cut __PACKAGE__->add_attr('max_messages'); =pod =item max_messages_per_robin when you set up your bulkmail object with multiple servers, max_messages_per_robin is used to determine how many messages are sent to a server before moving onto the next. This is the maximum number of messages that would be sent to a server in a given iteration before moving on to the next, but it is not necessarily the exact number of messages that will be sent. If the server has reached the maximum number of messages allowed, or the maximum number in a given connection, it will jump to the next server before reaching the robin limit. Set max_messages_per_robin to 0 for an infinite number of messages allowed on a given server iteration. It is recommended to set this to 500 if you're using multiple servers, and to 0 if you're using 1 server. The message robin counter is reset by reset_all_counters =cut __PACKAGE__->add_attr('max_messages_per_robin'); =pod =item max_messages_per_connection This sets the maximum number of messages that would be sent to a given SMTP relay in a given connection. When this limit is reached, the server will disconnect and return that it has reached a limit. set max_messages_per_connection to 0 for infinite messages per connection. It is recommended to keep this at 0. The message connection counter is reset by reset_all_counters =cut __PACKAGE__->add_attr('max_messages_per_connection'); =pod =item max_messages_while_awake Sometimes, it may be useful to pause and give your server a break. max_messages_while_awake allows this. This will specify the number of messages to send to a server before going to sleep for a certain period of time. $server->max_messages_while_awake(100); Will send 100 messages to the server and then go to sleep. for the time specified by sleep_length. Note that reaching this limit will not cause reached_limit to return a true value, so in a multi-server environment, you'll end up sleeping a lot. The message-while-awake counter is reset by reset_all_counters, so it is of dubious utility when using multiple servers. Set max_messages_while_awake to 0 to never sleep. It is recommended to have max_messages_while_awake set to 0 when using multiple servers. Set it to a positive number when using one server. =cut __PACKAGE__->add_attr('max_messages_while_awake'); =pod =item sleep_length Specifies the time to sleep (in seconds) if the server has reached the max_messages_while_awake limit. =cut __PACKAGE__->add_attr('sleep_length'); =pod =item talk_attempts The response codes for SMTP are pretty rigorously defined, which is obviously very usefull. a 5xy error is permanently fatal. a 4xy error is temporarily fatal. It is recommended that if a 4xy error is encountered, that the client (us) should try re-sending the same command again. talk_attempts specifies the number of times to try resending a command after receiving a 400 level error from the server. $server->talk_attempts(5); =cut __PACKAGE__->add_attr('talk_attempts'); =pod =item time_out We can *finally* time out! So if your SMTP relay doesn't respond for a set period of time, the connection will automatically disconnect and fail with an error. Set this to something high, the value is in seconds. $server->time_out(3000); # 5 minutes =cut __PACKAGE__->add_attr('time_out'); =pod =item time_of_last_message stores the time that the last message was sent through this server, in epoch seconds. =cut __PACKAGE__->add_attr('time_of_last_message'); =pod =item connected boolean attribute that says whether or not this server object is connected to an SMTP relay. Don't set this value, only read it. =cut __PACKAGE__->add_attr('connected'); # _not_worthless is the internal counter used for the number of failed connections attempted on a server # why not _connection_attempts or the like to be consistent? I just liked the way the method sounded more # $self->connect if $self->_not_worthless; __PACKAGE__->add_attr('_not_worthless'); # internal counter for the total number of messages sent to this server object __PACKAGE__->add_attr('_sent_messages'); # internal counter for the total number of messages sent to this server object during this "robin" # this value is reset by reset_message_counters or by reached_limit if the max_messages_per_robin limit is reached __PACKAGE__->add_attr('_sent_messages_this_robin'); # internal counter for the total number of messages sent to this server object during the current envelope # this value is reset by reset_message_counters # this counter can be accessed externally via the method "reached_envelope_limit" __PACKAGE__->add_attr('_sent_messages_this_envelope'); # internal counter for the total number of messages sent to this server object during this connection # this value is reset by reset_message_counters or by reached_limit if the max_messages_per_connection limit is # reached. Additionally, reached_limit will disconnect the server if this limit is reached __PACKAGE__->add_attr('_sent_messages_this_connection'); # internal counter for the total number of messages sent to this server object before sleeping # this value is reset by reset_message_counters or by reached_limit if the max_messages_while_awake limit is # reached. Additionally, reached_limit will sleep for the amount of time specified by sleep_length, if # sleep_length is specified __PACKAGE__->add_attr('_sent_messages_while_awake'); =pod =item CONVERSATION This is an optional log file to keep track of your SMTP conversations CONVERSATION may be either a coderef, globref, arrayref, or string literal. If a string literal, then Mail::Bulkmail::Server will attempt to open that file (in append mode) as your log: $server->CONVERSATION("/path/to/my/conversation"); If a globref, it is assumed to be an open filehandle in append mode: open (C, ">>/path/to/my/conversation"); $server->CONVERSATION(\*C); if a coderef, it is assumed to be a function to call with the address as an argument: sub C { print "CONVERSATION : ", $_[1], "\n"}; #or whatever your code is $server->CONVERSATION(\&C); if an arrayref, then the conversation will be pushed on to the end of it $server->CONVERSATION(\@conversation); Use whichever item is most convenient, and Mail::Bulkmail::Server will take it from there. B: This file is going to get B. Massively huge. You should only turn this on for debugging purposes and B in a production environment. It will log the first 50 characters of a message sent to the server, and the full server response. =cut __PACKAGE__->add_attr(['CONVERSATION', '_file_accessor'], '>>'); =pod =item socket socket contains the socket that this Server has opened to its SMTP relay. You'll probably never talk to this directly, but it's here, just in case you want it. =cut __PACKAGE__->add_attr('socket'); #this is a hashref to internally store our ESMTP options received from EHLO __PACKAGE__->add_attr('_esmtp'); =pod =back =head1 METHODS =over 11 =item increment_messages_sent This method will increment the server object's internal counters storing the total number of messages sent, the total sent this robin, the total sent this connection, the total sent while awake, and the total sent this envelope. It will also store the time the last message is sent. =cut sub increment_messages_sent { my $self = shift; $self->_sent_messages($self->_sent_messages + 1); $self->_sent_messages_this_robin($self->_sent_messages_this_robin + 1); $self->_sent_messages_this_connection($self->_sent_messages_this_connection + 1); $self->_sent_messages_while_awake($self->_sent_messages_while_awake + 1); $self->_sent_messages_this_envelope($self->_sent_messages_this_envelope + 1); $self->time_of_last_message(time); return $self; }; =pod =item reset_message_counters This message will reset the internal counters for the messages sent this robin, messages sent this connection, and messages sent while awake back to 0. =cut sub reset_message_counters { my $self = shift; #$self->_sent_messages(0); #this never gets reset $self->_sent_messages_this_robin(0); #$self->_sent_messages_this_connection(0); #this gets set upon connect $self->_sent_messages_while_awake(0); $self->_sent_messages_this_envelope(0); return $self; }; =pod =item reset_envelope_counter The envelope counter behaves slightly differently than the other counters, so we have a separate method to reset the internal envelope counter. =cut sub reset_envelope_counter { my $self = shift; $self->_sent_messages_this_envelope(0); return $self; }; =pod =item reached_envelope_limit This method returns 1 if we've reached the envelope limit, 0 otherwise =cut sub reached_envelope_limit { my $self = shift; return 1 if $self->envelope_limit && $self->_sent_messages_this_envelope >= $self->envelope_limit; }; =pod =item reached_limit This method will tell you if the server has reached the max_messages, max_messages_per_connection, or max_messages_per_robin limits. Also, if you reach the max_messages_while_awake limit, this method will cause you to sleep for the time period specified in sleep_length Return values: 1 : reached max_messages limit, server becomes worthless and will not be used again 2 : reached max_messages_per_connection limit, server will disconnect 3 : reached max_messages_per_robin limit =cut sub reached_limit { my $self = shift; #sleep if we're supposed to sleep if ($self->max_messages_while_awake && $self->_sent_messages_while_awake >= $self->max_messages_while_awake){ sleep $self->sleep_length if $self->sleep_length; $self->_sent_messages_while_awake(0); }; if ($self->max_messages && $self->_sent_messages >= $self->max_messages){ $self->disconnect(); $self->_sent_messages_this_connection(0); $self->_sent_messages_this_robin(0); $self->_not_worthless(0); return 1; } elsif ($self->max_messages_per_connection && $self->_sent_messages_this_connection >= $self->max_messages_per_connection){ $self->disconnect(); $self->_sent_messages_this_connection(0); $self->_sent_messages_this_robin(0); return 2; } elsif ($self->max_messages_per_robin && $self->_sent_messages_this_robin >= $self->max_messages_per_robin){ $self->_sent_messages_this_robin(0); return 3; } #otherwise, we've reached no limits else { return 0; }; }; =pod =item new Standard constructor. See Mail::Bulkmail::Object for more information. =cut sub new { my $self = shift->SUPER::new( '_sent_messages' => 0, '_sent_messages_this_robin' => 0, '_sent_messages_this_connection' => 0, '_sent_messages_while_awake' => 0, '_sent_messages_this_envelope' => 0, 'connected' => 0, '_esmtp' => {}, '_not_worthless' => 5, #default to 5 regardless of the conf file @_ ) || return undef; $self->_not_worthless($self->max_connection_attempts) if $self->max_connection_attempts; return $self; }; =pod =item connect Connects this server object to the SMTP relay specified with ->Smtp and ->Port This method will set ->connected to 1 if it successfully connects. $server->connect() || die "Could not connect : " . $server->error; Upon connection, ->connect will issue a HELO command for the ->Domain specified. This method is known to be able to return: MBS001 - cannot connect to worthless servers MBS002 - could not make socket MBS003 - could not connect to server MBS004 - no response from server MBS005 - server won't say HELO MBS010 - can't greet server w/o domain MBS011 - server gave an error for EHLO MBS015 - timed out waiting for response upon connect MBS016 - server didn't respond to EHLO, trying HELO (non-returning error) MBS017 - cannot connect to server, no Tries parameter =cut sub connect { my $self = shift; return $self if $self->connected(); #if we have no Tries parameter, then the server is unquestionably worthless unless ($self->Tries) { $self->_not_worthless(0); return $self->error("Cannot connect to server - no Tries parameter set", "MBS017"); }; #if we have no Domain, then the server is unquestionably worthless unless ($self->Domain) { $self->_not_worthless(0); return $self->error("Cannot greet server without domain", "MBS010"); }; return $self->error("Cannot connect to worthless servers", "MBS001") unless $self->_not_worthless > 0; my $bulk = $self->gen_handle(); my ($s_tries, $c_tries) = ($self->Tries, $self->Tries); 1 while ($s_tries-- && ! socket($bulk, PF_INET, SOCK_STREAM, getprotobyname('tcp'))); if ($s_tries < 0){ $self->_not_worthless($self->_not_worthless - 1); return $self->error("Could not make socket for " . $self->Smtp . ", Socket error ($!)", "MBS002"); } else { my $paddr = sockaddr_in($self->Port, inet_aton($self->Smtp)); 1 while ! connect($bulk, $paddr) && $c_tries--; if ($c_tries < 0){ $self->_not_worthless($self->_not_worthless - 1); return $self->error("Could not connect to " . $self->Smtp . ", Connect error ($!)", "MBS003") if $c_tries < 0; } else { $@ = undef; eval { local $SIG{"ALRM"} = sub {die "timed out"}; eval{ alarm($self->time_out) if $self->time_out; }; #catch it in case alarm isn't implemented (stupid windows) #keep our bulk pipes piping hot. select((select($bulk), $| = 1)[0]); local $\ = "\015\012"; local $/ = "\015\012"; my $response = <$bulk> || ""; if (! $response || $response =~ /^[45]/) { $self->_not_worthless($self->_not_worthless - 1); return $self->error("No response from server: $response", "MBS004"); }; #grab our domain my $domain = $self->Domain; #first, we'll try to say EHLO print $bulk "EHLO $domain"; $response = <$bulk> || ""; #log our conversation, if desired. if ($self->CONVERSATION){ $self->logToFile($self->CONVERSATION, "Said to server: 'EHLO'"); $self->logToFile($self->CONVERSATION, "\tServer replied: '$response'"); }; #now, if the server didn't respond or gave us an error, we'll fall back and try saying HELO instead if (! $response || $response =~ /^[45]/){ $self->error("Server did not respond to EHLO...trying HELO", "MBS016"); print $bulk "HELO $domain"; $response = <$bulk> || ""; #log our conversation, if desired if ($self->CONVERSATION){ $self->logToFile($self->CONVERSATION, "Said to server: 'HELO'"); $self->logToFile($self->CONVERSATION, "\tServer replied: '$response'"); }; if (! $response || $response =~ /^[45]/) { $self->_not_worthless($self->_not_worthless - 1); return $self->error("Server won't say HELO: $response", "MBS005"); }; } #otherwise, it accepted our EHLO, so we'll read in our list of ESMTP options else { my $receiving = 1; while ($receiving) { my $r = <$bulk> || ""; #log our conversation, if desired if ($self->CONVERSATION){ $self->logToFile($self->CONVERSATION, "\tServer replied: '$r'"); }; $self->error("Server gave an error for EHLO : $r", "MBS011") if ! $r || $r =~ /^[45]/; #extract out and store our ESMTP options for possible later use $r =~ /^\d\d\d[ -](\w+)/; my $esmtp_option = $1; $self->_esmtp->{$esmtp_option} = 1 if $esmtp_option; #multi-line replies are of the form \d\d\d-, single line (or last line replies are \d\d\d" " $receiving = 0 if $r =~ /^\d\d\d /; }; }; #end successful EHLO #clear our alarm eval { alarm(0); }; #catch it in case alarm isn't implemented (stupid windows) }; #end eval wrapping up our time out if ($@){ $self->_not_worthless($self->_not_worthless - 1); return $self->error("Timed out waiting for response on connect", "MBS015"); }; $self->socket($bulk); $self->connected(1); $self->_sent_messages_this_connection(0); return $self; }; }; }; =pod =item disconnect disconnects the server object from the SMTP relay. Before disconnect, it will issue a "RSET" and then a "quit" command to the SMTP server, then close the socket. disconnect sets ->connected to 0. disconnect can also disconnect quietly, i.e., it won't try to issue a RSET and then quit before closing the socket. $server->disconnect(); #issues RSET and quit $server->disconnect('quietly'); #issues nothing =cut sub disconnect { my $self = shift; my $quietly = shift; return $self unless $self->connected(); $self->talk_and_respond('RSET') unless $quietly; #just to be polite $self->talk_and_respond('quit') unless $quietly; if (my $socket = $self->socket) { close $socket; $socket = undef; }; $self->socket(undef); #wipe out our ESMTP hash, since it may not be valid upon next connect $self->_esmtp({}); $self->connected(0); return $self; }; =pod =item talk_and_respond talk_and_respond takes one argument and sends it to your SMTP relay. It then listens for a response. my $response = $server->talk_and_respond("RSET"); If you're not connected to the relay, talk_and_respond will attempt to connect. This method is known to be able to return: MBS006 - cannot talk w/o speech MBS007 - cannot talk to server MBS008 - server won't respond to speech MBS009 - server disconnected MBS012 - temporarily won't respond to speech...re-trying MBS013 - could never resolve temporary error MBS014 - timed out waiting for response MBS018 - No file descriptor =cut sub talk_and_respond { my $self = shift; my $talk = shift || return $self->error("Cannot talk w/o speech", "MBS006"); my $attempts= shift || $self->talk_attempts; unless ($self->connected){ $self->connect || return undef; }; my $bulk = $self->socket(); local $\ = "\015\012"; local $/ = "\015\012"; unless (fileno($bulk)) { $self->disconnect('quietly'); return $self->error("No file descriptor...socket appears to be closed. Disconnecting to be safe", "MBS018"); }; unless (print $bulk $talk){ return $self->error("Cannot talk to server : $!", "MBS007"); }; #keep track of the first 50 characters, w/o returns for logging purposes my $short_talk = substr($talk, 0, 50); $short_talk .= "...(truncated)" if length $talk > length $short_talk; if ($self->CONVERSATION){ $self->logToFile($self->CONVERSATION, "Said to server: '$short_talk'"); }; my $response = undef; #this is true as long as we're expecting more responses from the server my $receiving = 1; $@ = undef; eval { local $SIG{"ALRM"} = sub {die "timed out"}; eval { alarm($self->time_out) if $self->time_out; }; #catch it in case alarm isn't implemented (stupid windows) while ($receiving) { my $r = <$bulk> || ""; if ($self->CONVERSATION){ $self->logToFile($self->CONVERSATION, "\tServer replied: '$r'"); }; #500 codes are permanent fatal errors if (! $r || $r =~ /^5/){ return $self->error("Server won't respond to '$talk' : $r" . $self->Smtp, "MBS008"); } #400 error codes are temporary fatal errors #If we get a 4xy error, we're going to retry this same command up to our #talk_attempts parameter. If it never works, we'll fail completely elsif ($r && $r =~ /^4/){ my $next_attempts = $attempts - 1; if ($next_attempts > 0) { $self->error("Temporary response to $talk : $r...retrying", "MBS012"); return $self->talk_and_respond($talk, $next_attempts); } else { return $self->error("Server won't respond to $talk, and re-attempts for temporary code exhausted", "MBS013"); }; } #otherwise, if we got a 221, we were disconnected. elsif ($r && $r =~ /^221/){ #if we disconnected from something other than a quit, then log the error if ($talk ne 'quit'){ $self->disconnect(); return $self->error("Server disconnected in response to '$talk': $r", "MBS009"); } #otherwise, we're happy, so we'll return a true value else { return 'disconnected'; }; } #finally, if it's something else, then we're gonna assume it's a happy response #and tack it on to the response we return else { # Responses of \d\d\d" " indicate we're done and there's nothing # else coming $receiving = 0 if $r =~ /^\d\d\d / || $r =~ /^\d\d\d$/; $response .= $r; }; }; #end while #clear our alarm eval { alarm(0); }; #catch it in case alarm isn't implemented (stupid windows) }; #end eval if ($@){ $self->disconnect('quietly'); return $self->error("Timed out waiting for response to $talk", "MBS014"); }; return $response; }; #make sure that we're disconnected sub DESTROY { my $self = shift; $self->disconnect if $self->connected; $self = undef; }; =pod =item create_all_servers create_all_servers will iterate through the file specified in server_file in the conf file and return an arrayref of all server objects created. define package Mail::Bulkmail::Server server_file = ./server_file.txt your server file should be of the format of another Mail::Bulkmail conf file, containing definitions for all of the SMTP servers you want to use. See the examples below for how to set up the conf files. If you would like to specify a different conf file, pass that as an argument. my $servers = Mail::Bulkmail::Server->create_all_servers('/path/to/new/server_file.txt'); This will then ignore the server_file in the conf file and use the one passed. You may also pass hashrefs of init data for new servers. my $servers = Mail::Bulkmail::Server->create_all_servers( { 'Smtp' => 'smtp.yourdomain.com' }, { 'Smtp' => 'smtp2.yourdomain.com' }, { 'Smtp' => 'smtp3.yourdomain.com' } ) || die Mail::Bulkmail::Server->error; This is called internally by Mail::Bulkmail's constructor, so you probably won't ever need to touch it. =cut sub create_all_servers { my $self = shift; my $class = ref $self || $self; my $master_conf = $self->read_conf_file(); my $conf = {}; if ($_[0] && ! ref $_[0]){ my $file = shift; $conf = $self->read_conf_file($file); } else { foreach my $pkg (@{$class->isa_path() || []}){ if ($master_conf->{$pkg}->{"server_file"}){ $conf = $self->read_conf_file($master_conf->{$pkg}->{"server_file"}); }; }; }; my $data = {'Smtp' => []}; my @settables = qw(Smtp Port Tries Domain max_messages max_messages_per_robin max_messages_per_connection max_messages_while_awake sleep_length max_connection_attempts envelope_limit talk_attempts time_out CONVERSATION); foreach my $attribute (@settables) { foreach my $pkg (@{$class->isa_path() || []}){ foreach my $method (keys %{$conf->{$pkg}}){ $conf->{$class}->{$attribute} ||= $conf->{$pkg}->{$attribute}; }; }; next unless defined $conf->{$class}->{$attribute}; @{$data->{$attribute}} = ref $conf->{$class}->{$attribute} ? @{$conf->{$class}->{$attribute}} : ($conf->{$class}->{$attribute}); }; my @servers = (); while (@{$data->{"Smtp"}}){ my %init = (); foreach my $attribute (@settables) { $init{$attribute} = shift @{$data->{$attribute}} if $data->{$attribute} && @{$data->{$attribute}}; }; my $server = $class->new( %init ) || return undef; push @servers, $server; }; if (@_){ while (my $init = shift){ my $server = $class->new( %$init ) || return undef; push @servers, $server; }; }; return \@servers; }; 1; __END__ =pod =back =head1 SAMPLE SERVER FILE It is recommended that you define your server entries in your server file. See Mail::Bulkmail::Object and Mail::Bulkmail for more information on conf file set up and how to define your server_file. #in your conf file, you want this define package Mail::Bulkmail::Server #your server file server_file = /etc/mb/server.file.txt Now, your server file should look like this: define package Mail::Bulkmail::Server #set up the first server Smtp @= smtp1.yourdomain.com Port @= 25 Tries @= 5 max_messages_per_robin @= 1000 envelope_limit @= 100 #set up the second server Smtp @= smtp2.yourdomain.com Port @= 25 Tries @= 5 max_messages_per_robin @= 1000 envelope_limit @= 100 #set up the third server Smtp @= smtp3.yourdomain.com Port @= 25 Tries @= 5 max_messages_per_robin @= 1000 envelope_limit @= 100 Alternatively, you can use defaults in your master conf file. #your server file server_file = /etc/mb/server.file.txt #These values will apply to all servers Port = 25 Tries = 5 max_message_per_robin = 1000 envelope_limit = 100 Now, your server file should look like this: define package Mail::Bulkmail::Server #set up the first server Smtp @= smtp1.yourdomain.com #set up the second server Smtp @= smtp2.yourdomain.com #set up the third server Smtp @= smtp3.yourdomain.com Be warned that if you want to set up a value for one server, you should set it up for all of them. Either specify the attribute for a server in the master conf file, or specify it multiple times for all servers. =head1 SEE ALSO Mail::Bulkmail, Mail::Bulkmail::DummyServer =head1 COPYRIGHT (again) Copyright and (c) 1999, 2000, 2001, 2002, 2003 James A Thomason III (jim@jimandkoka.com). All rights reserved. Mail::Bulkmail::Server is distributed under the terms of the Perl Artistic License. =head1 CONTACT INFO So you don't have to scroll all the way back to the top, I'm Jim Thomason (jim@jimandkoka.com) and feedback is appreciated. Bug reports/suggestions/questions/etc. Hell, drop me a line to let me know that you're using the module and that it's made your life easier. :-) =cut libmail-bulkmail-perl-3.12.orig/Bulkmail.pm0100644000175000017500000030001607771636722017351 0ustar jojojojopackage Mail::Bulkmail; # Copyright and (c) 1999, 2000, 2001, 2002, 2003 James A Thomason III (jim@jimandkoka.com). All rights reserved. # Mail::Bulkmail is distributed under the terms of the Perl Artistic License. # Mail::Bulkmail is still my baby and shall be supported forevermore. =pod =head1 NAME Mail::Bulkmail - Platform independent mailing list module =head1 AUTHOR Jim Thomason, jim@jimandkoka.com (http://www.jimandkoka.com) =head1 SYNOPSIS use Mail::Bulkmail /path/to/conf.file my $bulk = Mail::Bulkmail->new( "LIST" => "~/my.list.txt", "From" => '"Jim Thomason"', "Subject" => "This is a test message", "Message" => "Here is my test message" ) || die Mail::Bulkmail->error(); $bulk->bulkmail() || die $bulk->error; Don't forget to set up your conf file! =head1 DESCRIPTION Mail::Bulkmail gives a fairly complete set of tools for managing mass-mailing lists. I initially wrote it because the tools I was using at the time were just too damn slow for mailing out to thousands of recipients. I keep working on it because it's reasonably popular and I enjoy it. In a nutshell, it allows you to rapidly transmit a message to a mailing list by zipping out the information to them via an SMTP relay (your own, of course). Subclasses provide the ability to use mail merges, dynamic messages, and anything else you can think of. Mail::Bulkmail 3.00 is a major major B upgrade to the previous version (2.05), which was a major upgrade to the previous version (1.11). My software philosophy is that most code should be scrapped and re-written every 6-8 months or so. 2.05 was released in October of 2000, and I'm writing these docs for 3.00 in January of 2003. So I'm at least 3 major re-writes behind. (philosophy is referenced in the FAQ, below) But that's okay, because we're getting it done now. 3.00 is about as backwards compatible to 2.00 as 2.00 is to 1.00. That is to say, sorta. I've tried to make a note of things where they changed, but I'm sure I missed things. Some things can no longer be done, lots are done differently, some are the same. You will need to change your code to update from 1.x or 2.x to 3.00, though. That's a given. So what's new for 3.00? Lots of stuff. Immediate changes are: * code compartmentalization * multi-server support * conf file The immediate change is that the code is now compartmentalized. Mail::Bulkmail now just handles ordinary, non-dynamic mailings. See Mail::Bulkmail::Dynamic for the merging and dynamic text abilities from the prior versions. Server connections are no longer handled directly in Mail::Bulkmail (Smtp attribute, Port attribute, etc.), there is now a separate Mail::Bulkmail::Server object to handle all of that. And everything subclasses off of Mail::Bulkmail::Object, where I have my super-methods to define my objects, some helper stuff, and so on. It's just a lot easier for me to maintain, think about it, etc. if it's all separated. It's also easier for you, the user, if you want to make changes to things. Just subclass it, tweak it, and use it. Very straightforward to modify and extend now. 2.x and below *could* do it, but it wasn't really that easy (unless you were making very trivial changes). This should rectify that. Another major change is the addition of multi-server support. See the docs in Mail::Bulkmail::Server for more information. You can still specify one SMTP relay if that's all you've got, but if you have multiple servers, Mail::Bulkmail can now load balance between them to help take the stress off. No matter what, the biggest bottleneck to all of this is network performance (both to the SMTP relay and then from the relay to the rest of the world), so i wanted to try and help alleviate that by using multiple servers. I know that some people were doing that on there own with small changes, but this allows you to do it all invisibly. And finally, finally, finally there is a conf file. Documentation on the format is in Mail::Bulkmail::Object. It's pretty easy to use. This is the conf file format that I designed for my own use (along with most of the rest of Mail::Bulkmail::Object). The software also has the ability to read multiple conf files, if so desired. So no more worrying about asking your sysadmin to tweak the values in your module somewhere up in /usr/lib/whatever Just have him create the conf file you want, or pass in your own as desired. conf_files are specified and further documented in Mail::Bulkmail::Object, in an internal array called @conf_files, right at the top of the module. To specify a universal conf file, put it in that array (or have your sysadmin do so). Alternatively, you can also add a conf_file via the conf_files accessor. Mail::Bulkmail->conf_files('/path/to/conf_file', '/path/to/other/conf_file'); #, etc. But the recommended way is to specify your conf file upon module import. use Mail::Bulkmail 3.00 "/path/to/conf/file"; In addition, there is the usual plethora of bug fixes, tweaks, clean-ups, and so on. And yes, the horrid long-standing bug in the Tz method is B No, honest. I'm also trying a new documentation technique. The pod for a given method is now in the module by that method, as opposed to everything being bunched up at the bottom. Personally, I prefer everything being bunched up there for clarities sake. But from a maintenance point of view, spreading it all out makes my life much easier. =head1 requires Perl 5.6.0, Socket (It probaly can get by with less than 5.6.0, but I haven't tested it in such an environment) =cut use Mail::Bulkmail::Object; @ISA = Mail::Bulkmail::Object; $VERSION = '3.12'; use Socket; use strict; use warnings; =head1 ATTRIBUTES =over 11 =cut #attributes for storing important headers # you'll note that these 5 attributes are email addresses and don't use the standard add_attr # instead, they're wrapped to call _email_accessor internally instead of _accessor as normal. # Externally, it's the same. $obj->From($value) sets it and $obj->From() reads it # # But this also creates additional internal methods for the slots. So there is a ->From and a ->_From # for example. ->_From internally stores whatever is accepted by ->From, and same with the rest of them. # Don't access the ->_ attributes directly, use the wrappers instead. =pod =item From Stores the From address of this mailing. Must be a valid email address, unless Trusting is set. Really really should be a valid email address anyway. From is no longer used as the Sender, as was the behavior in prior versions. Now, Mail::Bulkmail first tries to use the Sender as the Sender, and failing that, falls back on the from. $bulk->From('"Jim Thomason"'); print $bulk->From; =cut __PACKAGE__->add_attr(["From", '_email_accessor'], 0); =pod =item To Stores the To address of this mailing. Must be a valid email address, unless Trusting is set. Really should be a valid email address anyway. To is used if you have use_envelope set to 1. See use_envelope, below. If you are not using the envelope, then the actual email address that we are currently on is used instead and ->To is never used at all. $bulk->To('jimslist:;'); print $bulk->To; As of 3.00, ->To may contain either a valid email address or a valid group definition. A group definition is as follows (pseudo-regex): Groupname:(address(,address)*)?; i.e., "the group name", then a colon, then an optional list of email addresses, then a semi-colon $bulk->To('jim@jimandkoka.com'); $bulk->To('MyList:jim@jimandkoka.com'); $bulk->To('MyList:;'); Are all valid addresses. Only the ->To attribute may accept group syntax emails =cut __PACKAGE__->add_attr(["To", '_email_accessor'], 1); =pod =item Sender Stores the Sender address of this mailing. Must be a valid email address, unless Trusting is set. Really really should be a valid email address anyway. Sender is mainly used when speaking SMTP to the server, specifically in the RCPT TO command. The spec defines "Sender" as "he who send the message" (paraphrasing), which may not actually be who the message is from. 2.00 used the From address as the Sender. You should specify this, but if you don't then the From value is assumed to be the sender. $bulk->Sender('jim@jimandkoka.com'); print $bulk->Sender; If this value is not set, then Mail::Bulkmail B place a Sender header equal to the From value. Note that the ultimate receiving SMTP server is expected to place a Return-Path header in the message. This Return-Path value will be set to the value of the sender of the message, either ->Sender or ->From. This, in turn, will be the address that bounce backs go to. You should not set a Return-Path header yourself, because bad things will result. =cut __PACKAGE__->add_attr(["Sender", '_email_accessor'], 0); =pod =item ReplyTo Stores the Reply-To address of this mailing. Must be a valid email address, unless Trusting is set. Really really should be a valid email address anyway. Reply-To is used as the address that the user's email client should reply to, if present. If this value is not set, then Mail::Bulkmail B place a Reply-To header equal to the From value. Note that even though the attribute is "ReplyTo", the header set is "Reply-To" $bulk->ReplyTo('jim@jimandkoka.com'); print $bulk->ReplyTo; =cut __PACKAGE__->add_attr(["ReplyTo", '_email_accessor'], 0); =pod =item Subject Boring old accessor that stores the subject of the message. It's really recommended that this is set either at your object or in the conf file, otherwise you'll send out a mailing list with no subject which will probably be ignored. $bulk->Subject("This is the list you signed up for"); print $bulk->Subject; =cut __PACKAGE__->add_attr("Subject"); # internally stores the Precedence of the bulkmail object. Should never be accessed # directly, should always be accessed via the ->Precedence method, which does a validation check __PACKAGE__->add_attr("_Precedence"); # internally stores all non-standard (read: "not defined above") headers that the bulkmail object # may have. It's stored as a hashref, and should be accessed via the ->header method. __PACKAGE__->add_attr('_headers'); # internally stores the _cached_headers for a given message. This is populated by the # buildHeaders() method during mailing. After the headers have been built once, then # buildHeaders returns the value in _cached_headers instead of constantly rebuilding them. # # _cached_headers is static if using the envelope. If not using the envelope, then the # string ##EMAIL## is populated into the To: header, and buildHeaders swaps that for the # actual individual email addresses __PACKAGE__->add_attr('_cached_headers'); #attributes for storing boolean flags =pod =item HTML Boolean flag. 1/0 only. A lot of people, though obviously not you, because you're reading the pod, just couldn't figure out how to send HTML messages. It's easy. $bulk->header("Content-type", "text/html"); But it was just too hard for most people. So I added this flag. Here's the order: Check and see if ->header("Content-type") is set, if so then send it. Otherwise, check and see if ->HTML is true, if so, then send a content-type of text/html i.e., an HTML message Otherwise, send a content-type of text/plain i.e., a plaintext message $bulk->HTML(1); print $bulk->HTML(); =cut __PACKAGE__->add_attr('HTML'); =pod =item use_envelope Boolean flag. 1/0 only. use_envelope was the coolest thing I added to Bulkmail 2.00, and is arguably still the best thing I've got here in terms of raw power in your lists. Basically, it's like lasing a stick of dynamite. Mail::Bulkmail is fast. Mail::Bulkmail with use_envelope is mind-numbingly fast. For the uninformed, an email message contains two parts, the message itself and the envelope. Mail servers only care about the envelope (for the most part), since that's where they find out who the message is to and from, and they don't really need to know anything else. A nifty feature of the envelope is that you can submit multiple addresses within the envelope, and then your mail server will automagically send along the message to everyone contained within the envelope. You end up sending a hell of a lot less data across your connection, your SMTP server has less work to do, and everything ends up working out wonderfully. There are two catches. First of all, with envelope sending turned off, the recipient will have their own email address in the "To" field (To: jim@jimandkoka.com, fer instance). With the envelope on, the recipient will only receive a generic email address ("To: list@myserver.com", fer instance) Most people don't care since that's how most email lists work, but you should be aware of it. Secondly, you B and I mean B sort your list by domain. Envelopes can only be bundled up by domain, so that we send all email to a domain in one burst, all of the email to another domain in the next burst, and so on. So you need to have all of your domains clustered together in your list. If you don't, your list will still go out, but it will be a B slower, since Mail::Bulkmail has a fair amount more processing to do when you send with then envelope. This is normally more than offset by the gains received from sending fewer messages. But with an unsorted list, you never see the big gains and you see a major slow down. Sort your lists. $bulk->use_envelope(0); print $bulk->use_envelope; =cut __PACKAGE__->add_attr('use_envelope'); =pod =item force80 Boolean flag 1/0 RFC 2822 recommends that all messages have no more than 80 characters in a line (78 + CRLF), but doesn't require it. if force80 is 1, then it will force a message to have only 80 characters per line. It will try to insert carriage returns between word boundaries, but if it can't, then it will cut words in half to force the limit. Regardless of force80, be warned that RFC 2822 mandates that messages must have no more than 1000 characters per line (998 + CRLF), and that wrapping will be done no matter what. Again, it will try to wrap at word boundaries, but if it can't, it will cut words in half to force the limit. It is recommended that you just have your message with at most 78 characters + CRLF for happiness' sake, and B at most 998 characters + CRLF. You may end up with extra CRLFs in your message that you weren't expecting. If your message is not guaranteed to have only < 78 characters + CRLF per line, then it's recommended to have force80 on for full compatibility. Note that force80 will be overridden by ->Trusting('wrapping'); =cut __PACKAGE__->add_attr('force80'); # internal flag to let ->bulkmail know if a message is waiting. This is necessary for envelope sending: # when we get a new domain from the getNextLine call on LIST, we need to see if there's a waiting message # first. If there is a waiting message, then we need to finish that one up before we start the next one # for the new domain. _waiting_message stores that value __PACKAGE__->add_attr("_waiting_message"); #attributes for storing connection information =pod =item servers arrayref of servers. Okay, this is the first major change between 2.x and 3.x. 2.x had methods to connect to one server (->Smtp, ->Port, etc.). 3.x doesn't have those, and the relevent things are now in Mail::Bulkmail::Server, instead it has a list of servers. servers should contain an arrayref of server objects. You can either create them externally yourself and pass them in in an arrayref, $bulk->servers([\$server, \$server2, \$server3]); or you can create them in your conf file. See the Mail::Bulkmail::Object for more info on the format of the conf file, and Mail::Bulkmail::Server for the attributes to specify. servers will automatically be populated with a list of all servers in the server_list in the conf file if you don't specify anything, so you really don't need to worry about it. If you'd rather use a different server_file, then pass the server_file flag to the constructor: $bulk = Mail::Bulkmail->new( 'server_file' => '/path/to/server_file' ); That will B the server_file in B conf file, so use it with caution. Realistically, though, just let the program populate in the values of the servers you specified in the conf file and don't worry about this. Be warned that servers will be populated by the constructor if you do not populate servers at object creation. You may still change servers later (before you begin mailing), but there is the slight performance hit to initialize all of the server objects and then throw them away. This doesn't affect mailing speed in anyway, it'll just take a little longer to get started than it should. =cut __PACKAGE__->add_attr('servers'); # internal flag to let ->bulkmail know the domain of the last email address we looked at when using # the envelope. This is necessary to know when we reach a new domain in the LIST. If we have a new # domain (i.e., the current message's domain is different from _cached_domain), then finish off the # message if we _waiting_message is true and then move on __PACKAGE__->add_attr("_cached_domain"); # internally stores which index of the ->servers list we're on used and set by nextServer __PACKAGE__->add_attr("_server_index"); #attributes for storing information about the message =pod =item Message This stores the message that you will send out to the recipients of your list. $bulk->Message('Hi there. You're on my mailing list'); print $bulk->Message; Don't put any headers in your Message, since they won't be transmitted as headers. Instead they will show up in the body of your message text. Use the ->header method instead for additional headers This mutator is known to be able to return: MB020 - could not open file for message MB021 - could not close file for message MB022 - invalid headers from message =cut # The message is actually stored internally (_Message) and accessed via Message. # That way, if we change the message, we can be sure to wipe out the internal _cached_message as well __PACKAGE__->add_attr('_Message'); sub Message { my $self = shift; $self->_cached_message(undef) if @_; my @passed = @_; my $needs_header_extraction = 0; if (@passed) { $self->_extracted_headers_from_message(0); }; if ($self->message_from_file) { my $file = shift @passed || $self->_message_file; if (! defined $self->_message_file_access_time || $file ne $self->_message_file || -M $file < $self->_message_file_access_time) { $self->_message_file($file); $self->_message_file_access_time(-M $file); #theoretically, you could call ->Message with no arguments but with message_from_file turned on #in that case, you may re-read the file if it's been modified since you last looked at it. #We're currently in that case. So we wipe out the previously _cached_message to be safe. $self->_cached_message(undef); my $handle = $self->gen_handle; my $message = undef; open ($handle, $file) || return $self->error("Could not open file for message: $!", "MB020"); { local $/ = undef; $message = <$handle>; } close ($handle) || return $self->error("Could not close file for message: $!", "MB021"); unshift @passed, $message; }; }; #first, wipe out any previously set headers_from_message if (defined $self->_previous_headers_from_message) { foreach my $header (@{$self->_previous_headers_from_message}){ $self->header($header, undef); }; }; #wipe out the list of previously set headers $self->_previous_headers_from_message([]); #then, if we're setting new headers, we should set them. if ($self->headers_from_message && ! $self->_extracted_headers_from_message) { $self->_extracted_headers_from_message(1); $passed[0] ||= $self->_Message(); #We'll sometimes call this method after setting the message #sendmail-ify our messages newlines $passed[0] =~ s/(?:\r?\n|\r\n?)/\015\012/g; my $header_string = undef; #split out the header string and the message body ($header_string, $passed[0]) = split(/\015\012\015\012/, $passed[0], 2); my ($last_header, $last_value) = (); foreach (split/\015\012/, $header_string){ if (/:/){ if (defined $last_header && defined $last_value) { #set our header $self->header($last_header, $last_value) || return undef; #bubble up the header error #and wipe out the prior values $last_header = $last_value = undef; }; ($last_header, $last_value) = split(/:/, $_, 2); push @{$self->_previous_headers_from_message}, $last_header; } elsif (/^\s+/){ $last_value .= "\015\012$_"; } else { return $self->error("Invalid Headers from Message: line ($_)\n\n-->($header_string)", "MB022"); }; }; #clean up any headers that remain if (defined $last_header && defined $last_value) { #set our header $self->header($last_header, $last_value) || return undef; #bubble up the header error }; }; return $self->_Message(@passed); }; # internal method. Looks to see if a the message is being read from disk. If so, if it # was modified since it was read, then it is not current. Otherwise, it is. sub _current_message { my $self = shift; if ( $self->message_from_file && ( ! defined $self->_message_file_access_time || -M $self->_message_file < $self->_message_file_access_time ) ) { return 0; } else { return 1; }; }; # internally stores the _cached_message for a given message. This is populated by the buildMessage() # method during mailing. After the message has been built once, then buildMessage returns the # value in _cached_message instead of constantly rebuilding it. __PACKAGE__->add_attr('_cached_message'); =pod =item message_from_file boolean flag. 1/0 only. message_from_file allows you to load your message in from a file. If message_from_file is set to 1, then the value passed to ->Message() will be assumed to be a path to a file on disk. That file will be openned in read mode (if possible), read in, and stored as your message. Note that your entire message text will be read into memory - no matter how large the message may be. This is simply a shortcut so that you don't have to open and read in the message yourself. B This is a bit picky, to put it mildly. No doubt you've read that the constructor actually is taking in its arguments in an array, not a hash. So they're parsed in order, which means you need pass in message_from_file B Message. i.e., this will work: $bulk = Mail::Bulkmail->new( 'message_from_file' => 1, 'Message' => '/path/to/message.txt', ); But this will not: $bulk = Mail::Bulkmail->new( 'Message' => '/path/to/message.txt', 'message_from_file' => 1, ); Ditto for using the mutators. Turn on the flag, i specify the Message. =cut __PACKAGE__->add_attr('message_from_file'); # internal caching attribute to store the message file. This way we will be able to re-open # and re-read the message file if it happened to change. __PACKAGE__->add_attr('_message_file'); # internal attribute to store the time the message file was last accessed. This allows the message # file to change and be re-read, though lord knows why you'd want to necessarily do something like # that. __PACKAGE__->add_attr('_message_file_access_time'); =pod =item headers_from_message boolean flag. 1/0 only. headers_from_message allows you to specify mail headers inside your message body. You may still specify additional headers in the traditional manner. Note that if you change the value of ->Message (not recommended, but there are times you may want to do so), then any headers that were previously set via headers_from_message will be B. any headers specified in the message will be set when you call ->Message. =cut __PACKAGE__->add_attr('headers_from_message'); # internal boolean flag. used to govern whether the headers have already been extracted from # the message __PACKAGE__->add_attr('_extracted_headers_from_message'); #internal arrayref containing the headers set the last time ->Message was called. __PACKAGE__->add_attr("_previous_headers_from_message"); # internal hashref that stores the list of duplicate email addresses populated by setDuplicate and # read by isDuplicate. WARNING - there is a *severe* penalty for using duplicates, this hash can # get really really huge. It is recommended you remove duplicates in advance and turn on # allow_duplicates to prevent this from being populated, if you do use it, then it # is *strongly* recommended that you leave Trusting('banned') off, i.e. Trusting('banned' => 0) __PACKAGE__->add_attr('_duplicates'); # internal hashref that stores the list of banned email addresses or domains populated by a call # to banned (which does some magic with _file_accessor). accessed via isBanned # It is *strongly* recommended that you leave Trusting('banned') off, i.e. Trusting('banned' => 0) __PACKAGE__->add_attr('_banned'); #attributes for storing filehandles =pod =item LIST LIST stores the list of addresses you're going to mail out to. LIST may be either a coderef, globref, arrayref, or string literal. If a string literal, then Mail::Bulkmail will attempt to open that file as your list: $bulk->LIST("/path/to/my/list"); If a globref, it is assumed to be an open filehandle: open (L, "/path/to/my/list"); $bulk->LIST(\*L); if a coderef, it is assumed to be a function to return your list, or undef when it is done: sub L {return $listquery->execute()}; #or whatever your code is $bulk->LIST(\&L); The coderef will receive the bulkmail object itself as an argument. if an arrayref, it is assumed to be an array containing your list: my $list = [qw(jim@jimandkoka.com thomasoniii@yahoo.com)]; $bulk->LIST($list); Use whichever item is most convenient, and Mail::Bulkmail will take it from there. =cut __PACKAGE__->add_attr(['LIST', '_file_accessor'], '<'); =pod =item BAD This is an optional log file to keep track of the bad addresses you have, i.e. banned, invalid, or duplicates. BAD may be either a coderef, globref, arrayref, or string literal. If a string literal, then Mail::Bulkmail will attempt to open that file (in append mode) as your log: $bulk->BAD("/path/to/my/bad.addresses"); If a globref, it is assumed to be an open filehandle in append mode: open (B, ">>/path/to/my/bad.addresses"); $bulk->BAD(\*L); if a coderef, it is assumed to be a function to call with the address as an argument: sub B { print "BAD ADDRESS : ", $_[1], "\n"}; #or whatever your code is $bulk->BAD(\&B); The coderef will receive two arguments. The first is the bulkmail object itself, and the second is the data in the form that it was returned from the LIST attribute. if an arrayref, then bad addresses will be pushed on to the end of it $bulk->BAD(\@bad); Use whichever item is most convenient, and Mail::Bulkmail will take it from there. =cut __PACKAGE__->add_attr(['BAD', '_file_accessor'], '>>'); =pod =item GOOD This is an optional log file to keep track of the good addresses you have, i.e. the ones that Mail::Bulkmail could successfully transmit to the server. Note that there is no guarantee that an email address in the GOOD file actually received your mailing - it could have failed at a later point when out of Mail::Bulkmail's control. GOOD may be either a coderef, globref, arrayref, or string literal. If a string literal, then Mail::Bulkmail will attempt to open that file (in append mode) as your log: $bulk->GOOD("/path/to/my/good.addresses"); If a globref, it is assumed to be an open filehandle in append mode: open (B, ">>/path/to/my/good.addresses"); $bulk->GOOD(\*B); if a coderef, it is assumed to be a function to call with the address as an argument: sub G { print "GOOD ADDRESS : ", $_[1], "\n"}; #or whatever your code is $bulk->GOOD(\&G); The coderef will receive two arguments. The first is the bulkmail object itself, and the second is the data in the form that it was returned from the LIST attribute. if an arrayref, then bad addresses will be pushed on to the end of it $bulk->GOOD(\@good); Use whichever item is most convenient, and Mail::Bulkmail will take it from there. Please note that ->GOOD only says that the address was initially accepted for delivery. It could later fail while transmitting the email address, or it could be an valid but non-existent address that bounces later. It is up to the end user to inspect your error logs to make sure no errors occurred, and look for (and weed out) bounces or other failures later. =cut __PACKAGE__->add_attr(['GOOD', '_file_accessor'], '>>'); #class attributes =pod =item server_class server_class is a class method that B be specified in the conf file. You can initialize it in your program if you really want, but it is B recommended to be in the conf file so you don't forget it. server_class is used by the constructor to create the server list to populate into ->servers, ->servers is not populated in the constructor. By default, this should probably be Mail::Bulkmail::Server, to allow mailing. Another useful value is Mail::Bulkmail::Dummy See Mail::Bulkmail::Server and Mail::Bulkmail::Dummy for more information on how to create those objects. Also, if you write your own server implementation, this would be where you'd hook it into Mail::Bulkmail =cut __PACKAGE__->add_class_attr('server_class'); #speciality accessors # _Trusting stores the hashref that is accessed internally by the Trusting method __PACKAGE__->add_attr('_Trusting'); =pod =item Trusting Trusting specifies your Trusting level. Mail::Bulkmail 3.00 will do its best to make sure that your email addresses are valid and that your message conforms to RFC 2822. But, there is a slight performance hit to doing that - it does have to check things, do regexes, and so on. It's not very slow, but extrapolated over a huge list, it can be noticeable. So that's where Trusting comes in to play. If you set a Trusting value, then certain tests will be skipped. B. If you tell Mail::Bulkmail to be Trusting, then it won't verify addresses or to make sure your list is under 1,000 characters per line. So if you're Trusting and you pass in bad data, it's your funeral. If there is B chance of invalid data, then don't be Trusting. If you're *positive* there's nothing wrong, then you may be Trusting. Trusting values are set one as key/value pairs. $bulk->Trusting("email" => 1); $bulk->Trusting("wrapping" => 1); $bulk->Trusting("default" => 1); And read back with just the key: $bulk->Trusting("email"); $bulk->Trusting("wrapping"); $bulk->Trusting("default"); default is used as a fall back. So if you didn't specify a Trusting value for "email", for example, it will use the "default" value. Note that the default is only used if a value is not specified. $bulk->Trusting("default" => 1); print $bulk->Trusting("email"); #prints 1 print $bulk->Trusting("default"); #prints 1 $bulk->Trusting("default" => 0); print $bulk->Trusting("email"); #prints 0 print $bulk->Trusting("default"); #prints 0 $bulk->Trusting("email" => 1); print $bulk->Trusting("email"); #prints 1 print $bulk->Trusting("default"); #prints 0 $bulk->Trusting("email" => 0); $bulk->Trusting("default" => 0); print $bulk->Trusting("email"); #prints 0 print $bulk->Trusting("default"); #prints 1 You may also directly set all values with the integer short cut. $bulk->Trusting(1); # everything is Trusting $bulk->Trusting(0); # nothing is Trusting If you want to specify Trusting in the conf file, you may only directly specify via the integer shortcut. Otherwise, you must use the list equation. # all Trusting Trusting = 1 #none Trusting Trusting = 0 #email is trusting Trusting @= email Trusting @= wrapping This will not work: Trusting = email If you use that syntax, it will internally do: $bulk->Trusting('email'); which you know will only read the value, not set it. If you use the array syntax, it will properly set the value. Note that ->Trusting('default' => 0) is not equivalent to ->Trusting(0). Consider: $bulk->Trusting('email' => 1); print $bulk->Trusting('email'); # prints 1 $bulk->Trusting("default' => 0); print $bulk->Trusting('email'); # still prints 1 $bulk->Trusting(0); print $bulk->Trusting('email'); # now prints 0 Currently, you may set: email - Trusting('email' => 1) will not check for valid email addresses wrapping - Trusting('wrapping' => 1) will not try to wrap the message to reach the 1,000 character per line limit duplicates - Trusting('duplicates' => 1) will not do any duplicates checking (this is the equivalent of allow_duplicates in older versions) banned - Trusting('banned' => 1) will not lowercase the local part of a domain in a banned or duplicates check (this is the opposite of safe_banned in older versions. i.e. $bulk2_05->safe_banned(1) == $bulk_300->Trusting('banned' => 0); It is recommended your conf file be: Trusting @= duplicates Since you're usually better off weeding duplicates out in advance. All other Trusting values are recommended to be false. =cut sub Trusting { my $self = shift; my $key = shift; $self->_Trusting({}) unless $self->_Trusting; if (defined $key) { if (ref $key eq "ARRAY"){ foreach my $k (@$key){ $self->_Trusting->{$k} = 1; }; return 1; } elsif (@_){ my $val = shift; $self->_Trusting->{$key} = $val; return $val; } elsif ($key =~ /^[10]$/){ $self->_Trusting({}); $self->_Trusting->{'default'} = $key; return $key; } else { return defined $self->_Trusting->{$key} ? $self->_Trusting->{$key} : ($self->_Trusting->{'default'} || 0) }; } else { return $self->_Trusting->{'default'} || 0; }; }; =pod =item banned banned stores the list of email addresses and domains that are banned. Only store user@domain.com portions of email addresses, don't try to ban "Jim", for instance. Only ban jim@jimandkoka.com banned may be either a coderef, globref, arrayref, or string literal. If a string literal, then Mail::Bulkmail will attempt to open that file (in append mode) as your log: $bulk->banned("/path/to/my/banned.addresses"); If a globref, it is assumed to be an open filehandle in append mode: open (B, ">>/path/to/my/banned.addresses"); $bulk->banned(\*B); files should contain one entry per line, each entry being an email address or a domain. For example: jim@jimandkoka.com jimandkoka.com foo@bar.com bar.com if a coderef, it is assumed to be a function to return your banned list: sub B {return $bannedquery->execute()}; #or whatever your code is $bulk->banned(\&B); The function should return one entry per execution, either an address or a domain. if an arrayref, then it's an array of banned addresses and domains $bulk->banned([qw(jim@jimandkoka.com jimandkoka.com)]); The arrayref can contain email addresses and domains. Use whichever item is most convenient, and Mail::Bulkmail will take it from there. Once banned has been populated, the values are stored internally in a hashref. =cut sub banned { my $self = shift; if (@_) { my $banned = shift; #we're gonna cheat and populate the data into ->_banned via the _file_accessor. #then we'll iterate through it all, pop it into a hash, and then drop #that back into _banned instead my $ob = $self->_banned(); #save it for below. $self->_file_accessor("_banned", "<", $banned); my $b = $ob || {}; #keep the old value, or make a new hashref while (my $address = $self->getNextLine($self->_banned)){ $b->{$address} = 1; }; return $self->_banned($b); } else { #if we have a banned hash, return it. if ($self->_banned){ return $self->_banned; } #otherwise, create one and return that. else { return $self->_banned({}); }; }; }; =pod =item Precedence Precedence is a validating accessor to validate the Precedence you have passed for your mailing list. Precedence must be either: * list (default) - a mailing list * bulk - bulk mailing of some type * junk - worthless test message. You can use an alternate Precedence if you set Trusting to 0. But seriously, there's *no* reason to do that. Keeping the appropriate precedence will help the servers on the internet route your message as well as the rest of the email out there more efficiently. So don't be a jerk, and leave it as one of those three. This method is known to be able to return: MB001 - invalid precedence =cut sub Precedence { my $self = shift; my $prop = '_Precedence'; if (@_){ my $precedence = shift; if ($self->Trusting('precedence') || $self->_valid_precedence($precedence)){ $self->_Precedence($precedence); return $self->_Precedence; } else { return $self->error("Invalid precedence: $precedence", "MB001"); }; } else { return $self->_Precedence || 'list'; #if they didn't set it, assume list, no matter what }; }; #date and tz are actually methods, not accessors, but they're close enough, so what the hell =pod =item Tz Returns the timezone that you're in. You cannot set this value. You'll also never need to worry about it. =cut sub Tz { my $self = shift; my $time = shift || time; my ($min, $hour, $isdst) = (localtime($time))[1,2,-1]; my ($gmin, $ghour, $gsdst) = (gmtime($time))[1,2, -1]; my $diffhour = $hour - $ghour; $diffhour = $diffhour - 24 if $diffhour > 12; $diffhour = $diffhour + 24 if $diffhour < -12; ($diffhour = sprintf("%03d", $diffhour)) =~ s/^0/\+/; return $diffhour . sprintf("%02d", $min - $gmin); }; =pod =item Date Returns the date that this email is being sent, in valid RFC format. Note that this will be stored in _cached_headers as the date that the first email is sent. Another thing you won't need to worry about. =cut sub Date { my $self = shift; my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); my @days = qw(Sun Mon Tue Wed Thu Fri Sat); my $time = time; my ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime($time); return sprintf("%s, %02d %s %04d %02d:%02d:%02d %05s", $days[$wday], $mday, $months[$mon], $year + 1900, $hour, $min, $sec, $self->Tz($time)); }; #done with speciality accessors #our generic speciality accessors # internally used to populate the attributes that are expected to contain email addresses # basically, it just does a valid_email check on the email address before allowing it into # the object's attribute. The validation check will be bypassed if Trusting is set # # otherwise, the attribute externally behaves just as any other sub _email_accessor { my $self = shift; my $prop = shift; my $allow_groups = shift; if (@_){ my $email = shift; if (! defined $email || $self->Trusting('email') || $self->valid_email($email, $allow_groups)){ my $return = $self->$prop($email);; return defined $email ? $return : 0; } else { return $self->error("Invalid address: $email", "MB002"); }; } else { return $self->$prop(); }; }; #done with generic specialty accessors #constructor =pod =back =head1 METHODS =over 11 =item new The constructor, used to create new Mail::Bulkmail objects. See Mail::Bulkmail::Object for more information on constructors. In a nutshell, the constructor accepts a hash with name/value pairs corresponding to attributes and attribute values. So that: my $bulk = Mail::Bulkmail->new( 'LIST' => './list.txt', 'Message' => "This is my message!", 'HTML' => 0 ) || die Mail::Bulkmail->error; is the same as: my $bulk = Mail::Bulkmail->new() || die Mail::Bulkmail->error; $bulk->LIST("./list.txt"); $bulk->Message("This is my message!"); $bulk->HTML(0); *technically* it's not exactly the same, since the constructor will fail with an error if your attribute calls return undef, but it's close enough. It is recommend to tack on an || die after your new() calls, to make sure you're alerted if your object isn't created. my $bulk = Mail::Bulkmail->new() || die Mail::Bulkmail->error(); Otherwise, you won't be alerted if your object isn't created. Upon creation, Mail::Bulkmail will first iterate through the conf file and populate all of the attributes defined in the conf file into your object. It will then iterate through the values you passed to the constructor and mutate the attributes to those values. If you don't pass any arguments to the constructor, it still gets the default values in the conf file. Values passed to the constructor always override values specified in the conf file There is one special constructor flag, "server_file", which does not correspond to an attribute or method. "server_file" is used to override the server_file specified in the conf file. If you pass a key/value pair to the constructor that doesn't have a corresponding attribute, then it is assuming you are setting a new header. my $bulk = Mail::Bulkmail->new('foo' => 'bar'); is the same as: my $bulk = Mail::Bulkmail->new(); $bulk->header('foo' => 'bar'); This method is known to be able to return: MB003 - could not use server class =cut sub new { my $class = shift; my %init = @_; my $self = $class->SUPER::new( 'servers' => [], '_headers' => {}, "_duplicates" => {}, "_waiting_message" => 0, "_server_index" => -1, @_ ) || return undef; #now, we iterate through everything else that was passed, since we're gonna assume #that they want to set it as a header foreach my $key (grep {! $self->can($_)} keys %init){ next if $key eq 'server_file'; #special case to allow passing of a separate server_file $self->header($key, $init{$key}) || return $class->error($self->error, $self->errcode, 'not logged'); }; #if we have no servers, but we do have a server file (which we should...) if ($class->server_class) { $@ = undef; eval "use " . $class->server_class; return $self->error("Could not use " . $class->server_class . " : $@", "MB003") if $@; #if we have no servers, then initialize them via create_all_servers $self->servers($class->server_class->create_all_servers($init{'server_file'} || undef)) if $class->server_class && @{$self->servers} == 0; }; return $self; }; =pod =item header the header method is used to set additional headers for your object that don't have their own methods (such as Subject) header expects the header and value to act as a mutator, or the header to act as an accessor. $bulk->header('X-Header', "My header value"); print $bulk->header('X-Header'); #prints "My header value" Use this to set any additional headers that you would like. Note that you can't use this to bypass validation checks. $bulk->Header("Subject", "My Subject") will internally change into $bulk->Subject("My Subject"); There's no benefit to doing that, it'll just slow you down. If you call header with no values, it returns the _headers hashref, containing key value pairs of header => value This method is known to be able to return: MB004 - cannot set CC or BCC header MB005 - invalid header =cut #header allows us to specify additional headers sub header { my $self = shift; my $header = shift || return $self->_headers; if ($header =~ /^(?:From|To|Sender|Reply-?To|Subject|Precedence)$/){ $header =~ s/\W//g; return $self->$header(@_); } elsif ($header =~ /^b?cc/i){ return $self->error("Cannot set CC or BCC...that's just common sense!", "MB004"); } else { if ($header =~ /^[\x21-\x39\x3B-\x7E]+$/){ my $value = shift; if (defined $value) { $self->_headers->{$header} = $value; return $value; } else { delete $self->_headers->{$header}; return 0; #non-true value (didn't set it to anything), but a defined value since it's not an error. }; } else { return $self->error("Cannot set header '$header' : invalid. Headers cannot contain non-printables, spaces, or colons", "MB005"); }; }; }; #validation methods { # Mail::Bulkmail 3.00 has a greatly extended routine for validating email addresses. The one in 2.x was pretty good, # but was only slightly superior to the one in 1.x. It also wasn't quite perfect - there were valid addresses it would # refuse, and invalid addresses it would accept. It was *mostly* fine, though. # # 3.00 has a higher standard, though. :) # So valid_email has been re-written. This should match only valid RFC 2822 addresses, with deviations from the # spec noted below. Still only allows single addresses, though. No address lists or groups for the general case. # our regexes to deal with whitespace and folding whitespace my $wsp = q<[ \t]>; my $fws = qq<(?:(?:$wsp*\\015\\012)?$wsp+)>; # our regexes for control characters my $no_ws_ctl = q<\x01-\x08\x0B\x0C\x0E-\x1F\x7F>; # regex for "text", any ascii character other than a CR or LF my $text = q<[\x01-\x09\x0B\x0C\x14-\x7F]>; #regexes for "atoms" #define our atomtext my $atext = q<[!#$%&'*+\-/=?^`{|}~\w]>; # an atom is atext optionally surrounded by folded white space my $atom = qq<(?:$fws*$atext+$fws*)>; # a dotatom is atom text optionally followed by a dot and more atomtext my $dotatomtext = qq<(?:$atext+(?:\\.$atext+)*)>; #a dotatom is dotatomtext optionally surrounded by folded whitespace my $dotatom = qq<(?:$fws?$dotatomtext$fws?)>; #a quoted pair is a backslash followed by a single text character, as defined above. my $quoted_pair = '(?:' . q<\\> . qq<$text> . ')'; #regexes for quoted strings #quoted text is text between quotes, it can be any control character, #in addition to any ASCII character other than \ or " my $qtext = '(?:' . '[' . $no_ws_ctl . q<\x21\x23-\x5B\x5D-\x7E> . ']' . ')'; #content inside a quoted string may either be qtext or a quoted pair my $qcontent = qq<(?:$qtext|$quoted_pair)>; #and, finally, our quoted string is optional folded white space, then a double quote #with as much qcontent as we'd like (optionally surrounded by folding white space #then another double quote, and more optional folded white space my $quoted_string = qq<(?:$fws?"(?:$fws?$qcontent)*$fws?"$fws?)>; #a word is an atom or a quoted string my $word = qq<(?:$atom|$quoted_string)>; #a phrase is multiple words my $phrase = qq<$word+>; #the local part of an address is either a dotatom or a quoted string my $local_part = qq<(?:$dotatom|$quoted_string)>; #regexes for domains # #domain text may be a control character, in addition to any ASCII character other than [, \, or ] # my $dtext = '(?:' . '[' . $no_ws_ctl . q<\x21-\x5A\x5E-\x7E> . ']' . ')'; # # #domain content is either dtext or a quoted pair # my $dcontent = qq<(?:$dtext|$quoted_pair)>; # # #a domain literal is optional folded white space, followed by a literal [ # #then optional folded white space and arbitrary dcontent, followed by another literal ] # #and then optional fws # my $domain_literal = qq<(?:$fws?\\[(?:$fws?$dcontent)*\\]$fws)>; # # #and, finally, a domain is either a dotatom or a domainliteral. # my $domain = qq<(?:$dotatom|$domain_literal)>; # RFC 2821 is a bit stricter than RFC 2822. In fact, according to that document, a domain may be only # letters, numbers, and hyphens. Go figure. I kept the old domain specification in the comments # immediately above here, just 'cuz I was so proud of 'em. :) my $domain = q<[a-zA-Z0-9\-]+(?:\.[a-zA-Z0-9\-]+)*\\.(?:[a-zA-Z][a-zA-Z](?:[a-zA-Z](?:[a-zA-Z](?:[a-zA-Z][a-zA-Z])?)?)?)>; #our address spec. Defines user@domain.com #note - very important, that the addr_spec is within backtracking parentheses. This value will #go into either $1 (common) or $2 (not quite as common). #also note that we deviate from RFC 2822 here, by forcing the TLD of 2,3,4 or 6 characters. #that's what the internet uses, regardless of what the spec allows. my $addr_spec = '(' . $local_part . '@' . $domain . ')'; #a display name (displayname) is just a phrase my $display_name = $phrase; #an angle_addr is just an addr_spec surrounded by < and >, with optional folded white space #around that my $angle_addr = qq[(?:$fws?<$addr_spec>$fws?)]; #a name address is an optional display_name followed by an angle_addr my $name_addr = qq<(?:$display_name?$angle_addr)>; # and a mailbox is either an addr_spec or a name_addr # the mailbox is our final regex that we use in valid_email # my $mailbox = qq<(?:$addr_spec|$name_addr)>; # ## # a mailbox list is, as it sounds, a list of at least one mailbox, with as many as you'd like, comma delimited my $mailbox_list = qq<(?:$mailbox(?:,$mailbox)*)>; # and a group is a display_name, a :, and an optional mailbox list, ended with a semi-colon # This is used in the To accessor, which is allowed to contain groups. my $group = qq<(?:$display_name:(?:$mailbox_list|$fws)?;)>; =pod =item valid_email valid_email validates an email address and extracts the user@domain.com part of an address print $bulk->valid_email('jim@jimandkoka.com')->{'extracted'}; #prints jim@jimandkoka.com print $bulk->valid_email('"Jim Thomason"')->{'extracted'}; #prints jim@jimandkoka.com print $bulk->valid_email('jim@jimandkoka.com')->{'extracted'}; #prints jim@jimandkoka.com print $bulk->valid_email('jim@@jimandkoka.com'); #prints nothing (invalid address) Note that as of v3.10, valid_email returns a hash with two keys upon success. 'original' contains the address as you passed it in, 'extracted' is the address person that was yanked out. { 'original' => 'Jim Thomason' 'jim@jimandkoka.com', } Given an invalid address, returns undef and sets an error as always. If Trusting is 1, then valid_email only removes comments and extracts the address spec part of the email. i.e., if your address is some name It'll just return some@address.com. This is required, because valid_email is also where the address spec is validated. As of 3.00, valid_email should be fully RFC 2822 compliant, except where otherwise noted (such as forcing a valid domain as per RFC 2821). And also as of 3.00, Trusting is even more trusting and has a faster return. There are speed reasons to have Trusting set to 1 (such as not having to check the validity of each email address), but if you do that then you must be B that B of your addresses are 100% valid. If you have B addresses in your list that are invalid and Trusting is set to 1, then you may have bad things happen. You have been warned. This method is known to be able to return: MB006 - no email address MB007 - invalid email address =cut sub valid_email { my $self = shift; my $email = shift; my $allow_groups = shift; my $return_hash = { 'original' => $email }; return $self->error("Cannot validate w/o email address", "MB006") unless $email; $email = $self->_comment_killer($email); #No one else handles comments, to my knowledge. Cool, huh? :) # if we're trusting, trivially extract the address-spec and return it if ($self->Trusting('email')){ $email =~ s/.+<(.+)>/$1/g; $return_hash->{'extracted'} = $email; return $return_hash; }; #okay, check our email address if ($email =~ m!^$mailbox$!o){ $return_hash->{'extracted'} = $1 || $2; #our address could be in either place; return $return_hash; } #if it fails as an email address and we allow groups, see if we were passed a group elsif ($allow_groups && $email =~ m!^$group$!o){ #the $group regex can't extract emails, so we'll just return the whole thing. $return_hash->{'extracted'} = $email; return $return_hash; } #finally, otherwise give an error else { $self->logToFile($self->BAD, \$email); return $self->error("Invalid email address : $email", "MB007"); }; }; # _comment_killer is used internally by valid_email, _comment_killer does what you'd expect from it, it removes # comments from email addresses sub _comment_killer { my $self = shift; my $email = shift; #comment text is anything in ASCII, except for \, (, and ) my $ctext = '(' . '[' . $no_ws_ctl . q<\x21-\x27\x2A-\x5B\x5D-\x7E> . ']' . ')'; #the content of a comment is either ctext or a quoted pair #we are deviating from RFC 2822, because comments can nest arbitrarily. But we don't allow that. my $ccontent = qq<($ctext|$quoted_pair)>; #|$comment, but we don't allow nesting here #and finally, a comment is a ( followed by arbitrary ccontent, followed by another ) my $comment = '(' . '\(' . qq<($fws?$ccontent)*$fws?> . '\)' . ')'; while ($email =~ /$comment/o){$email =~ s/$comment//go}; return $email; }; }; # _valid_precedence is used internally to check whether a precedence is valid, i.e., list, bulk, or junk # It is called by the Precedence wrapper to the _Precedence attribute sub _valid_precedence { my $self = shift; my $value = shift; if ($self->Trusting('precedence') || (defined $value && $value =~ /list|bulk|junk/i)){ return 1; } else { $value = '' unless defined $value; return $self->error("Invalid precedence ($value) : only 'list', 'bulk', or 'junk'", "MB008"); }; }; #/validation #now, for the methods =pod =item lc_domain given an email address, lowercases the domain. Mainly used internally, but I thought it might be useful externally as well. print $self->lc_domain('Jim@JimANDKoka.com'); #prints Jim@jimandkoka.com print $self->lc_domain('JIM@JIMANDKOKA.com'); #prints JIM@jimandkoka.com print $self->lc_domain('jim@jimandkoka.com'); #prints jim@jimandkoka.com This method is known to be able to return: MB009 - cannot lowercase domain w/o email =cut sub lc_domain { #lowercase the domain part, but _not_ the local part. Why not? #Read the specs, you can't make assumptions about the local part, it is case sensitive #even though 99.999% of the net treats it as insensitive. my $self = shift; my $email = shift || return $self->error("Cannot lowercase domain with no email address", "MB009"); (my $lc = $email) =~ s/^(.+)@(.+)$/$1@\L$2/; return $lc; }; =pod =item setDuplicate sets an email address as a duplicate. $bulk->setDuplicate($email); once an address is set as a duplicate, then isDuplicate will return a true value for that address print $bulk->isDuplicate($email2); #prints 0 $bulk->setDuplicate($email2); print $bulk->isDuplicate($email2); #prints 1 This is mainly used internally, but I decided to make it external anyway. setDuplicate will always return 1 if you have Trusting('duplicates') set. Be warned that there is a performance hit to using this, since it will eventually store your entire list inside an entire hashref in memory. You're in much better shape if you weed out the duplicates in advance and then set Trusting('duplicates' => 1) to skip the check and skip storing the values in the hashref. But if you have to use this to weed out values, go to town. This method is known to be able to return: MB010 - cannot set duplicate w/o email =cut sub setDuplicate { my $self = shift; my $email = shift || return $self->error("Cannot set duplicate without email", "MB010"); return 1 if $self->Trusting('duplicates'); if (! $self->Trusting('banned')) { $self->_duplicates->{lc $email} = 1; } else { $self->_duplicates->{$self->lc_domain($email)} = 1; }; return 1; }; =pod =item isDuplicate returns a boolean value as to whether an email address is a duplicate print $bulk->isDuplicate($email); #prints 0 or 1 once an address is set as a duplicate, then isDuplicate will return a true value for that address print $bulk->isDuplicate($email2); #prints 0 $bulk->setDuplicate($email2); print $bulk->isDuplicate($email2); #prints 1 This is mainly used internally, but I decided to make it external anyway. isDuplicate will always return 0 if you have Trusting('duplicates' => 1) set. Be warned that there is a performance hit to using this, since it will eventually store your entire list inside an entire hashref in memory. You're in much better shape if you weed out the duplicates in advance and then set Trusting('duplicates' => 1) to skip the check and skip storing the values in the hashref. But if you have to use this to weed out values, go to town. =cut sub isDuplicate { my $self = shift; my $email = shift || return $self->undef("Cannot check duplicate without email", "MB015"); return 0 if $self->Trusting('duplicates'); if (! $self->Trusting('banned')){ return $self->_duplicates->{lc $email}; } else { return $self->_duplicates->{$self->lc_domain($email)}; }; }; =pod =item isBanned returns a boolean value as to whether an email address (or domain) is banned or not $bulk->isBanned($email); #prints 0 or 1 $bulk->isBanned($domain); #prints 0 or 1 ->isBanned goes off of the values populated via the banned attribute This is mainly used internally, but I decided to make it external anyway. =cut sub isBanned { my $self = shift; my $email = shift || return $self->undef("Cannot check banned-ness without email", "MB016"); (my $domain = $email) =~ s/^.+@//; return 2 if $self->banned->{lc $domain}; if (! $self->Trusting('banned')){ return $self->banned->{lc $email}; } else { return $self->banned->{$self->lc_domain($email)}; }; }; =pod =item nextServer Again, mainly used internally. ->nextServer will iterate over the ->servers array and return the next valid, connected server. If a server is not connected, ->nextServer will try to make it connect. If the server cannot connect, it will go on to the next one. Once all servers are exhausted, it returns undef. nextServer is called if the present server object has reached one of its internal limits. See Mail::Bulkmail::Server for more information on server limits. This method is known to be able to return: MB011 - No servers (->servers array is empty) MB012 - No available servers (cannot connect to any servers) =cut sub nextServer { my $self = shift; return $self->error("No servers", "MB011") unless $self->servers && @{$self->servers}; my $old_idx = $self->_server_index; my $new_idx = ($old_idx + 1) % @{$self->servers}; #special case for loop prevention. Internally, we initially start @ -1, to start off at 0 instead of 1. $old_idx = 0 if $new_idx == 0; while (1){ #prevent infinite loops. If we get back to the beginning AND that server is worthless ("not not worthless"), then #we can't connect to any of 'em. if ($new_idx == $old_idx && ! $self->servers->[$new_idx]->_not_worthless){ return $self->error("No available servers", "MB012"); } else { #if we're connected, we're golden. if ($self->servers->[$new_idx]->connected){ $self->_server_index($new_idx); return $self->servers->[$new_idx]; } #otherwise, try to connect else { $self->servers->[$new_idx]->connect; #if we succeed, we're golden if ($self->servers->[$new_idx]->connected){ $self->_server_index($new_idx); return $self->servers->[$new_idx]; } } }; #otherwise, no matter what, if we're down here we want to look at the next server in the list $new_idx = ($new_idx + 1) % @{$self->servers}; }; }; =pod =item extractEmail The extract methods return results equivalent to the return of valid_email extracts the email address from the data passed in the bulkmail object. Not necessary in Mail::Bulkmail, since all it does in here is reflect through the same value that is passed. This will be very important in a subclass, though. getNextLine might return values beyond just simple email addresses in subclasses, hashes, objects, whatever. You name it. In that case, extractEmail is necessary to find the actual email address out of whatever it is that was returned from getNextLine(). But here? Nothing to worry about. This method is known to be able to return: MB013 - cannot extract email w/o email =cut sub extractEmail { my $self = shift; my $email = shift || return $self->error("Cannot extract email w/o email", "MB013"); return $self->valid_email($$email); }; =pod =item extractSender The extract methods return results equivalent to the return of valid_email extracts the sender of the message from the data passed in the bulkmail object. Not necessary in Mail::Bulkmail, since all it does in here is return either the Bulkmail object's Sender or its From field. This will be very important in a subclass, though. getNextLine might return values beyond just simple email addresses in subclasses - hashes, object, whatever. You name it. In that case, extractEmail is necessary to find the actual email address out of whatever it is that was returned from getNextLine(). But here? Nothing to worry about. =cut sub extractSender { my $self = shift; #we cheat like a madman in this method. We -know- that the Sender and the From are valid, since we validated #them before they're insered. So we do the trivial extract and return that way. my $sender = $self->Sender || $self->From; my $return_hash = {'original' => $sender}; $sender =~ s/.+<(.+)>/$1/g; $return_hash->{'extracted'} = $sender; return $return_hash; }; =pod =item extractReplyTo The extract methods return results equivalent to the return of valid_email extracts the Reply-To of the message from the data passed in the bulkmail object. Not necessary in Mail::Bulkmail, since all it does in here is return either the Bulkmail object's Sender or its From field. This will be very important in a subclass, though. getNextLine might return values beyond just simple email addresses in subclasses - hashes, object, whatever. You name it. In that case, extractEmail is necessary to find the actual email address out of whatever it is that was returned from getNextLine(). But here? Nothing to worry about. =cut sub extractReplyTo { my $self = shift; #we cheat like a madman in this method. We -know- that the Sender and the From are valid, since we validated #them before they're insered. So we do the trivial extract and return that way. my $replyto = $self->ReplyTo || $self->From; my $return_hash = {'original' => $replyto}; $replyto =~ s/.+<(.+)>/$1/g; $return_hash->{'extracted'} = $replyto; return $return_hash; }; =pod =item preprocess This is another method that'll do more in a subclass. When you had off data to either ->mail or ->bulkmail, it gets preprocessed before it's actually used. In Mail::Bulkmail itself, all it does is take a non-reference value and turn it into a reference, or return a reference as is if that was passed. Here, the whole method: sub preprocess { my $self = shift; my $val = shift; return ref $val ? $val : \$val; }; But in a subclass, this may be much more important. Making sure that your data is uniform or valid, that particular values are populated, additional tests, whatever. =cut sub preprocess { my $self = shift; my $val = shift; return ref $val ? $val : \$val; }; # _force_wrap_string is an internal method that handles wrapping lines as appropriate, either to 80 characters per line # if ->force80 is true, and otherwise to 1000 characters to comply with RFC2822. Will not touch the string # if Trusting is set to 1. # # though this is re-written, I'm still not terribly thrilled with it. sub _force_wrap_string { my $self = shift; my $string = shift; my $spaceprepend= shift || 0; my $noblanks = shift || 0; #if we're trusting the wrap, just return the string return $string if $self->Trusting('wrapping'); #determine the length we wrap to my $length = $self->force80 ? 78 : 998; #if we're tacking a space on to the front, that's an extra character, so decrement the length to match $length-- if $spaceprepend; #we want to split into as many fields as there are returns in the message my @returns = $string =~ m/(\015\012)/g; my @lines = split(/\015\012/, $string, scalar @returns); foreach (@lines){ if (length $_ > $length){ my $one = 0; # boy, did this take finesse. Only prepend a space if it's not the start of the original line # That way, we can properly wrap our headers. That's what $one is. # this regex puts as many characters before a wordbreak as it can into $1, and the rest into $2. # if a string is a solid word greater than the the length, it all goes into $2 $_ =~ s/(?:([^\015\012]{1,$length})\b)?([^\015\012]+)/$self->_process_string($1, $2, $length, $spaceprepend && ! $one++ ? 1 : 0)/ge; }; }; #rebuild our string $string = join("\015\012", @lines); #get rid of any blank lines we may have created, if so desired. if ($noblanks){ $string =~ s/\015\012[^\015\012\S]*\015\012/\015\012/g while $string =~ /\015\012[^\015\012\S]+\015\012/; }; return $string; }; # process string is used internally by _force_wrap_string to do wrapping, as appropriate. sub _process_string { my $self = shift; my $one = shift || ''; #$1, passed from _force_wrap_string my $two = shift || ''; #$2, passed from _force_wrap_string my $length = shift; #the length we're wrapping to my $spaceprepend = shift || 0; #whether we're prepending a space #re-define the spaceprepend to the character we will prepend. $spaceprepend = $spaceprepend ? ' ' : ''; #if we don't have $1, then we have a single word greater than the length. Cut it up at the length point, globally if (! $one){ $two =~ s/([^\015\012]{$length})/$1\015\012$spaceprepend/g; return $two; } #otherwise, use the same regex that _force_wrap_string uses and proceed recusively. else { $two =~ s/(?:([^\015\012]{1,$length})\b)?([^\015\012]+)/$self->_process_string($1, $2, $length, $spaceprepend)/ge; return "$one\015\012$spaceprepend$two"; } }; =pod =item buildHeaders buildHeaders is mainly used internally, like its name implies, it builds the headers for the message. You'll never need to call buildHeaders unless you're subclassing, in which case you may want to override this method with a new routine to build headers in a different fashion. This method is called internally by ->bulkmail and ->mail otherwise and is not something you need to worry about. The first time buildHeaders is called, it populates _cached_headers so as not to have to go through the processing of rebuilding the headers for each address in your list. This method is known to be able to return: MB014 - no From address MB015 - no To address =cut sub buildHeaders { my $self = shift; my $data = shift; my $headers_hash = shift || $self->_headers; if ($self->use_envelope && $self->_cached_headers){ return $self->_cached_headers; } elsif ($self->_cached_headers){ my $headers = ${$self->_cached_headers}; my $extracted_emails = $self->extractEmail($data); my $email = $extracted_emails->{'original'}; $headers =~ s/^To: ##EMAIL##/To: $email/m; return \$headers; }; my $headers = undef; $headers .= "Date: " . $self->Date . "\015\012"; if (my $from = $self->From){ $headers .= "From: " . $from . "\015\012"; } else { return $self->error("Cannot bulkmail...no From address", "MB014"); }; $headers .= "Subject: " . $self->Subject . "\015\012" if defined $self->Subject && $self->Subject =~ /\S/; #if we're using the envelope, then the To: header is the To attribute if (my $to = $self->use_envelope ? $self->To : "##EMAIL##"){ $headers .= "To: $to\015\012"; } else { return $self->error("Cannot bulkmail...no To address", "MB015"); }; my $sender_hash = $self->extractSender($data); if (defined $sender_hash) { $headers .= "Sender: " . $sender_hash->{'original'} . "\015\012"; } my $reply_to_hash = $self->extractReplyTo($data); if (defined $reply_to_hash) { $headers .= "Reply-To: " . $reply_to_hash->{'original'} . "\015\012"; }; #we're always going to specify at least a list precedence $headers .= "Precedence: " . ($self->Precedence || 'list') . "\015\012"; if ($headers_hash->{"Content-type"}){ $headers .= "Content-type: " . $headers_hash->{"Content-type"} . "\015\012"; } else { if ($self->HTML){ $headers .= "Content-type: text/html\015\012"; } else { $headers .= "Content-type: text/plain\015\012"; }; }; foreach my $key (keys %{$headers_hash}) { next if $key eq 'Content-type'; my $val = $headers_hash->{$key}; next if ! defined $val || $val !~ /\S/; $headers .= $key . ": " . $val . "\015\012"; }; # I'm taking credit for the mailing, dammit! $headers .= "X-Bulkmail: " . $Mail::Bulkmail::VERSION . "\015\012"; $headers = $self->_force_wrap_string($headers, 'start with a blank', 'no blank lines'); $headers .= "\015\012"; #blank line between the header and the message $self->_cached_headers(\$headers); unless ($self->use_envelope){ my $h = $headers; #can't just use $headers, we'll screw up the ref in _cached_headers my $extracted_emails = $self->extractEmail($data); my $email = $extracted_emails->{'original'}; $h =~ s/^To: ##EMAIL##/To: $email/m; return \$h; }; return \$headers; }; =pod =item buildMessage buildMessage is mainly used internally, like its name implies, it builds the body of the message You'll never need to call buildMessage unless you're subclassing, in which case you may want to override this method with a new routine to build your message in a different fashion. This method is called internally by ->bulkmail and ->mail otherwise and is not something you need to worry about. This method is known to be able to return: MB016 - ->Message is not defined =cut sub buildMessage { my $self = shift; my $data = shift; #if we've cached the message, then return it return $self->_cached_message if $self->_cached_message && $self->_current_message; #otherwise, use the Message, cache that and return it. my $message = $self->Message() || return $self->error("Cannot build message w/o message", "MB016"); return $message if ref $message; #sendmail-ify our line breaks $message =~ s/(?:\r?\n|\r\n?)/\015\012/g; $message = $self->_force_wrap_string($message); #double any periods that start lines $message =~ s/^\./../gm; #and force a CRLF at the end, unless one is already present $message .= "\015\012" unless $message =~ /\015\012$/; $message .= "."; $self->_cached_message(\$message); return \$message; }; =pod =item bulkmail This is the bread and butter of the whole set up, and it's easy as pie. $bulk->bulkmail(); will take your list, iterate over it, build all your message headers, build your message, and email to everyone on your list, iterating through all of your servers, log all relevant information, and send you happily on your way. Easy as pie. You don't even need to worry about it if you subclass things, because you'd just need to override buildHeaders, buildMessage, getNextLine and extractEmail at most. This method is known to be able to return: MB017 - duplicate email MB018 - banned email MB019 - invalid sender/from =cut sub bulkmail { my $self = shift; my $server = $self->nextServer || return undef; my $last_data = undef; while (defined (my $data = $self->getNextLine)){ if (my $r = $server->reached_limit){ #if a message is waiting on the previous server, then finish it off if ($self->_waiting_message) { my $headers = $self->buildHeaders($last_data); my $message = $self->buildMessage($last_data); # it is *imperative* that we only send DATA if we have the headers and message body. # otherwise, the server will hang. if ($headers && $message) { my $rc = $server->talk_and_respond("DATA"); $server->talk_and_respond($$headers . $$message) if $rc; } my $extracted_emails = $self->extractEmail($last_data); if (defined $extracted_emails) { $self->setDuplicate($extracted_emails->{'extracted'}); }; }; $server = $self->nextServer || return undef; #new server, so nothing should be waiting, and there are no cached domains $self->_waiting_message(0); $self->_cached_domain(undef); #and reset that server's counters $server->reset_message_counters(); }; $data =~ s/(?:^\s+|\s+$)//g unless ref $data; $data = $self->preprocess($data) || next; my $extracted_emails = $self->extractEmail($data) || next; my $email = $extracted_emails->{'extracted'}; #check for duplicates or banned addresses if ($self->isDuplicate($email)){ $self->logToFile($self->BAD, $data) if $self->BAD; $self->error("Invalid email address $email : duplicate", "MB017"); next; } elsif (my $b = $self->isBanned($email)){ $self->logToFile($self->BAD, $data) if $self->BAD; $self->error("Invalid email address $email : " . ($b == 2 ? 'banned domain' : 'banned address'), "MB018"); next; }; #use the envelope, if we're using it if ($self->use_envelope){ #extract the domain from the email address (my $domain = lc $email) =~ s/^[^@]+@//; #first, see if this is a new domain, either the first time through, if it's a different domain than the last #one we saw, or if we reached the server's envelope limit if (! $self->_cached_domain || ($self->_cached_domain && $domain ne $self->_cached_domain()) || $server->reached_envelope_limit) { #if a message is waiting, then finish it off if ($self->_waiting_message) { my $headers = $self->buildHeaders($last_data); my $message = $self->buildMessage($last_data); # it is *imperative* that we only send DATA if we have the headers and message body. # otherwise, the server will hang. if ($headers && $message) { my $rc = $server->talk_and_respond("DATA"); $server->talk_and_respond($$headers . $$message) if $rc; } my $extracted_emails = $self->extractEmail($last_data); if (defined $extracted_emails) { $self->setDuplicate($extracted_emails->{'extracted'}); }; $self->_waiting_message(0); }; #reset our connection, just to be safe $server->talk_and_respond("RSET") || next; my $from_hash = $self->extractSender($data) || return $self->error("Could not get valid sender/from address", "MB019"); my $from = $from_hash->{'extracted'}; #say who the message is from $server->talk_and_respond("MAIL FROM:<" . $from . ">") || next; #now, since we know that we reset and sent MAIL FROM properly, we'll reset our counter #and cache this domain #reset that server's envelope counter $server->reset_envelope_counter(); #so now we want to cache this domain $self->_cached_domain($domain); }; #now, we add this email address to the envelope $server->talk_and_respond("RCPT TO:<" . $email . ">") || next; #a message is now waiting to be sent $self->_waiting_message(1); #make a note of the email address in the log $self->logToFile($self->GOOD, $data) if $self->GOOD; #we need to keep track of the last email sent, to finish off the final #waiting_message at the end. $last_data = $data; #and finally, we cache the domain $self->_cached_domain($domain); } #not using the envelope else { $self->mail($data, $server) || next; }; #make a note of this email address $self->setDuplicate($email); #and we increment our counters $server->increment_messages_sent(); }; #if a message is waiting, then finish it off if ($self->_waiting_message) { my $headers = $self->buildHeaders($last_data); my $message = $self->buildMessage($last_data); # it is *imperative* that we only send DATA if we have the headers and message body. # otherwise, the server will hang. if ($headers && $message) { my $rc = $server->talk_and_respond("DATA"); $server->talk_and_respond($$headers . $$message) if $rc; } my $extracted_emails = $self->extractEmail($last_data); if (defined $extracted_emails) { $self->setDuplicate($extracted_emails->{'extracted'}); }; $self->_waiting_message(0); }; return 1; }; =pod =item mail Works the same as ->bulkmail, but only operates on one email address instead of a list. $bulk->mail('jim@jimandkoka.com'); Sends your Message as defined in ->Message to jim@jimandkoka.com. You can also optionally pass in a server as the second argument. $bulk->mail('jim@jimandkoka.com', $server); is the same as above, but relays through that particular server. if you don't pass a server, if tries to bring the next one in via ->nextServer ->mail wants its first argument to be whatever would be normally returned by a call to ->getNextLine($bulk->LIST); Right now, that's just a single email address. But that may change in a subclass. So, if you're operating in a subclass, just remember that you may be able (or required) to pass additional information in your first argument. This method is known to be able to return: MB018 - banned email MB019 - invalid sender/from address =cut sub mail { my $self = shift; my $data = shift; my $passed_server = shift; my $server = $passed_server || $self->nextServer() || return undef; $data = $self->preprocess($data); my $extracted_emails = $self->extractEmail($data) || return undef; my $email = $extracted_emails->{'extracted'}; if (my $b = $self->isBanned($email)){ $self->logToFile($self->BAD, $data) if $self->BAD; return $self->error("Invalid email address $email : " . ($b == 2 ? 'banned domain' : 'banned address'), "MB018"); }; #reset our connection, just to be safe $server->talk_and_respond("RSET") || return $self->error($server->error, $server->errcode, 'not logged'); my $from_hash = $self->extractSender($data) || return $self->error("Could not get valid sender/from address", "MB019"); my $from = $from_hash->{'extracted'}; #say who the message is from $server->talk_and_respond("MAIL FROM:<" . $from . ">") || return $self->error($server->error, $server->errcode, 'not logged'); #now, we add this email address to the envelope $server->talk_and_respond("RCPT TO:<" . $email . ">") || return $self->error($server->error, $server->errcode, 'not logged'); #we build the headers and message body FIRST, to make sure we have them. #that way, we can never send DATA w/o a message and hang the server my $headers = $self->buildHeaders($data) || return undef; my $message = $self->buildMessage($data) || return undef; $server->talk_and_respond("DATA") || return $self->error($server->error, $server->errcode, 'not logged'); $server->talk_and_respond($$headers . $$message) || return undef; #make a note of the email address in the log $self->logToFile($self->GOOD, $data) if $self->GOOD; return $email; }; 1; __END__ =pod =back =head1 FAQ =over 5 =item So just how fast is this thing, anyway?> I don't know any more, I don't have access to the same gigantic lists I used to anymore. :~( But, basically, Really fast. Really stupendously incredibly fast. The last official big benchmark I ran was with v1.11. That list runs through to completion in about an hour and 43 minutes, which meant that Mail::Bulkmail 1.11 could process (at least) 884 messages per minute or about 53,100 per hour. The last message sent out was 4,979 bytes. 4979 x 91,140 people is 453,786,060 bytes of data transferred, or about 453.786 megabytes in 1 hour and 43 minutes. This is a sustained transfer rate of about 4.4 megabytes per minute, or 264.34 megabytes per hour. So then, that tells you how fast the software was back in 1999, 2 major revisions ago. But, invariably, you want to know what it's like *now*, right? Well, I'll do my best to guesstimate it. However, these tests were not run through an SMTP relay, they were run using DummyServer in v3.0 and a hacked 2.05 and (severely) hacked 1.11 to insert similar functionality. All data was sent to /dev/null. Tests were performed on a 5,000 recipient list. First of all, with envelope sending turned off (average times): v1.11......20 seconds (1.00) v3.00......23 seconds (1.15) v2.05......50 seconds (2.5) 1.11 was the speed champ in this case, but that's not surprising considering the fact that it did a lot less processing than the other 2. The fact that 3.00 almost catches it should speak to the improvement in the code in the 3.x release. 2.05 was...clunky. Now then, there's another thing to consider, envelope sending. With envelope sending turned on (average times): v3.00......12 seconds (1.00) v2.05......19 seconds (1.58) v1.11......22 seconds (1.83) This is with an envelope_limit of 100. So the supposed speed gains that envelope sending were supposed to see in 2.05 never really materialized. While doing these tests, I discovered a bug in 2.05's use_envelope routine that would sometimes cause it to slow down substantially. 3.00, with a new routine, was never affected. Incidentally, Bulkmail 2.05 will be faster with trivially low envelope_limits. Bulkmail 3.00 becomes faster with an envelope_limit greater than 2. There is also mail merging (filemapping in 1.x) that should be considered. This was benchmarked with Mail::Bulkmail::Dynamic for 3.00. A simple mail merge with one item was used, and one global item, read from a file, and split on a delimiter (since this was the only functionality that v1.x had). With mail merge turned on (average times): v1.11......20 seconds (1.00) v3.00......35 seconds (1.75) v2.05......40 seconds (2.00) And finally, 2.x and 3.x have both had the capability to generate a dynamic message. This is a minimal test with one dynamic message element, one dynamic header, and a mail merge into the dynamic element: v3.00......36 seconds (1.00) v2.05......44 seconds (1.22) So 3.x is usually faster than 2.x, but sometimes slower than 1.x. Which makes sense, again due to the added features in 2.x and 3.x. These tests do not take into account the multi-server capability introduced in 3.00. Also note that these speeds are only measuring the time it takes to get from Mail::Bulkmail to your SMTP relay. There are no measurements reflecting how long it may take your SMTP relay to send the data on to the recipients on your list. =item Am I going to see speeds that fast? Maybe, maybe not. It depends on how busy your SMTP server is. If you have a relatively unused SMTP server with a fair amount of horsepower and a fast connection, you can easily get these speeds or beyond. If you have a relatively busy and/or low powered SMTP server or slow connections, you're not going to reach speeds that fast. =item How much faster will Mail::Bulkmail be than my current system? This is a very tough question to answer, since it depends highly upon what your current system is. For the sake of argument, let's assume that for your current system, you open an SMTP connection to your server, send a message, and close the connection. And then repeat. Open, send, close, etc. Mail::Bulkmail will I be faster than this approach since it opens one SMTP connection and sends every single message across on that one connection. How much faster depends on how busy your server is as well as the size of your list. The connection will only be closed if you have an error or if you reach the max number of messages to send in a given server connection. Lets assume (for simplicity's sake) that you have a list of 100,000 people. We'll also assume that you have a pretty busy SMTP server and it takes (on average) 25 seconds for the server to respond to a connection request. We're making 100,000 connection requests (with your old system). That means 100,000 x 25 seconds = almost 29 days waiting just to make connections to the server! Mail::Bulkmail makes one connection, takes 25 seconds for it, and ends up being 100,000x faster! But, now lets assume that you have a very unbusy SMTP server and it responds to connection requests in .003 seconds. We're making 100,000 connection requests. That means 100,000 x .0003 seconds = about 5 minutes waiting to make connections to the server. Mail::Bulkmail makes on connection, takes .0003 seconds for it, and ends up only being 1666x faster. But, even though being 1,666 times faster sounds impressive, the world won't stop spinning on its axis if you use your old system and take up an extra 5 minutes. And this doesn't even begin to take into account systems that don't open and close SMTP connections for each message. This also doesn't take into account the load balancing between multiple SMTP relays that 3.00 can perform. In short, there's no way for me to tell how much faster (if at all) it'll be. Try it and find out. =item Have you benchmarked it against anything else? Not scientifically. I've heard that Mail::Bulkmail 1.10 is about 4-5x faster than Listcaster from Mustang Software, but I don't have any hard numbers. But nothing beyond that. If you want to benchmark it against some other system and let me know the results, it'll be much appreciated. :-) =item Can I send spam with this thing? No. Don't be a jerk. =item SMTP relay? Wazzat? All Mail::Bulkmail does is provide you a quick way to relay information from your local machine through to your SMTP relay (which may be the same machine). Your SMTP relay then sends the messages on to the rest of the world. So your SMTP server must be configured properly to allow you to relay your messages out. It is recommended that this machine be kept behind a firewall for security reasons. Make sure that it's configured properly so it's not an open relay. Ask your SysAdmin for help. =item What about multi-part messages? Not yet supported. I'll definitely add internal support for multi-part/alternative in the future. Until then? You can always do the MIME encoding yourself, set your own headers, etc. It's perfectly fine to do it yourself, but you will have to do it yourself for now. =item Mail::Bulkmail is really cool, but what'd be even cooler is a front end for the thing! Do you have one of those? I don't. But check out Mojo Mail: http://mojo.skazat.com/ Active community, developer, etc. Looks like a good product. =item You know, you re-invent a lot of wheels. Yeah, I do. Hey, c'mon, I write this stuff for the fun of it. And that means that I'm going to do it the way that I want to. :) Besides, I've never had any problem with re-inventing wheels. After all, if the wheel hadn't been re-invented a few times, we'd still be using solid plain wooden wheels. Not to say that I necessarily think that I've invented better things here than are available elsewhere, but I might eventually. Who knows. Anyway, you're more than free to subclass and over-ride things with "standard" modules if you'd like. ou can make your own server implementation using Net::SMTP, or your own dynamic message system using Text::Template, or whatever else. Feel free to use the standards if you'd prefer. Me? I enjoy re-inventing wheels, so I'll continue to do so. =item Dude! Warnings is on! That's by design. Nothing in the code ever should generate a warning, but if it does, then please please B let me know about it so I can patch it. You can always turn off warnings yourself if you're worried/annoyed. =item So what is it with these version numbers anyway? I'm going to I to be consistent in how I number the releases. The B digit will indicate bug fixes, minor behind-the-scenes changes, etc. The B digit will indicate new and/or better functionality, as well as some minor new features. The B digit will indicate a major new feature or re-write. Basically, if you have x.ab and x.ac comes out, you want to get it guaranteed. Same for x.ad, x.ae, etc. If you have x.ac and x.ba comes out, you'll probably want to get it. Invariably there will be bug fixes from the last "hundredths" release, but it'll also have additional features. These will be the releases to be sure to read up on to make sure that nothing drastic has changes. If you have x.ac and y.ac comes out, you'll want to do research before upgrading. I break things, I lose backwards compatibility, I change stuff around a lot. Just my nature. Porting from one major release to the next is pretty straightforward, but there's still work to be done on your part - it won't just be a drop in replacement. And, depending upon your list and what options you're using, you may or may not see any benefit to upgrading. Read the docs, ask me questions, and test test test. Don't get me wrong, I'm not going to intentially *try* to make things not backwards compatible, but if I come up with what I think is a better way of doing things, I'm going to go with it. And I don't like to pollute modules with a lot of cruft bridgeworks for backwards compatibility. This thing is huge enough as is without having to worry about making sure internal band-aids work. If this'll be a problem, then don't upgrade. =item Is anything missing vs. the old versions? Yes. You can't currently extract headers from the message you're sending. This will return in the future, probably. When using dynamic_header_data, you can no longer set a default header to be used if no header is defined for the individual user. This will also probably return in the future. local merges no longer exist. You only have global merges and individual ones. It will now date all messages to the time of the first sent message. You can no longer externally load in a list of duplicates. Come on, did *anybody* ever actually do that? =item When I try to bulkmail, I get an error that says "Cannot bulkmail...no To address" How do I fix this? Ya know, I B this error was self-explanatory, but considering the number of people that email me about it, I guess it's not. The issue here is that (say it with me now), you can't bulkmail because the To header hasn't been set. If you're using envelope sending (on by default in Mail::Bulkmail), then you have to specify an address to set in the To: header of the message. This is specified via the ->To accessor. $bulk->To("mylist@mysite.com"); So, specify the To header, and then you'll be fine. =item Wow, this module is really cool. Have you contributed anything else to CPAN? Yes, Carp::Notify and Text::Flowchart =item Was that a shameless plug? Why, yes. Yes it was. =item Anything else you want to tell me? Sure, anything you need to know. Just drop me a message. =back =head1 EXAMPLES #simple mailing with a list called "./list.txt" my $bulk = Mail::Bulkmail->new( "LIST" => "./list.txt", "Subject" => "A test message", "Message" => "This is my test message", "From" => 'me@mydomain.com', "To" => 'somelist@mydomain.com', "Reply-To" => 'replies@mydomain.com' ) || die Mail::Bulkmail->error(); $bulk->bulkmail || die $bulk->error; #same thing, but turning off envelope sending my $bulk = Mail::Bulkmail->new( "LIST" => "./list.txt", "Subject" => "A test message", "Message" => "This is my test message", "From" => 'me@mydomain.com', "Reply-To" => 'replies@mydomain.com', "use_envelope" => 0 ) || die Mail::Bulkmail->error(); $bulk->bulkmail || die $bulk->error; #Small example, with a miniature in memory list my $bulk = Mail::Bulkmail->new( "LIST" => [qw(test@mydomain.com me@mydomain.com test2@mydomain.com)], "Subject" => "A test message", "Message" => "This is my test message", "From" => 'me@mydomain.com', "To" => 'somelist@mydomain.com', "Reply-To" => 'replies@mydomain.com', "Sender" => 'sender@mydomain.com' ) || die Mail::Bulkmail->error(); $bulk->bulkmail || die $bulk->error; #Make sure our error logging is on in a different place, and set up a different server my $server = Mail::Bulkmail::Server->new( 'Smtp' => "smtp.mydomain.com", "Port" => 25 ) || die Mail::Bulkmail::Server->error(); my $bulk = Mail::Bulkmail->new( "LIST" => "./list.txt", "Subject" => "A test message", "Message" => "This is my test message", "From" => 'me@mydomain.com', "To" => 'somelist@mydomain.com', "Reply-To" => 'replies@mydomain.com', "ERRFILE" => '/etc/mb/error.file.txt', "servers" => [$server] #our new server ) || die Mail::Bulkmail->error(); $bulk->bulkmail || die $bulk->error; #Make sure our error logging is on in a different place, and set up a different server #this time, we'll use a dummy server for debugging purposes my $dummy_server = Mail::Bulkmail::DummyServer->new( "dummy_file" => "/etc/mb/dummy.server.output.txt" ) || die Mail::Bulkmail::DummyServer->error(); my $bulk = Mail::Bulkmail->new( "LIST" => "./list.txt", "Subject" => "A test message", "Message" => "This is my test message", "From" => 'me@mydomain.com', "To' => 'somelist@mydomain.com', "Reply-To" => 'replies@mydomain.com', "ERRFILE" => '/etc/mb/error.file.txt', "servers" => [$dummy_server] #our new server, which is a dummy server ) || die Mail::Bulkmail->error(); $bulk->bulkmail || die $bulk->error; #mailing just to one address my $bulk = Mail::Bulkmail->new( "Subject" => "A test message", "Message" => "This is my test message", "From" => 'me@mydomain.com', "Reply-To" => 'replies@mydomain.com', "Sender" => 'sender@mydomain.com' ) || die Mail::Bulkmail->error(); $bulk->mail('test@yourdomain.com') || die $bulk->error; #here, a fun one. Use a coderef as our LIST my $query = "select email, domain from table order by domain"; my $stmt = $dbh->prepare($query) || die; $stmt->execute || die; sub get_list { my $bulk = shift; #we always get our bulkmail object first my $data = $stmt->fetchrow_hashref(); if ($data) { return $data->{"email"}; } else { return undef; }; }; $bulk->LIST(\&get_list); #and now, logging to a coderef. my $query = ('insert into table good_addresses (email) values (?)'); my $stmt = $dbh->prepare($query) || die; sub store_to_db { my $bulk = shift; #always get our bulkmail object first my $email = shift; $stmt->execute($email) || return $bulk->error("Could not store to DB!"); return 1; }; $bulk->GOOD(\&store_to_db); =head1 SAMPLE CONFIG FILE This is my current conf file. It's about as close to one that you want to use as possible. Remember, you can set any values you'd like in the conf file, as long as they're scalars or arrayrefs of scalars. For example, if you want a default "From" value, then define it in the conf file. For more information on conf files, see Mail::Bulkmail::Object. For more information on the server file, see Mail::Bulkmail::Server. This file is also stored in the file "sample.cfg.file" define package Mail::Bulkmail #server_class stores the server object that we're going to use. #uncomment the DummyServer line and comment out the Server line for debugging server_class = Mail::Bulkmail::Server #server_class = Mail::Bulkmail::DummyServer #log our errors ERRFILE = /etc/mb/error.txt BAD = /etc/mb/bad.txt GOOD = /etc/mb/good.txt banned = /etc/mb/banned.txt #if we want a default From value, you can place it here. #From = me@mydomain.com define package Mail::Bulkmail::Server #set up the domain we use to say HELO to our relay Domain = mydomain.com #Most servers are going to connect on port 25, so we'll set this as the default port here Port = 25 #We'll give it 5 tries to connect before we let ->connect fail Tries = 5 #Lets try to reconnect to a server 5 times if ->connect fails. max_connection_attempts = 5 #100 is a good number for the envelope_limit envelope_limit = 100 #Send 1,000 messages to each server in the round before going to the next one. #set max_messages_per_robin to 0 if you're only using one server, otherwise you'll have needless #overhead max_messages_per_robin = 0 #maximum number of messages per connection. Probably best to keep this 0 unless you have a reason #to do otherwise max_messages_per_connection = 0 #maximum number of messages for the server. Probably best to keep this 0 unless you have a reason #to do otherwise max_messages= 0 #maximum number of messages to send before sleeping, probably best to keep this 0 unless you need #to let your server relax and sleep max_messages_while_awake = 0 #sleep for 10 seconds if we're sleeping. This line is commented out because we don't need it. #No harm in uncommenting it, though. #sleep_length = 10 #our list of servers server_file = /etc/mb/servers.txt define package Mail::Bulkmail::Dynamic #it is highly recommended that quotemeta be 1 quotemeta = 1 #set up our default delimiters dynamic_message_delimiter = ; dynamic_message_value_delimiter = = dynamic_header_delimiter = ; dynamic_header_value_delimiter = = #we're going to assume that duplicates have been weeded out, so we'll allow them. Trusting @= duplicates #By default, we'll turn on our envelope. Mail::Bulkmail might as well use it. #Mail::Bulkmail::Dynamic doesn't care about this value. use_envelope = 1 define package Mail::Bulkmail::DummyServer #Our dummy data file, for when we're using DummyServer. It's also useful to send the data to #/dev/null to test things if you don't care about the message output. dummy_file = /etc/mb/dummy.file #dummy_file = /dev/null =head1 DIAGNOSTICS Bulkmail doesn't directly generate any errors. If something fails, it will return undef and set the ->error property of the bulkmail object. If you've provided an error log file, the error will be printed out to the log file. Check the return of your functions, if it's undef, check ->error to find out what happened. Be warned that isDuplicate and isBanned will return 0 if an address is not a duplicate or banned, respectively, but this is not an error condition. =head1 SEE ALSO Mail::Bulkmail::Object, Mail::Bulkmail::Server, Mail::Bulkmail::Dummy =head1 COPYRIGHT (again) Copyright and (c) 1999, 2000, 2001, 2002, 2003 James A Thomason III (jim@jimandkoka.com). All rights reserved. Mail::Bulkmail is distributed under the terms of the Perl Artistic License. =head1 CONTACT INFO So you don't have to scroll all the way back to the top, I'm Jim Thomason (jim@jimandkoka.com) and feedback is appreciated. Bug reports/suggestions/questions/etc. Hell, drop me a line to let me know that you're using the module and that it's made your life easier. :-) http://www.jimandkoka.com/jim/perl/ for more perl info, http://www.jimandkoka.com in general =cut libmail-bulkmail-perl-3.12.orig/Changes0100644000175000017500000002556707771665534016570 0ustar jojojojoRevision history for Perl module Mail::Bulkmail. 3.12 Mon Dec 22, 2003 - headers_from_message would fail under mysterious cirumstances, not all of which have been explicitly discovered. Should now be resolved (thanks to Eric Litman for bringing this to my attention) - Under certain conditions, ->bulkmail could hang upon server connect attempt. Basically, Mail::Bulkmail::Server wasn't always flaggin a server as worthless. (thanks to Frank Naude for discovering one of these conditions) - in a fit of generousity, Mail::Bulkmail::Object is now distributed under the Artistic License 3.11 Sun Nov 30, 2003 - love it when I discover bugs in the test suite! Fixed a potentially fatal bug when sending to domains under certain conditions (thanks to Eric Litman for discovering this) - turned off some debugging code that had snuck by me - updated the pod regarding message_from_file to help alleviate a possible PEBKAC issue - the server_file can now accept more parameters, such as CONVERSATION, envelope_limit, etc. 3.10 Tue Nov 25, 2003 - message_from_file was hopelessly broken. Now fixed. - valid_email now returns a hash (see the pod) - extractEmail now returns a hash (see the pod) - added extractSender and extractReplyTo for dynamic senders and replies-to - added the errvals method - Timeouts were still breaking under Windows. Now fixed. (thanks to Finn Smith for pointing this out) - Fixed a pod formatting flaw (thanks to Todd Karlsson for pointing this out) - error now just returns (additionally appropriately returning void in a void context) 3.09 Fri Apr 04, 2003 - Mail::Bulkmail::Dynamic wasn't properly doubling periods. Oops. (thanks to Matthew Williams for pointing this out) - Gah. Mail::Bulkmail::DummyServer had some crap in it regarding how filehandles were created and passed. 5.8.0 would complain about it. (many thanks to Christ Faust for giving me info to help track this down) - as per request, added a space after the : in the headers - added a fileno test on the socket to prevent printing on a closed filehandle - added a 'no warnings "portable"' to make 5.8 shut up - added a few more examples to the docs 3.08 Sat Mar 29, 2003 - Damn this makes me mad. Turns out I was doubling periods and *then* wrapping the message. In some unlikely circumstances, that could cause a lone period on a line in the middle of a message, which is, of course, bad. Now does doubling after wrapping. (thanks to Guy Matz for pointing this out!) 3.07 Fri Mar 28, 2003 - Fixed a stupid little bug that should not have slipped by me. (thanks to Guy Matz for pointing this out!) - broke the version numbers back out into the individual modules, so CPAN wouldn't bitch 3.06 Tue Mar 25, 2003 - No longer even attempts to connect to a server if you haven't specified the Tries parameter - You can now change the text of the Message after bulkmailing or mailing (This means you may change the non-merged, non-dynamic text via a new call to ->Message, it is recommended that you do not do this unless you know why you are doing it. dynamic messages and mail merges will do what you want 99% of the time) - added some entries to the FAQ - ->error now returns () in a list context, undef in a scalar context - added some more documentation - the constructor now operates on passed keys/values in the order they were passed - added message_from_file flag to load in a message from a file on disk - added headers_from_message to extract message headers from the value passed to ->Message - you may now unset From, To, Sender, Reply-To headers by calling the relevant method and passing an undef as customary with the returns from ->header, will return 0 if you successfully set a header to undef - if you wish, for some foolish reason, to name one of your log files "0", you may now do that. 3.05 Thu Feb 6, 2003 - *mutter* fixed a flaw in my test suite (thanks to an error reported by Ben Wrigley) - added the migration guide (migration.guide.txt) - adjusted how Mail::Bulkmail::Dynamic internally handles headers - fixed some documentation errors - tweaked some of the code to look more consistent - Mail::Bulkmail::Dynamic no longer incorrectly requires a ->To header to be set. (again, thanks to Ben Wrigley) 3.04 Tue Feb 4, 2003 - setting a header to undef now deletes it, instead of storing it in the hash as undef. This wasn't terribly important, since the header wouldn't be set in the message if it was empty, but it was good for consistency's sake. Also, if you set a header to undef, the method now returns 0, for a non-true but defined value. - All $VERSION numbers now reference the master version number in Mail::Bulkmail::Object - Fixed a bug where trying to call ->header in Mail::Bulkmail::Dynamic w/o using dynamic_header_data would cause a crash. (thanks to Justin Simoni for catching this) - added the ->errstring convenience method (in Mail::Bulkmail::Object) - Will now bubble up error codes from methods called at construction instead of replacing with the default code. Still uses the default codes if one is not passed. - Fixed an obscure error that might have caused a slightly incorrect error message if there's a failure during construction. - Wrappered the alarm calls in evals to catch them on systems that don't implement it. (like some stupid versions of activeperl on windows) 3.03 Fri Jan 24, 2003 - Fixed a potentially disasterous bug that could cause the system to hang infinitely if there's a severely mal-formed Message - fixed a minor logging error that could cause some errors to be logged twice - DummyServer now says EHLO, to be consistent with Server - if using a coderef for logging/reading, now gets the bulkmail object as its first argument - Mail::Bulkmail::Server now has a CONVERSATION log, to aid in debugging. - Magically fixed another bug in envelope sending. I can't say exactly what it was or how it was fixed or when it manifested itself, but it was there. (again, many thanks to Tim de Wolf for his continued help in tracking this down) 3.02 Thu Jan 23, 2003 - Fixed a bug in envelope sending that I can't believe I managed to allow into the final release. (many thanks to Tim de Wolf for finding this and helping me isolate it) - fixed some documentation errors in the examples - now logs to ERRFILE if the server didn't accept an EHLO - doesn't skip current email address if there's an error on the previous one - fixed a ridiculously obscure bug that could manifest with an invalid Sender - headers weren't *quite* RFC 2822 compliant (they were still valid RFC 822) 3.01 Thu Jan 23, 2003 - Fixed an annoylingly old bug in setting the envelope header which could cause an invalid address to be sent (thanks to Joseph Brown for identifying this) - removed the debugging routine that required Data::Dumper 3.00 Mon Jan 20, 2003 - Componentized the code. (Mail::Bulkmail, Mail::Bulkmail::Dynamic, Mail::Bulkmail::Server, etc.) - Added multiple server support. - added support for timing out if there's no reply from a server - Finally fixed the damn Tz bug. - Cleaned up the code an awful lot. - General bug fixes, etc. - Brand spanking new docs. - Errors now return error codes as well as error text - should be fully RFC 2821 and RFC 2822 compliant - defaults now set in a conf file 2.05 Tues Oct 3, 2000 - Added envelope_limit accessor. - You can now set more defaults yourself. - Cleaned up the documentation a lot. - Re-wrote the date generation methods. They're now 5-10% faster and I fixed an *old* bug causing mail to sometimes appear to have been sent yesterday, or tomorrow. - Altered logging when using the envelope, see item GOOD, above. - Fixed a bug with undefined values in mailmerges 2.04 Tues Aug 29, 2000 - Added log_full_line flag. - Trusting is now more trusting. - Domains can once again be banned. - Error checking is done less often and in a slightly different order now - ->bulkmail now returns 1 on success. Doh. - Fixed an annoyingly subtle bug with construction of dynamic messages - Repaired a long-standing bug in the docs. 2.03 Tues Aug 22, 2000 - Tweaked the constructor - Enhanced the 'error' method so it can behave as a class method - Enhanced HFM - Enhanced the test suite - various bug fixes 2.01 Wed Aug 16, 2000 - Fixed a mindnumblingly dumb bug whereby merge and dynamic hashes weren't initialized. 2.00 Fri Aug 11, 2000 - Re-wrote everything. Literally _everything_. Total re-write. - Added in support for dynamic messaging. - Added in support for envelope sending. - Added in ability to import lists from more sources. - Mail::Bulkmail should now behave absolutely perfectly with -w and use strict. - Did I mention that this is a ground-up re-write? Your existing code will need to be tweaked slightly to use the new module. 1.11 Tue Nov 09, 1999 - Banned addresses now checks entire address case insensitively instead of leaving the local part alone. Better safe than sorry. - $self->fmdl is now used to split BULK_FILEMAP - Various fixes suggested by Chris Nandor to make -w shut up. - Changed the way to provide local maps to mail and bulkmail so it's more intuitive. 1.10 Wed Sep 08, 1999 - Several little fixes. - The module will now re-connect if it receives a 221 (connection terminated) message from the server. - Fixed a potential near-infinite loop in the _valid_email routine. - _valid_email now merrily strips away comments (even nested ones). :) - hfm (headers from message) method added. - fmdl (filemap delimiter) method added. 1.01 Wed Sep, 01, 1999 - Fixed a bug in the email validation routine which would cause the module to hang severely on certain malformed addresses. All is once again right with the world. - Altered default date generation to be RFC 1123 compliant (4 digit year) - changed date generation so that it adds a space after the comma after the day. This is because of a bug in Outlook that wouldn't recognize the date w/o the space. 1.00 Wed Aug 18, 1999 - First public release onto CPAN 0.93 Thu Aug 12, 1999 - Re-vamped the documentation substantially. 0.92 Thu Aug 12, 1999 - Started adding a zero in front of the version name, just like I always should have - Changed accessing of non-standard headers so that they have to be accessed and retrieved via the "headset" method. This is because methods cannot have non-word characters in them. From, Subject, and Precedence headers may also be accessed via headset, if you so choose. - AUTOLOAD now complains loudly (setting ->error and printing to STDERR) if it's called. .91 Wed Aug 11, 1999 - Fixed bugs in setting values which require validation checks. - Fixed accessing of non-standard headers so that the returns are identical to every other accesor method. .90 Tue Aug 10, 1999 - Initial "completed" release. First release available to general public. libmail-bulkmail-perl-3.12.orig/MANIFEST0100644000175000017500000000027207620465317016376 0ustar jojojojoChanges Makefile.PL MANIFEST test.pl sample.cfg.file sample.server.file migration.guide.txt Bulkmail.pm Bulkmail/Object.pm Bulkmail/Server.pm Bulkmail/DummyServer.pm Bulkmail/Dynamic.pm libmail-bulkmail-perl-3.12.orig/Makefile.PL0100644000175000017500000000045507620071643017215 0ustar jojojojouse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Mail::Bulkmail', 'VERSION_FROM' => 'Bulkmail/Object.pm', # finds $VERSION 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 ); libmail-bulkmail-perl-3.12.orig/migration.guide.txt0100644000175000017500000000406407620513515021070 0ustar jojojojoThis is to help you migrate from Mail::Bulkmail 2.x to Mail::Bulkmail 3.x change use Mail::Bulkmail 2.05 to use Mail::Bulkmail 3.03 "/path/to/conf/file"; change $bulk->allow_duplicates(1); to $bulk->Trusting('duplicates' => 1) (should be in the conf file as Trusting @= duplicates) change $bulk->safe_banned(1) to $bulk->Trusting('banned' => 0); (should just not be specified, since it defaults to 0. And yes, it's correct, they're inverse. Trusting('banned' => 0) == safe_banned(1)) change $bulk->log_full_line(1); to $bulk->log_all_data(1); You no longer specify Smtp, Port, Tries in the constructor or as object calls, these should be specified in the conf file instead. See the sample config and sample server list files for examples as to how to set that up. It's important not to specify those items in the constructor, since they'll now turn into headers. $bulk->new( 'Smtp' => 'your.smtp.com' ); Now sends a message with "Smtp : your.smtp.com" as a header. Headers from message (HFM) is no longer supported. This may return in the future. If you're creating a dynamic message, such as with a mail merge, dynamic message components, or dynamic headers, you now need to use Mail::Bulkmail::Dynamic. So change: $bulk = Mail::Bulkmail->new(); to $bulk = Mail::Bulkmail::Dynamic->new(); ONLY change it if you're using dynamic messages. To specify a merge, change this: $bulk->new( 'merge' => { 'date' => '01/28/2003', 'person' => 'bob', 'BULK_MAILMERGE' => 'BULK_EMAIL::name::age' } ); to: $bulk->new( 'global_merge' => { 'date' => '01/28/2003', 'person' => 'bob' }, 'merge_keys' => [qw(BULK_EMAIL name age)] ); You should specify any delimiters you need in the conf file. There is no longer any support for local merges. $bulk->bulkmail({'local_key' => 'local_value'}); no longer works. Use global_merge instead. change $bulk->dynamic({...}); to $bulk->dynamic_message_data({...}); change $bulk->dynamic_headers({...}); to $bulk->dynamic_header_data({...}); change DYNAMIC_MESSAGE to BULK_DYNAMIC_MESSAGE change DYNAMIC_HEADERS to BULK_DYNAMIC_HEADERS libmail-bulkmail-perl-3.12.orig/sample.cfg.file0100644000175000017500000000676607614276036020144 0ustar jojojojo#################### # # First, we'll set up values for Mail::Bulkmail # #################### define package Mail::Bulkmail #server_class stores the server object that we're going to use. #uncomment the DummyServer line and comment out the Server line for debugging server_class = Mail::Bulkmail::Server #server_class = Mail::Bulkmail::DummyServer #log our errors ERRFILE = /etc/mb/error.txt BAD = /etc/mb/bad.txt GOOD = /etc/mb/good.txt banned = /etc/mb/banned.txt #by default, our precedence will be list #remember, it can only be list, bulk, or junk precedence = list #we're going to recommend that you follow the 80 character per line limit force80 = 1 #And we're only going to be trusting with duplicates Trusting @= duplicates #By default, we'll turn on our envelope. Mail::Bulkmail might as well use it. #Mail::Bulkmail::Dynamic doesn't care about this value. use_envelope = 1 #################### # # Now, we'll set values for Mail::Bulkmail::Server # #################### define package Mail::Bulkmail::Server #set up the domain we use to say HELO to our relay Domain = mydomain.com #Most servers are going to connect on port 25, so we'll set this as the default port here Port = 25 #We'll give it 5 tries to connect before we let ->connect fail Tries = 5 #Lets try to reconnect to a server 5 times if ->connect fails. max_connection_attempts = 5 #100 is a good number for the envelope_limit envelope_limit = 100 #Send 1,000 messages to each server in the round before going to the next one. #set max_messages_per_robin to 0 if you're only using one server, otherwise you'll have needless #overhead max_messages_per_robin = 0 #maximum number of messages per connection. Probably best to keep this 0 unless you have a reason #to do otherwise max_messages_per_connection = 0 #maximum number of messages for the server. Probably best to keep this 0 unless you have a reason #to do otherwise max_messages= 0 #maximum number of messages to send before sleeping, probably best to keep this 0 unless you need #to let your server relax and sleep max_messages_while_awake = 0 #sleep for 10 seconds if we're sleeping. This line is commented out because we don't need it. #No harm in uncommenting it, though. #sleep_length = 10 #time_out is how long we'll wait for a response code from a server before giving up. This should #be pretty high time_out = 3000 #talk_attempts is how many times we'll try to re-send a command after a 400 level (temporary) error #this should be fairly low talk_attempts = 5 #our list of servers server_file = /etc/mb/servers.txt #we can log the full SMTP conversation. ONLY turn this on for debugging purposes. #this file is going to get HUGE. #CONVERSATION = /etc/mb/conversation.txt #################### # # Now, we'll set values for Mail::Bulkmail::DummyServer # #################### define package Mail::Bulkmail::DummyServer #Our dummy data file, for when we're using DummyServer. It's also useful to send the data to #/dev/null to test things if you don't care about the message output. dummy_file = /etc/mb/dummy.file #dummy_file = /dev/null #################### # # Now, we'll set values for Mail::Bulkmail::Dynamic # #################### define package Mail::Bulkmail::Dynamic #it is highly recommended that quotemeta be 1 quotemeta = 1 #set up our default delimiters dynamic_message_delimiter = ; dynamic_message_value_delimiter = = dynamic_header_delimiter = ; dynamic_header_value_delimiter = = libmail-bulkmail-perl-3.12.orig/sample.server.file0100644000175000017500000000052007610667227020673 0ustar jojojojodefine package Mail::Bulkmail::Server #we've already set up the server defaults in sample.cfg.file, so here we #just need to define a list of Smtp servers Smtp @= smtp1.mydomain.com Smtp @= smtp2.mydomain.com Smtp @= smtp3.mydomain.com #of course, you may add as many smtp servers as you'd like. 3 isn't a magic number or anything. libmail-bulkmail-perl-3.12.orig/test.pl0100644000175000017500000000445207643126733016566 0ustar jojojojo# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "Starting tests\n\n"; } END {print "not ok 1\n\n" unless $loaded;} use Mail::Bulkmail; $loaded = 1; my $ok = 1; print "loaded Mail::Bulkmail...ok ", $ok++, "\n\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): use Mail::Bulkmail::Object; use Mail::Bulkmail::Dynamic; use Mail::Bulkmail::Server; use Mail::Bulkmail::DummyServer; $loaded = 1; print "Loaded all modules...ok ", $ok++, "\n\n"; #create a DummyServer that sends to /dev/null my $dummy = Mail::Bulkmail::DummyServer->new( 'dummy_file' => '/dev/null', 'Domain' => 'yourdomain.com' ) || die Mail::Bulkmail::DummyServer->error(); print "Successfully created dummy server object...ok ", $ok++, "\n\n"; print "okay...now I'm going to try a test message. Nothing will actually be sent...\n\n"; my $bulk = Mail::Bulkmail->new( 'LIST' => [qw(valid_address@yourdomain.com invalid_address@yourdomain valid_address2@yourdomain.com)], 'GOOD' => \&good, 'BAD' => \&bad, 'From' => 'test@yourdomain.com', 'Message' => 'This is a test message', 'Subject' => "test message", 'servers' => [$dummy] ) || die Mail::Bulkmail->error(); print "Successfully created bulkmail object...ok ", $ok++, "\n\n"; $bulk->bulkmail || die $bulk->error(); print "Successfully bulkmailed...ok ", $ok++, "\n\n"; print "All succesful...done\n\n"; sub good { my $obj = shift; my $email = shift; if ($email eq 'valid_address@yourdomain.com' || $email eq 'valid_address2@yourdomain.com'){ print "Mail successfully sent to $email...ok ", $ok++, "\n\n"; } else { print "Mail could not be sent to $email...not ok", $ok++, "\n\n"; }; }; sub bad { my $obj = shift; my $email = shift; if ($email eq 'invalid_address@yourdomain'){ print "Mail did not send to $email...ok ", $ok++, "\n\n"; } else { print "Mail could successfully sent to $email...not ok", $ok++, "\n\n"; }; };