/[notice-sender]/trunk/Nos.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /trunk/Nos.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 22 - (show annotations)
Sun May 15 21:52:56 2005 UTC (18 years, 10 months ago) by dpavlin
File size: 3231 byte(s)
moved send_queued_messages to module

1 package Nos;
2
3 use 5.008;
4 use strict;
5 use warnings;
6
7 require Exporter;
8
9 our @ISA = qw(Exporter);
10
11 our %EXPORT_TAGS = ( 'all' => [ qw(
12 ) ] );
13
14 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
15
16 our @EXPORT = qw(
17 );
18
19 our $VERSION = '0.1';
20
21 use Class::DBI::Loader;
22 use Email::Valid;
23 use Email::Send;
24 use Carp;
25
26 =head1 NAME
27
28 Nos - Notice Sender core module
29
30 =head1 SYNOPSIS
31
32 use Nos;
33 my $nos = new Nos();
34
35 =head1 DESCRIPTION
36
37 Core module for notice sender's functionality.
38
39 =head1 METHODS
40
41 =head2 new
42
43 Create new instance specifing database, user, password and options.
44
45 my $nos = new Nos(
46 dsn => 'dbi:Pg:dbname=notices',
47 user => 'dpavlin',
48 passwd => '',
49 debug => 1,
50 verbose => 1,
51 );
52
53 =cut
54
55 sub new {
56 my $class = shift;
57 my $self = {@_};
58 bless($self, $class);
59
60 croak "need at least dsn" unless ($self->{'dsn'});
61
62 $self->{'loader'} = Class::DBI::Loader->new(
63 debug => $self->{'debug'},
64 dsn => $self->{'dsn'},
65 user => $self->{'user'},
66 password => $self->{'passwd'},
67 namespace => "Nos",
68 # additional_classes => qw/Class::DBI::AbstractSearch/,
69 # additional_base_classes => qw/My::Stuff/,
70 relationships => 1,
71 ) || croak "can't init Class::DBI::Loader";
72
73 $self ? return $self : return undef;
74 }
75
76 =head2 send_queued_messages
77
78 Send queued messages or just ones for selected list
79
80 $noc->send_queued_messages("my list");
81
82 =cut
83
84 sub send_queued_messages {
85 my $self = shift;
86
87 my $list_name = shift;
88
89 my $lists = $self->{'loader'}->find_class('lists');
90 my $queue = $self->{'loader'}->find_class('queue');
91 my $user_list = $self->{'loader'}->find_class('user_list');
92 my $sent = $self->{'loader'}->find_class('sent');
93
94 my $my_q;
95 if ($list_name ne '') {
96 my $l_id = $lists->search_like( name => $list_name )->first ||
97 croak "can't find list $list_name";
98 $my_q = $queue->search_like( list_id => $l_id ) ||
99 croak "can't find list $list_name";
100 } else {
101 $my_q = $queue->retrieve_all;
102 }
103
104 while (my $m = $my_q->next) {
105 next if ($m->all_sent);
106
107 print "sending message ",$m->message_id," enqueued on ",$m->date," to list ",$m->list_id->name,"\n";
108 my $msg = $m->message_id->message;
109
110 foreach my $u ($user_list->search(list_id => $m->list_id)) {
111
112 if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
113 print "SKIP ",$u->user_id->email," message allready sent\n";
114 } else {
115 print "\t",$u->user_id->email,"\n";
116
117 my $hdr = "From: " . $u->list_id->name . " <" . $u->list_id->email . ">\n" .
118 "To: " . $u->user_id->full_name . " <". $u->user_id->email. ">\n";
119
120 # FIXME do real sending :-)
121 send IO => "$hdr\n$msg";
122
123 $sent->create({
124 message_id => $m->message_id,
125 user_id => $u->user_id,
126 });
127 $sent->dbi_commit;
128 }
129 }
130 $m->all_sent(1);
131 $m->update;
132 $m->dbi_commit;
133 }
134
135 }
136
137 =head2 EXPORT
138
139 None by default.
140
141 =head1 SEE ALSO
142
143 mailman, ezmlm, sympa, L<Mail::Salsa>
144
145 =head1 AUTHOR
146
147 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
148
149 =head1 COPYRIGHT AND LICENSE
150
151 Copyright (C) 2005 by Dobrica Pavlinusic
152
153 This library is free software; you can redistribute it and/or modify
154 it under the same terms as Perl itself, either Perl version 5.8.4 or,
155 at your option, any later version of Perl 5 you may have available.
156
157
158 =cut

  ViewVC Help
Powered by ViewVC 1.1.26