notice-sender/trunk/sender.pl

#!/usr/bin/perl -w

use strict;
use Class::DBI::Loader::Pg;
use Getopt::Long;
use Mail::CheckUser qw(check_email);
use Email::Valid;
use Email::Send;

=head1 NAME

sender.pl - command line notify sender utility

=head1 SYNOPSYS

 sender.pl --add=mylist members.txt
 sender.pl --list[=mylist]
 sender.pl --queue[=mylist message.txt]
 sender.pl --send=mylist

=head2 Command options

=over 20

=cut

my $debug = 0;
my $verbose = 0;
my $list_opt;
my $add_opt;
my $queue_opt;
my $send_opt;

my $result = GetOptions(
        "list:s" => \$list_opt,
        "add=s" => \$add_opt,
        "queue:s" => \$queue_opt,
        "send:s" => \$send_opt,
        "debug" => \$debug,
        "verbose" => \$verbose,
);


my $loader = Class::DBI::Loader::Pg->new(
        debug           => $debug,
        dsn             => "dbi:Pg:dbname=notices",
        user            => "dpavlin",
        password        => "",
        namespace       => "Noticer",
#       additional_classes      => qw/Class::DBI::AbstractSearch/,
#       additional_base_classes => qw/My::Stuff/,
        relationships   => 1,
);

my $lists = $loader->find_class('lists');
my $users = $loader->find_class('users');
my $user_list = $loader->find_class('user_list');
my $messages = $loader->find_class('messages');
my $queue = $loader->find_class('queue');
my $sent = $loader->find_class('sent');

$queue->set_sql( list_queue => qq{
        SELECT messages.message, messages.date AS date, lists.name AS list
        FROM queue
        JOIN messages on message_id = messages.id
        JOIN lists on list_id = lists.id
} );


=item --list[=list_name]

List all available lists and users on them.

Optional value is name of list. With it, this option will produce just users
on that list.

=cut

