1 |
#!/usr/bin/perl -w |
2 |
|
3 |
# part of wopi poll toolkit |
4 |
# |
5 |
# 2003-04-24 Dobrica Pavlinusic <dpavlin@rot13.org> |
6 |
|
7 |
use strict; |
8 |
use DBI; |
9 |
use Digest::MD5 qw(md5 md5_hex md5_base64); |
10 |
use XML::Simple; |
11 |
use common; |
12 |
|
13 |
my $db="a01"; |
14 |
my $debug; |
15 |
|
16 |
#$debug=1; |
17 |
|
18 |
$|++; |
19 |
|
20 |
my $in_xml=shift; |
21 |
|
22 |
if (! $in_xml) { |
23 |
print "Usage: $0 poll.xml\n"; |
24 |
exit; |
25 |
} |
26 |
|
27 |
my $config = XMLin($in_xml); |
28 |
# dump all other parts of poll and keep just config |
29 |
$config = $config->{config}; |
30 |
|
31 |
my $in_mail = x($config->{mail}) || die "XML file doesn't have <config mail=\"file\"> tag"; |
32 |
my $prefix = x($config->{prefix}) || die "XML file doesn't have <config prefix=\"wopi_\"> tag"; |
33 |
my $db_user = x($config->{db_user}) || die "XML file doesn't have <config db_user=\"username\"> tag"; |
34 |
my $sql = x($config->{send_sql}) || die "XML file doesn't have <config send_sql=\"select id,name,surname,email from member\"> tag"; |
35 |
my $url = x($config->{url}) || die "XML file doesn't have <config url=\"http://host/path/\"> tag"; |
36 |
|
37 |
$url .= "/" if ($url !~ m#/$#); # add trailing / |
38 |
|
39 |
my $poll = $in_xml; $poll =~ s/\.xml//gi; |
40 |
|
41 |
sub id_encode { |
42 |
my $id = shift @_; |
43 |
my $trid = $id; |
44 |
$trid =~ tr/1234567890/abcdef1234/; |
45 |
return md5_hex($id).$trid; |
46 |
} |
47 |
|
48 |
#--- |
49 |
|
50 |
my $dbh_poll = DBI->connect("DBI:Pg:dbname=${prefix}${poll}","","") || die $DBI::errstr; |
51 |
|
52 |
# read all members which are allready sent |
53 |
my $sth = $dbh_poll->prepare("select member_id from poslani") || die $dbh_poll->errstr(); |
54 |
$sth->execute() || die $sth->errstr(); |
55 |
my %poslano; |
56 |
while (my $row = $sth->fetchrow_hashref() ) { |
57 |
$poslano{$row->{member_id}}++; |
58 |
} |
59 |
|
60 |
# send to all members |
61 |
my $dbh_member = DBI->connect("DBI:Pg:dbname=${prefix}members","","") || die $DBI::errstr; |
62 |
$sth = $dbh_member->prepare($sql) || die $dbh_member->errstr(); |
63 |
$sth->execute() || die $sth->errstr(); |
64 |
|
65 |
while (my $row = $sth->fetchrow_hashref() ) { |
66 |
if (! defined($poslano{$row->{id}})) { |
67 |
$dbh_poll->do("insert into poslani (member_id) values ($row->{id})") if (! $debug); |
68 |
my $full_name="$row->{name} $row->{surname}"; |
69 |
$full_name =~ tr/ðèæÐÈÆ/¹ð¾èæ©Ð®ÈÆ/; # 1250 -> iso8859-2 |
70 |
$full_name =~ tr/¹ðè澩ÐÈÆ®/sdcczSDCCZ/; |
71 |
|
72 |
my $tmpurl=$url."?a=".id_encode($row->{id}); |
73 |
my $email=$row->{email}; |
74 |
if (defined $debug) { |
75 |
open(MAIL,">> /tmp/mailfoo") || die "$!"; |
76 |
} else { |
77 |
open(MAIL,"| /usr/lib/sendmail -t") || die "sendmail: $!"; |
78 |
} |
79 |
print MAIL "To: $full_name <$email>\n"; |
80 |
open(IN,"$in_mail") || die "in mail '$in_mail': $!"; |
81 |
while(my $line = <IN>) { |
82 |
$line =~ s/##url##/$tmpurl/ig; |
83 |
foreach (keys %$row) { |
84 |
$line =~ s/##$_##/$row->{$_}/gi; |
85 |
} |
86 |
print MAIL $line; |
87 |
} |
88 |
close(IN); |
89 |
close(MAIL); |
90 |
print "." if (defined $debug); |
91 |
} |
92 |
|
93 |
} |
94 |
|
95 |
|
96 |
print "\n" if (defined $debug); |
97 |
|
98 |
undef $sth; |
99 |
$dbh_member->disconnect; |
100 |
$dbh_poll->disconnect; |