| 1 |
dpavlin |
1.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; |
Parent Directory
| 
Revision Log