if (defined($list_opt)) {
        my @lists;
        if ($list_opt ne '') {
                @lists = $lists->search( name=> $list_opt )->first || die "can't find list $list_opt";
        } else {
                @lists = $lists->retrieve_all;
        }

        foreach my $list (@lists) {
                print $list->name,"\n";
                foreach my $user_on_list ($user_list->search(list_id => $list->id)) {
                        my $user = $users->retrieve( id => $user_on_list->user_id );
                        print "\t",$user->full_name," <", $user->email, ">\n";
                }
        }

=item --add=list_name

Add users to list. Users are stored in file (which can be supplied as
argument) or read from C<STDIN>. List should be in following format:

 email@example.com      Optional full name of person
 dpavlin@rot13.org      Dobrica Pavlinusic

=cut

} elsif ($add_opt) {
        #my $noticer = $loader->find_class('Noticer') || die "can't find my class!";
        my $list = $lists->find_or_create({
                name => $add_opt,
        }) || die "can't add list $add_opt\n";

        my $added = 0;

        while(<>) {
                chomp;
                next if (/^#/ || /^\s*$/);
                my ($email, $name) = split(/\s+/,$_, 2);
                $name ||= '';
                if (! Email::Valid->address($email)) {
                        print "SKIPPING $name <$email>\n";
                        next;
                }
                print "# $name <$email>\n";
                my $this_user = $users->find_or_create({
                        email => $email,
                        full_name => $name,
                }) || die "can't find or create member\n";
                my $user_on_list = $user_list->find_or_create({
                        user_id => $this_user->id,
                        list_id => $list->id,
                }) || die "can't add user to list";
                $added++;
        }

        foreach my $c_name ($loader->tables) {
                my $c = $loader->find_class($c_name)|| die "can't find $c_name";
                $c->dbi_commit();
        }

        print "list ",$list->name," has $added users\n";

=item --queue[=list_name]

Queue message for later delivery. Message can be read from file (specified as
argument) or read from C<STDIN>.

This options without optional parametars it will display current queue.

=cut

} elsif (defined($queue_opt)) {

        if ($queue_opt ne '') {
                # add message to list queue

                my $this_list = $lists->search(
                        name => $queue_opt,
                )->first || die "can't find list $queue_opt";

                my $message_text;
                while(<>) {
                        $message_text .= $_;
                }

                die "no message" unless ($message_text);

                my $this_message = $messages->find_or_create({
                        message => $message_text
                }) || die "can't insert message";

                $this_message->dbi_commit() || die "can't add message";

                $queue->find_or_create({
                        message_id => $this_message->id,
                        list_id => $this_list->id,
                }) || die "can't add message ",$this_message->id," to list ",$this_list->id, ": ",$this_list->name;

                $queue->dbi_commit || die "can't add message to list ",$this_list->name;

                print "added message ",$this_message->id, " to list ",$this_list->name,"\n";

        } else {
                # list messages in queue        

                foreach my $m ($queue->retrieve_all) {
                        next if ($m->all_sent && ! $verbose);

                        my $l = $m->all_sent ? 'S' : 'Q';

                        my $date = $m->message_id->date;
                        $date =~ s/\..+$//;
                        my $msg = $m->message_id->message;
                        $msg =~ s/\s+/ /gs;

                        $l .= sprintf(" %-10s %15s : ", $m->list_id->name, $date);
                        $l .= substr($msg, 0, 79 - length($l));

                        print "$l\n";
                }

        }

=item --send[=list_name]

Send e-mail waiting in queue for all lists, or with optional argument for
just single list.

=cut

} elsif (defined($send_opt)) {

        my $my_q;
        if ($send_opt ne '') {
                my $l_id = $lists->search_like( name => $send_opt )->first ||
                        die "can't find list $send_opt";
                $my_q = $queue->search_like( list_id => $l_id ) ||
                        die "can't find list $send_opt";
        } else {
                $my_q = $queue->retrieve_all;
        }

        while (my $m = $my_q->next) {
                next if ($m->all_sent);

                print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";
                my $msg = $m->message_id->message;

                foreach my $u ($user_list->search(list_id => $m->list_id)) {

                        my $hdr = "To: ".$u->user_id->full_name." <". $u->user_id->email. ">\n";

                        if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
                                print "SKIP ",$u->user_id->email," message allready sent\n";
                        } else {
                                print "\t",$u->user_id->email,"\n";
                                send IO => "$hdr\n$msg";
                                $sent->create({
                                        message_id => $m->message_id,
                                        user_id => $u->user_id,
                                });
                                $sent->dbi_commit;
                        }
                }
                $m->all_sent(1);
                $m->update;
                $m->dbi_commit;
        }

} else  {
        die "see perldoc $0 for help";
}

=back


=head2 Helper options

=over 20

=item --debug

Turn on debugging output from C<Class::DBI>

=item --verbose

Dump more info on screen.

=back


=head1 AUTHOR

Dobrica Pavlinusic <dpavlin@rot13.org>

=cut

