1 #!/usr/bin/perl
2 use strict;
3
4 use CGI qw(:all);
5
6 my $BASE = "http://www.forgetmenots.comm/images";
7
8 =for MySQL
9
10 DROP TABLE votes;
11 CREATE TABLE votes (
12 disk TINYINT DEFAULT 1 NOT NULL,
13 image TINYINT DEFAULT 1 NOT NULL,
14 when TIMESTAMP DEFAULT 0 NOT NULL,
15 host CHAR(16) DEFAULT '127.0.0.1' NOT NULL,
16 vote TINYINT,
17 INDEX (disk, image, when, host)
18 )
19
20 =cut
21
22 print header, start_html("Am I a forget-me-not?"),
h1("Am I a forget-me-not?");
23
24 my $previous_vote = "";
25 my $disk;
26 my $image;
27
28 {
29 defined (my $votedisk = param("disk")) or last;
30 defined (my $voteimage = param("image")) or last;
31 defined (my $rating = param("rating")) or last;
32 $votedisk =~ /\A[1-5]\z/ or last;
33 $voteimage =~ /\A\d{3}\z/ and $voteimage >= 1 and
$voteimage <= 100 or last;
34 $rating =~ /\A([1-9]|10|abstain)\z/ or last;
35
36 require DBI;
37 my $dbh = DBI->connect("dbi:mysql:merlyn_amiforgetmenot",
38 "username", "password", { RaiseError => 1 });
39
40 ## verify no recent previous vote
41 if ($rating ne "abstain" and not
42 $dbh->selectrow_array('SELECT count(*) FROM votes ' .
43 'WHERE disk = ? AND image = ? AND host = ? ' .
44 'AND when > DATE_SUB(NOW(), INTERVAL 1 HOUR)',
45 undef, $votedisk, $voteimage, $ENV{REMOTE_ADDR}))
{
46
47 ## store vote
48 $dbh->do("INSERT INTO votes (disk, image, when, host, vote) ".
49 "VALUES (?, ?, now(), ?, ?)",
50 undef, $votedisk, $voteimage, $ENV{REMOTE_ADDR}, $rating);
51 }
52
53 ## get average vote, count
54 my ($average, $count) =
55 $dbh->selectrow_array('SELECT avg(vote), count(*) FROM votes ' .
56 'WHERE disk = ? AND image = ? ' .
57 'GROUP BY disk, image',
58 undef, $votedisk, $voteimage);
59 $average = defined $average ? (sprintf "%.1f", $average) : "?";
60 $count =
61 (not defined $count or $count == 0) ? "no votes" :
62 ($count == 1) ? "1 vote" :
63 "$count votes";
64
65 $previous_vote =
66 table({-border => 1},
67 Tr(td({align => 'center'},
68 "What others thought", br,
69 $average, br,
70 "based on $count", br,
71 "You rated it: $rating", br,
72 img({src =>
"$BASE/Disk$votedisk/Thumb/$voteimage.jpg"}),
73 )));
74
75 if ($voteimage > 99) {
76 $image = "001";
77 if ($votedisk > 5) {
78 $disk = 1;
79 } else {
80 $disk = $votedisk + 1;
81 }
82 } else {
83 $image = sprintf "%03d", $voteimage + 1;
84 $disk = $votedisk;
85 }
86
87 $dbh->disconnect; # not needed in mod_perl
88 }
89
90 unless ($disk) {
91 BEGIN { srand; }
92 $disk = 1 + int rand 5;
93 $image = sprintf "%03d", 1 + int rand 100;
94 }
95
96 param("disk", $disk);
97 param("image", $image);
98 param("rating", "abstain");
99
100 print
101 start_form,
102 table({-border => 0, -colspacing => 0, -colpadding => 2},
103 Tr(td({-valign => 'top'}, $previous_vote),
104 td(table(Tr(td({-align => 'right'},
105 p("Tell me, is this a",
106 a({-href => "/cgi/go/http://www.forgetmenots.comm/"},
107 "Forget-me-not"),
108 "or not?"),
109 radio_group(-name => "rating",
110 -values => [1..10, 'abstain'],
111 -rows => 1),
112 hidden("disk"),
113 hidden("image")),
114 td(submit("vote"))),
115 Tr(td(
116 ## "disk $disk image $image<br>", # debug
117 img({src => "$BASE/Disk$disk/Small/$image.jpg"})),
118 td(table(Tr(td("see more:")),
119 map {
120 Tr(td(a({-href =>
"/cgi/go/$BASE/Disk$disk/$_/$image.jpg"}, $_)))
121 } qw(Thumb Small Medium Large Exlarge)))))))),
122 end_form;
123
124 print
125 p("Please note that images may be copyrighted by their",
126 "respective owners, and that this voting system",
127 "is not affiliated in any way with the Forget-Me-Nots site,",
128 "or related to (no matter how inspired by) the",
129 a({-href => "/cgi/go/http://www.amihotornot.com/"},
130 "Am I Hot Or Not?"), "site."),
131
132 print end_html;