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;