Pm/Likes.pm
Copying Source is Forbidden
370 lines of code
1
package Likes;
2
3
#/
4
# a pm to handle "likes"
5
#
6
#/
7
8
use strict;
9
use warnings;
10
use CGI::Carp qw(fatalsToBrowser);
11
use Exporter;
12
use vars qw($VERSION @ISA @EXPORT_OK @EXPORT);
13
use CGI;
14
15
$VERSION = 1.00;
16
@ISA = qw(Exporter);
17
18
##########################
19
#use statements here
20
21
use lib "./Pm";
22
23
##########################
24
25
my $TABLE_BORDER = 0;
26
my $DEBUG = 0;
27
28
##########################
29
push @EXPORT_OK, "likes";
30
sub likes(;$$) {
31
#*
32
# to return a list of likes for a given uid (default = LOGGEDIN)
33
# if $params is a hash reference, required keys are:
34
# $params->{uid}
35
# $params->{debug}
36
# else
37
# $params will be treated like it's a UID
38
#*
39
my ($params) = @_; # a hash of params
40
my $sql = "select * from likes where uid=";
41
42
if (ref $params eq "HASH") {
43
$sql .= $Bc_sql::DB->quote($params->{uid});
44
} else {
45
if (not $params) { $params = $Bc_sql::LOGGEDIN; }
46
$sql .= $Bc_sql::DB->quote($params);
47
}
48
49
my $rv = Bc_sql::sql_execute($sql, "", 1);
50
51
return $rv; # a list reference
52
#usage: my $likes = likes();
53
}
54
55
##########################
56
push @EXPORT_OK, "dislikes";
57
sub dislikes(;$$) {
58
#*
59
# to return a list of dislikes for a given uid (default = LOGGEDIN)
60
# if $params is a hash reference, required keys are:
61
# $params->{uid}
62
# $params->{debug}
63
# else
64
# $params will be treated like it's a UID
65
#*
66
my ($params) = @_; # a hash of params
67
my $sql = "select * from dislikes where uid=";
68
69
if (ref $params eq "HASH") {
70
$sql .= $Bc_sql::DB->quote($params->{uid});
71
} else {
72
if (not $params) { $params = $Bc_sql::LOGGEDIN; }
73
$sql .= $Bc_sql::DB->quote($params);
74
}
75
76
my $rv = Bc_sql::sql_execute($sql, "", 1);
77
78
return $rv; # a list reference
79
#usage: my $dislikes = dislikes();
80
}
81
82
##########################
83
push @EXPORT_OK, "liked";
84
sub liked($) {
85
#*
86
# to determine if something is liked by given uid
87
# if $params is a hash reference, required keys are:
88
# $params->{uid} (default = $Bc_sql::LOGGEDIN)
89
# $params->{page}
90
# $params->{count} = returns count (default: off = returns true/false)
91
# $params->{debug}
92
# else
93
# $params will be treated like it's a liked item ID
94
#*
95
my ($params) = @_; # a hash of params
96
my $rv = 0;
97
my $sql = "select * from likes ";
98
my $uid = $Bc_sql::LOGGEDIN;
99
my $itemid = $params;
100
my $count = 0;
101
102
if (ref $params eq "HASH") {
103
if ($params->{uid}) { $uid = $params->{uid}; }
104
$itemid = $params->{page};
105
}
106
107
if ($count) {
108
$sql .= "where item_id=" . $Bc_sql::DB->quote($itemid);
109
} else {
110
$sql .= "where uid=" . $Bc_sql::DB->quote($uid) . " and item_id=" . $Bc_sql::DB->quote($itemid);
111
}
112
113
my $result = Bc_sql::sql_execute($sql, "", 1);
114
if (@$result) {
115
if ($count)
116
{ $rv = @$result; } else
117
{ $rv = 1; }
118
}
119
120
return $rv; # 0, or 1, or a count of likes for page
121
#usage: my $liked = liked($itemid);
122
}
123
124
##########################
125
push @EXPORT_OK, "disliked";
126
sub disliked($) {
127
#*
128
# to determine if something is disliked by given uid
129
# if $params is a hash reference, required keys are:
130
# $params->{uid} (default = $Bc_sql::LOGGEDIN)
131
# $params->{page}
132
# $params->{count} = returns count (default: off = returns true/false)
133
# $params->{debug}
134
# else
135
# $params will be treated like it's a liked item ID
136
#*
137
my ($params) = @_; # a hash of params
138
my $rv = 0;
139
my $sql = "select * from dislikes ";
140
my $uid = $Bc_sql::LOGGEDIN;
141
my $itemid = $params;
142
my $count = 0;
143
144
if (ref $params eq "HASH") {
145
if ($params->{uid}) { $uid = $params->{uid}; }
146
$itemid = $params->{page};
147
}
148
149
if ($count) {
150
$sql .= "where item_id=" . $Bc_sql::DB->quote($itemid);
151
} else {
152
$sql .= "where uid=" . $Bc_sql::DB->quote($uid) . " and item_id=" . $Bc_sql::DB->quote($itemid);
153
}
154
155
my $result = Bc_sql::sql_execute($sql, "", 1);
156
if (@$result) {
157
if ($count)
158
{ $rv = @$result; } else
159
{ $rv = 1; }
160
}
161
162
return $rv; # 0, or 1, or a count of likes for page
163
#usage: my $disliked = disliked($itemid);
164
}
165
166
##########################
167
push @EXPORT_OK, "like";
168
sub like($) {
169
#*
170
# to like/unlike itemid
171
# if $itemid is liked then like is removed and this returns 0
172
# else like is added and this returns 1
173
# if $params is a hash reference, required keys are:
174
# $params->{uid} (default = $Bc_sql::LOGGEDIN)
175
# $params->{page}
176
# $params->{set} = like (1) or not liked (0)
177
# $params->{debug}
178
# else
179
# $params will be treated like it's an item ID
180
#*
181
my ($params) = @_; # a hash of params
182
my $rv = 1;
183
184
my $uid = $Bc_sql::LOGGEDIN;
185
my $itemid = $params;
186
my $set = 0;
187
my $admin = 0;
188
my $str = "";
189
190
if (ref $params eq "HASH") {
191
if ($params->{uid}) { $uid = $params->{uid}; }
192
$itemid = $params->{page};
193
$set = $params->{set};
194
if ($params->{admin}) { $admin = isUserAdmin(); }
195
}
196
197
my $sql = "";
198
199
my $result = Bc_sql::sql_execute($sql, "", 1);
200
my $ignore = 0;
201
202
if (liked($itemid)) {
203
# item is liked, so unlike it.
204
# unless {set} == 1
205
$sql = "delete from likes where uid=" . $Bc_sql::DB->quote($uid) . " and item_id=" . $Bc_sql::DB->quote($itemid);
206
if ($admin) {
207
if ($set == 0)
208
{ $rv = 0; } else
209
{ $ignore = 1; }
210
}
211
}
212
else {
213
# item is not liked, so like it.
214
# unless set == 0
215
$sql = "insert into likes values (" .
216
"NULL, " .
217
$Bc_sql::DB->quote($uid) . ", " .
218
$Bc_sql::DB->quote($itemid) . ", " .
219
$Bc_sql::DB->quote(Date::get_today("db", 1)) .
220
")";
221
# now, check if we have a dislike on this item
222
# remove it if we do
223
if (disliked($itemid)) { dislike($itemid); }
224
if ($admin and $set != 1) { $ignore = 1; }
225
}
226
227
if (not $ignore) {
228
if (not Bc_sql::sql_execute($sql, $sql)) { $rv = 0; } # -1, in perl's mind, is "true"! fucker!
229
}
230
231
return $rv; # can be 1 or 0. Beware: 0 can also indicate an error.
232
#usage: if (like($itemid)) { print "item liked"; } else { print "item unliked"; }
233
}
234
235
##########################
236
push @EXPORT_OK, "dislike";
237
sub dislike($) {
238
#*
239
# to dislike/undislike itemid
240
# if $itemid is disliked then dislike is removed and this returns 0
241
# else dislike is added and this returns 1
242
# if $params is a hash reference, required keys are:
243
# $params->{uid} (default = $Bc_sql::LOGGEDIN)
244
# $params->{page}
245
# $params->{set} = like (1) or not liked (0)
246
# $params->{debug}
247
# else
248
# $params will be treated like it's an item ID
249
#*
250
my ($params) = @_; # a hash of params
251
my $rv = 1;
252
253
my $uid = $Bc_sql::LOGGEDIN;
254
my $itemid = $params;
255
my $set = 0;
256
my $admin = 0;
257
258
if (ref $params eq "HASH") {
259
$uid = $params->{uid};
260
$itemid = $params->{page};
261
$set = $params->{set};
262
if ($params->{admin}) { $admin = isUserAdmin(); }
263
}
264
265
my $where = "where uid=" . $Bc_sql::DB->quote($uid) . " and item_id=" . $Bc_sql::DB->quote($itemid);
266
my $sql = "";
267
my $ignore = 0;
268
269
if (disliked($itemid)) {
270
# item is disliked, so undislike it.
271
# unless {set} == 1
272
$sql = "delete from dislikes " . $where;
273
if ($admin) {
274
if ($set == 0)
275
{ $rv = 0; } else
276
{ $ignore = 1; }
277
}
278
} else {
279
# item is not disliked, so dislike it.
280
# unless set == 0
281
$sql = "insert into dislikes values (" .
282
"NULL, " .
283
$Bc_sql::DB->quote($uid) . ", " .
284
$Bc_sql::DB->quote($itemid) . ", " .
285
$Bc_sql::DB->quote(Date::get_today("db", 1)) .
286
")";
287
# now, check if we have a like on this item
288
# remove it if we do
289
if (liked($itemid)) { like($itemid); }
290
if ($admin and $set != 1) { $ignore = 1; }
291
}
292
293
if (not $ignore) {
294
if (not Bc_sql::sql_execute($sql, $sql)) { $rv = 0; } # -1, in perl's mind, is "true"! fucker!
295
}
296
297
return $rv; # can be 1 or 0. Beware: 0 can also indicate an error.
298
#usage: if (dislike($itemid)) { print "item disliked"; } else { print "item undisliked"; }
299
}
300
301
##########################
302
##########################
303
##########################
304
##########################
305
##########################
306
##########################
307
##########################
308
##########################
309
##########################
310
##########################
311
##########################
312
##########################
313
##########################
314
##########################
315
##########################
316
##########################
317
##########################
318
##########################
319
##########################
320
##########################
321
##########################
322
##########################
323
##########################
324
325
########################
326
sub _tests(;$) {
327
#*
328
# to test <i>Pm::Likes</i> subroutines
329
#*
330
my ($extended) = @_; # to display extended info
331
my $output = "";
332
333
### LIKES ###
334
my $likes = likes();
335
if (ref $likes eq "ARRAY") {
336
if (@$likes) {
337
$output .= "$Bc_sql::LOGGEDIN liked images:" . Html2::br();
338
foreach my $like (@$likes) {
339
$output .= " " . $like . Html2::br();
340
}
341
} else {
342
$output .= "no likes found for $Bc_sql::LOGGEDIN" . Html2::br();
343
}
344
} else {
345
$output .= "this shouldn't have happened!" . Html2::br();
346
}
347
348
### LIKED ###
349
my $id = 43;
350
if (liked($id)) {
351
$output .= "image liked";
352
} else {
353
$output .= "image not liked";
354
}
355
$output .= Html2::br();
356
357
### LIKE ###
358
if (like($id)) {
359
# wasn't liked, but now is
360
$output .= "wasn't liked, but now is";
361
} else {
362
# was liked, but now isn't
363
$output .= "was liked, but now isn't";
364
}
365
366
return $output; # a scalar
367
#usage: print _tests();
368
}
369
370
1;