1	dpavlin	1	#!/usr/bin/perl -w
2
3			use strict;
4			use Class::DBI::Loader::Pg;
5			use Getopt::Long;
6	dpavlin	13	use Mail::CheckUser qw(check_email);
7			use Email::Valid;
8	dpavlin	14	use Email::Send;
9	dpavlin	1
10	dpavlin	6	=head1 NAME
11
12			sender.pl - command line notify sender utility
13
14	dpavlin	8	=head1 SYNOPSYS
15
16			sender.pl --add=mylist members.txt
17	dpavlin	9	sender.pl --list[=mylist]
18	dpavlin	14	sender.pl --queue[=mylist message.txt]
19	dpavlin	8	sender.pl --send=mylist
20
21	dpavlin	15	=head2 Command options
22	dpavlin	8
23			=over 20
24
25	dpavlin	6	=cut
26
27	dpavlin	12	my $debug = 0;
28	dpavlin	15	my $verbose = 0;
29	dpavlin	12	my $list_opt;
30	dpavlin	2	my $add_opt;
31	dpavlin	6	my $queue_opt;
32	dpavlin	14	my $send_opt;
33	dpavlin	1
34			my $result = GetOptions(
35	dpavlin	9	"list:s" => \$list_opt,
36	dpavlin	2	"add=s" => \$add_opt,
37	dpavlin	14	"queue:s" => \$queue_opt,
38			"send:s" => \$send_opt,
39	dpavlin	1	"debug" => \$debug,
40	dpavlin	15	"verbose" => \$verbose,
41	dpavlin	1	);
42
43
44			my $loader = Class::DBI::Loader::Pg->new(
45			debug => $debug,
46			dsn => "dbi:Pg:dbname=notices",
47			user => "dpavlin",
48			password => "",
49			namespace => "Noticer",
50			# additional_classes => qw/Class::DBI::AbstractSearch/,
51			# additional_base_classes => qw/My::Stuff/,
52	dpavlin	3	relationships => 1,
53	dpavlin	1	);
54
55	dpavlin	2	my $lists = $loader->find_class('lists');
56			my $users = $loader->find_class('users');
57			my $user_list = $loader->find_class('user_list');
58	dpavlin	6	my $messages = $loader->find_class('messages');
59	dpavlin	11	my $queue = $loader->find_class('queue');
60	dpavlin	15	my $sent = $loader->find_class('sent');
61	dpavlin	2
62	dpavlin	14	$queue->set_sql( list_queue => qq{
63	dpavlin	15	SELECT messages.message, messages.date AS date, lists.name AS list
64	dpavlin	14	FROM queue
65			JOIN messages on message_id = messages.id
66			JOIN lists on list_id = lists.id
67			} );
68
69
70	dpavlin	9	=item --list[=list_name]
71	dpavlin	8
72	dpavlin	14	List all available lists and users on them.
73	dpavlin	8
74	dpavlin	14	Optional value is name of list. With it, this option will produce just users
75			on that list.
76
77	dpavlin	8	=cut
78
79	dpavlin	9	if (defined($list_opt)) {
80			my @lists;
81			if ($list_opt ne '') {
82			@lists = $lists->search( name=> $list_opt )->first \|\| die "can't find list $list_opt";
83			} else {
84			@lists = $lists->retrieve_all;
85			}
86
87			foreach my $list (@lists) {
88	dpavlin	1	print $list->name,"\n";
89			foreach my $user_on_list ($user_list->search(list_id => $list->id)) {
90			my $user = $users->retrieve( id => $user_on_list->user_id );
91			print "\t",$user->full_name," <", $user->email, ">\n";
92			}
93			}
94	dpavlin	8
95			=item --add=list_name
96
97			Add users to list. Users are stored in file (which can be supplied as
98			argument) or read from C<STDIN>. List should be in following format:
99
100			email@example.com Optional full name of person
101			dpavlin@rot13.org Dobrica Pavlinusic
102
103			=cut
104
105	dpavlin	2	} elsif ($add_opt) {
106			#my $noticer = $loader->find_class('Noticer') \|\| die "can't find my class!";
107			my $list = $lists->find_or_create({
108			name => $add_opt,
109			}) \|\| die "can't add list $add_opt\n";
110	dpavlin	6
111			my $added = 0;
112
113	dpavlin	2	while(<>) {
114			chomp;
115			next if (/^#/ \|\| /^\s*$/);
116			my ($email, $name) = split(/\s+/,$_, 2);
117	dpavlin	15	$name \|\|= '';
118	dpavlin	13	if (! Email::Valid->address($email)) {
119			print "SKIPPING $name <$email>\n";
120			next;
121			}
122	dpavlin	2	print "# $name <$email>\n";
123			my $this_user = $users->find_or_create({
124			email => $email,
125			full_name => $name,
126			}) \|\| die "can't find or create member\n";
127			my $user_on_list = $user_list->find_or_create({
128			user_id => $this_user->id,
129			list_id => $list->id,
130			}) \|\| die "can't add user to list";
131	dpavlin	6	$added++;
132	dpavlin	2	}
133	dpavlin	3
134			foreach my $c_name ($loader->tables) {
135			my $c = $loader->find_class($c_name)\|\| die "can't find $c_name";
136			$c->dbi_commit();
137			}
138
139	dpavlin	6	print "list ",$list->name," has $added users\n";
140
141	dpavlin	14	=item --queue[=list_name]
142	dpavlin	8
143			Queue message for later delivery. Message can be read from file (specified as
144			argument) or read from C<STDIN>.
145
146	dpavlin	14	This options without optional parametars it will display current queue.
147
148	dpavlin	8	=cut
149
150	dpavlin	14	} elsif (defined($queue_opt)) {
151	dpavlin	6
152	dpavlin	14	if ($queue_opt ne '') {
153			# add message to list queue
154
155			my $this_list = $lists->search(
156			name => $queue_opt,
157			)->first \|\| die "can't find list $queue_opt";
158
159			my $message_text;
160			while(<>) {
161			$message_text .= $_;
162			}
163
164			die "no message" unless ($message_text);
165
166			my $this_message = $messages->find_or_create({
167			message => $message_text
168			}) \|\| die "can't insert message";
169
170			$this_message->dbi_commit() \|\| die "can't add message";
171
172			$queue->find_or_create({
173			message_id => $this_message->id,
174			list_id => $this_list->id,
175			}) \|\| die "can't add message ",$this_message->id," to list ",$this_list->id, ": ",$this_list->name;
176
177			$queue->dbi_commit \|\| die "can't add message to list ",$this_list->name;
178
179			print "added message ",$this_message->id, " to list ",$this_list->name,"\n";
180
181			} else {
182			# list messages in queue
183
184			foreach my $m ($queue->retrieve_all) {
185	dpavlin	15	next if ($m->all_sent && ! $verbose);
186
187			my $l = $m->all_sent ? 'S' : 'Q';
188
189			my $date = $m->message_id->date;
190			$date =~ s/\..+$//;
191			my $msg = $m->message_id->message;
192			$msg =~ s/\s+/ /gs;
193
194			$l .= sprintf(" %-10s %15s : ", $m->list_id->name, $date);
195			$l .= substr($msg, 0, 79 - length($l));
196
197	dpavlin	14	print "$l\n";
198			}
199
200	dpavlin	6	}
201
202	dpavlin	14	=item --send[=list_name]
203	dpavlin	6
204	dpavlin	14	Send e-mail waiting in queue for all lists, or with optional argument for
205			just single list.
206	dpavlin	6
207	dpavlin	14	=cut
208	dpavlin	6
209	dpavlin	14	} elsif (defined($send_opt)) {
210	dpavlin	6
211	dpavlin	15	my $my_q;
212			if ($send_opt ne '') {
213			my $l_id = $lists->search_like( name => $send_opt )->first \|\|
214			die "can't find list $send_opt";
215			$my_q = $queue->search_like( list_id => $l_id ) \|\|
216			die "can't find list $send_opt";
217			} else {
218			$my_q = $queue->retrieve_all;
219			}
220	dpavlin	6
221	dpavlin	15	while (my $m = $my_q->next) {
222			next if ($m->all_sent);
223	dpavlin	14
224	dpavlin	15	print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";
225			my $msg = $m->message_id->message;
226
227			foreach my $u ($user_list->search(list_id => $m->list_id)) {
228
229			my $hdr = "To: ".$u->user_id->full_name." <". $u->user_id->email. ">\n";
230
231			if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
232			print "SKIP ",$u->user_id->email," message allready sent\n";
233			} else {
234			print "\t",$u->user_id->email,"\n";
235			send IO => "$hdr\n$msg";
236			$sent->create({
237			message_id => $m->message_id,
238			user_id => $u->user_id,
239			});
240			$sent->dbi_commit;
241			}
242			}
243			$m->all_sent(1);
244			$m->update;
245			$m->dbi_commit;
246	dpavlin	14	}
247
248	dpavlin	1	} else {
249	dpavlin	8	die "see perldoc $0 for help";
250	dpavlin	1	}
251
252	dpavlin	8	=back
253
254	dpavlin	15
255
256			=head2 Helper options
257
258			=over 20
259
260			=item --debug
261
262			Turn on debugging output from C<Class::DBI>
263
264			=item --verbose
265
266			Dump more info on screen.
267
268			=back
269
270
271
272	dpavlin	8	=head1 AUTHOR
273
274			Dobrica Pavlinusic <dpavlin@rot13.org>
275
276			=cut
277