· 9 years ago · Oct 23, 2016, 04:52 AM
1#!/usr/bin/perl -w
2
3# written by andrewt@cse.unsw.edu.au September 2015
4# as a starting point for COMP2041/9041 assignment 2
5# http://cgi.cse.unsw.edu.au/~cs2041/assignments/bitter/
6
7use CGI qw/:all/;
8use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
9use Data::Dumper;
10use List::Util qw/min max/;
11use CGI::Cookie;
12use Digest::MD5 qw(md5_hex);
13use File::Copy;
14use Env;
15use File::Path;
16warningsToBrowser(1);
17
18
19# some globals used through the script
20$debug = 1;
21$dataset_size = "large";
22$attachments_dir = "dataset-$dataset_size/attachments";
23$users_dir = "dataset-$dataset_size/users";
24$bleats_dir = "dataset-$dataset_size/bleats";
25$default_picture = '../assets/images/default_pic.jpg';
26$stylesheet = '../assets/stylesheets/bitter.css';
27$max_length_of_bleat = '142';
28$max_attachments = 4;
29$escape_description = 0; #whether we escape html tags in desciption
30$bleats_per_page = 10;
31
32
33# form.innerHTML += "<input type='button' name='submit' onclick='reply_bleat("" + document.getElementById('bleat_box').value + "", " + bleat + ");'/>";
34# delete script
35$js_delete = <<"eof";
36<script type="text/javascript">
37function delete_bleat(bleat) {
38 if (confirm('Are you sure you want to delete your bleat?')) {
39 var dict = get_params();
40 dict['delete_bleat'] = bleat;
41 post("bitter.cgi", dict);
42 }
43}
44
45function reply_bleat(bleat, reply) {
46 //alert(""+bleat);
47 var dict = get_params();
48 dict['new_bleat'] = ""+bleat;
49 if (typeof reply === 'undefined') {
50 //
51 } else {
52 dict['in_reply_to'] = reply;
53 }
54
55 //alert(dict['new_bleat']);
56 post("bitter.cgi", dict);
57}
58
59function show_reply_form(bleat) {
60 if (document.getElementById('b' + bleat).style.display=="none") {
61 document.getElementById('b' + bleat).style.display="block";
62 } else {
63 document.getElementById('b' + bleat).style.display="none";
64 }
65}
66
67function see_attachments(attachment, bleat) {
68 var image = document.getElementById('a' + bleat);
69 if (image.innerHTML.indexOf('src="' + attachment + '"') > -1) {
70 image.innerHTML = "";
71 } else {
72 image.innerHTML = '<img src="' + attachment + '" alt="Attachment"/>';
73 }
74}
75
76function get_params() { //this is written by some dude in SO
77 var qd = {};
78 location.search.substr(1).split("&").forEach(function(item) {var s = item.split("="), k = s[0], v = s[1] && decodeURIComponent(s[1]); (k in qd) ? qd[k].push(v) : qd[k] = [v]})
79 return qd;
80}
81
82function post(path, params, method) { //this is written by some dude on SO
83 method = method || "post"; // Set method to post by default if not specified.
84
85 // The rest of this code assumes you are not using a library.
86 // It can be made less wordy if you use one.
87 var form = document.createElement("form");
88 form.setAttribute("method", method);
89 form.setAttribute("action", path);
90
91 for(var key in params) {
92 if(params.hasOwnProperty(key)) {
93 var hiddenField = document.createElement("input");
94 hiddenField.setAttribute("type", "hidden");
95 hiddenField.setAttribute("name", key);
96 hiddenField.setAttribute("value", params[key]);
97
98 form.appendChild(hiddenField);
99 }
100 }
101
102 document.body.appendChild(form);
103 form.submit();
104}
105</script>
106eof
107
108# i have no idea whetehr I am doing this right
109# we need to do this before anything else because we have to know who is logged in
110# check if a user is logged in
111%cookies = CGI::Cookie->fetch;
112if ($cookies{'login'}) {
113 %login_details = $cookies{'login'}->value;
114 if (validate_user($login_details{'username'}, $login_details{'password'})) {
115 # cool cool
116 $c_user = $login_details{'username'};
117 } else {
118 $c_user = '';
119 }
120}
121
122# FUNCTIONS WHICH HAVE TO BE RUN BEFORE I WRITE THE HEADER
123my $username = param('username') || "";
124my $password = param('password') || "";
125my $remember = param('remember_me') || 0;
126@page = which_page_am_I_on();
127if ($page[0] eq "login") {
128 if (!$c_user) {
129 if ($username and $password) {
130 if (validate_user($username, $password)) {
131 $username = get_proper_case_for_user($username);
132 my $ck = new_session($username, $password, $remember);
133 # if they are suspended, unsuspend them
134 if (user_suspended($username)) {
135 unsuspend_user($username);
136 }
137 print $ck->bake . start_html .
138 div("Welcome $username. Please click <a href='bitter.cgi'>here</a> to be redirected") .
139 end_html;
140 exit(0);
141 }
142 }
143 }
144} elsif ($page[0] eq 'logout') {
145 print &logout() . start_html . div("Successfully logged out. Please click <a href='bitter.cgi'>here</a> to be redirected");
146 exit 0;
147} elsif ($page[0] eq 'suspend') {
148 suspend_user($c_user);
149 print &logout() . start_html . div("Successfully suspended. Please click <a href='bitter.cgi'>here</a> to be redirected");
150 exit 0;
151} elsif ($page[0] eq 'delete') {
152 delete_user($c_user);
153 print &logout() . start_html . div("Successfully deleted. Please click <a href='bitter.cgi'>here</a> to be redirected");
154 exit 0;
155}
156
157#
158# check if we are deleting a bleat before anything
159#
160
161if (param('delete_bleat')) {
162 if (bleat_exists(param('delete_bleat'))) {
163 my %bleat_to_delete = format_bleat(param('delete_bleat'));
164 # check if we are the user
165 if ($c_user and $bleat_to_delete{'username'} =~ /^$c_user$/i) {
166 # DELETE
167 &delete_bleat(param('delete_bleat'));
168 }
169 }
170}
171
172#
173# check if we are making a new bleat as well
174#
175if (param('new_bleat')) {
176 if ($c_user) {
177 my @attachments = upload('bleat_attachment');
178 # write the attachments to files
179
180 # GET THE MINIMUM (idk why I don't use min)
181 my $num = $#attachments;
182 if ($num > ($max_attachments - 1)) {
183 $num = $max_attachments - 1;
184 }
185
186 my @all_attachments = ();
187 my @uploaded = ();
188
189 foreach my $i (0..$num) {
190 next if ($attachments[$i] !~ /\.jpg$/i);
191
192 @all_attachments = sort glob("$attachments_dir/*");
193 my $last_attachment = (@all_attachments) ? $all_attachments[$#all_attachments] : '0';
194 $last_attachment =~ s/\.jpg$//;
195 $last_attachment =~ s/^.*attachments\///;
196
197 my $handle = $attachments[$i];
198 open my $fh, ">$attachments_dir/" . (int($last_attachment) + 1) . ".jpg" or die "Couldn't create new attachment: $!";
199 binmode $fh;
200 while (my $line = <$handle>) {
201 print $fh $line;
202 }
203 close $fh;
204
205 push @uploaded, "$attachments_dir/" . (int($last_attachment) + 1) . ".jpg";
206 }
207
208 if (param('in_reply_to')) {
209 add_new_bleat($c_user, param('new_bleat'), param('in_reply_to'), @uploaded);
210 } else {
211 add_new_bleat($c_user, param('new_bleat'), '', @uploaded);
212 }
213 }
214}
215
216# print start of HTML ASAP to assist debugging if there is an error in the script
217print page_header();
218my @page = which_page_am_I_on();
219if ($page[0] eq 'p') { # a user profile
220 if (user_exists($page[1])) {
221 render_user_profile($page[1]);
222 } else {
223 print user_not_found($page[1]) . br; # change this to render a page later
224 }
225} elsif ($page[0] eq 'b') { # a bleat
226 if (bleat_exists($page[1])) {
227 render_full_bleat($page[1]);
228 } else {
229 print bleat_not_found($page[1]) . br;
230 }
231} elsif ($page[0] eq 'f') { #searching
232 render_search_page($page[1]);
233} elsif ($page[0] eq 'login') {
234 render_login_page();
235} elsif ($page[0] eq 'register') {
236 render_register_page();
237} elsif ($page[0] eq 'settings' and $c_user) {
238 render_settings_page();
239} elsif ($page[0] eq 'passwordrecovery') {
240 render_password_recovery_page();
241} else {
242 render_homepage();
243}
244
245#print browse_screen();
246print page_trailer();
247exit 0;
248
249#
250# transorms the user case to the actual one
251# e.g. if user logs in with 'brainyboy', would change it to BrainyBoy
252#
253sub get_proper_case_for_user {
254 my ($user) = @_;
255 my @blob = glob("$users_dir/*");
256 my $new_user = $user;
257 foreach (@blob) {
258 $_ =~ s/^$users_dir\///;
259 if ($_ =~ /^$user$/i) {
260 $new_user = $_;
261 }
262 }
263 return $new_user;
264}
265
266sub browse_screen {
267 my $n = param('n') || 0;
268 my @users = glob("$users_dir/*");
269 $n = min(max($n, 0), $#users);
270 param('n', $n + 1);
271 my $user_to_show = $users[$n];
272 my $details_filename = "$user_to_show/details.txt";
273 open my $p, "$details_filename" or die "can not open $details_filename: $!";
274 $details = join '', <$p>;
275 close $p;
276
277 return p,
278 start_form, "\n",
279 pre($details),"\n",
280 hidden('n', $n + 1),"\n",
281 submit('Next user'),"\n",
282 end_form, "\n",
283 p, "\n";
284}
285
286#
287# HTML placed at top of every screen
288#
289sub page_header {
290
291 # if someone is logged in and we are on login page
292 my @page = which_page_am_I_on();
293 if ($page[0] eq 'login' or $page[0] eq 'register') {
294 #print redirect('');
295 }
296
297 my $head = header;
298
299 # i have no idea whetehr I am doing this right
300 # i know i already did this before
301 # check if a user is logged in
302 %cookies = CGI::Cookie->fetch;
303 if ($cookies{'login'}) {
304 %login_details = $cookies{'login'}->value;
305 if (validate_user($login_details{'username'}, $login_details{'password'})) {
306 $c_user = $login_details{'username'};
307 # we have to add the cookie to the header again
308 $head = header({-cookie => $cookies{'login'}});
309 } else {
310 $c_user = '';
311 }
312 }
313
314 #if we are on user profiel and they have a background, print the background
315 #print img({-src => "../$bg", -alt=>"$username\'s background", -id=>'profile-bg'});
316 my $start = start_html("-title"=>"Bitter", -style=>{-src=>"$stylesheet"});
317 if ($page[0] eq 'p') {
318 my $bg;
319 if (user_exists($page[1]) and $bg = user_has_background($page[1])) {
320 $start = start_html( -title=>'Bitter',
321 -style=>{-src=>"$stylesheet"},
322 -background=>"../$bg"
323 );
324 }
325 }
326
327 return $head, $start,
328 div({-id=>'header-container'},
329 div({-id=>'search-bar'},
330 (start_form({-id=>'search-form', -action=>'bitter.cgi', -method=>'get'}),
331 textfield({-id=>'search-box', -name=>'f', -placeholder=>'Search...'}),
332 hidden({-value => 'users', -name=>'fu'}),
333 submit({-id=>'search-button', -value=>'Search', -name=>''}),
334 end_form)
335 ), div({-id=>'bitter-title'}, a({-href=>'bitter.cgi'}, 'Bitter')), div({-id=>'menu-container'}, render_menu())),
336 "\n" . br . br . "\n",
337 $js_delete . "\n";
338
339
340
341}
342
343#
344# HTML placed at bottom of every screen
345# It includes all supplied parameter values as a HTML comment
346# if global variable $debug is set
347#
348sub page_trailer {
349 my $html = "";
350 $html .= join("", map("<!-- $_=".param($_)." -->\n", param())) if $debug;
351 $html .= end_html;
352 return $html;
353}
354
355
356
357################## GENERAL FUNCTIONS ###########################
358
359#
360# gets the page from the params
361#
362sub which_page_am_I_on {
363 # a user's profile
364 my $user_profile = param('p') || 0;
365 if ($user_profile) {
366 my @ret = ('p', $user_profile);
367 # check for listening too
368 my $listen = param('listen') || 0;
369 my $unlisten = param('unlisten') || 0;
370 if ($listen and $c_user) {
371 listen_to($listen);
372 }
373 if ($unlisten and $c_user) {
374 unlisten_to($unlisten);
375 }
376 return @ret;
377 }
378
379 # a detailed view of a bleat
380 my $detailed_bleat = param('b') || 0;
381 if ($detailed_bleat) {
382 my @ret = ('b', $detailed_bleat);
383 return @ret;
384 }
385
386 # search
387 my $search = param('f') || 0;
388 if ($search) {
389 #print "SEARCH TERM: $search";
390 my @ret = ('f', $search);
391 return @ret;
392 }
393
394 # random static pages
395 my $page = param('page') || 0;
396 if ($page) {
397 if ($page eq 'login' and !$c_user) {
398 my @ret = ('login', '');
399 return @ret;
400 } elsif ($page eq 'register' and !$c_user) {
401 my @ret = ('register', '');
402 return @ret;
403 } elsif ($page eq 'logout' and $c_user) {
404 my @ret = ('logout', '');
405 return @ret;
406 } elsif ($page eq 'settings') {
407 my @ret = ('settings', '');
408 return @ret;
409 } elsif ($page eq 'suspend' and $c_user) {
410 my @ret = ('suspend', '');
411 return @ret;
412 } elsif ($page eq 'delete' and $c_user) {
413 my @ret = ('delete', '');
414 return @ret;
415 } elsif ($page eq 'passwordrecovery') {
416 my @ret = ('passwordrecovery', '');
417 return @ret;
418 } else {
419 print "Page: $page";
420 }
421 }
422
423 my $validation = param('v') || 0;
424 if ($validation) {
425 # if the user hasn't yet validated
426 if (-d "$users_dir/temp/$validation") {
427 account_validation($validation);
428 }
429
430 # redirect to homepage
431 redirect("bitter.cgi?p=$validation");
432 }
433
434
435 # print param();
436 # the key value for homepage
437 return (69, 420);
438
439}
440
441#
442# deletes a bleat
443#
444sub delete_bleat {
445 my ($bl) = @_;
446
447 if (!bleat_exists($bl)) {return;}
448
449 # delete the file and the number from the user
450 # first write the data to an array
451 my %bleat_to_delete = format_bleat($bl);
452 open my $bleats_list, "<$users_dir/$bleat_to_delete{'username'}/bleats.txt" or die "Couldn't open bleats file: $!";
453 chomp ( my @list = <$bleats_list> );
454 close $bleats_list;
455 # then modify the array and write it back to the file
456 my @new_list = grep {$_ !~ /^$bl$/} @list;
457 open my $bleats_list2, ">$users_dir/$bleat_to_delete{'username'}/bleats.txt" or die "Couldn't open bleats file: $!";
458 print $bleats_list2 join "\n", @new_list;
459 print $bleats_list2 "\n";
460 close $bleats_list2;
461
462 # first remove all the replies tot heir bleats
463 my @l;
464 my @all_bleats = glob("$bleats_dir/*");
465 my $delete = 0;
466 foreach my $file (@all_bleats) {
467 @l = ();
468
469 open my $b, "<$file" or die "Couldn't open: $!";
470 while (<$b>) {
471 push @l, $_;
472 next unless $_ =~ /^in_reply_to: (.*)/;
473 my $temp = $1;
474 chomp $temp;
475 if ($temp =~ /^$bl$/) {
476 pop @l; # undo the push if it is a reply to one of the deleted users' bleats
477 $delete = 1;
478 } else {
479 $delete = 0;
480 }
481 }
482 close $b;
483
484 next if (grep {$_ =~ /^in_reply_to: /} @l); # to save some time
485 if ($delete) {
486 open my $c, ">$file" or die "Couldn't open to write: $!";
487 print $c join("\n", @l);
488 print $c "\n";
489 close $c;
490 $delete = 0;
491 }
492 }
493
494 # now delete it from the bleats file
495 if ( -f "$bleats_dir/$bl" ) {
496 unlink "$bleats_dir/$bl";
497 }
498}
499
500#
501# generatrs a reply form
502#
503sub generate_reply_form {
504 my ($to, $bleatID) = @_;
505 return <<"eof";
506<form action='bitter.cgi' enctype='multipart/form-data' method='post' >
507 <textarea name='new_bleat' class='bleat-area' maxlength='$max_length_of_bleat' >\@$to </textarea><br />
508 <input type='file' name='bleat_attachment' multiple/>
509 <input type='hidden' name='in_reply_to' value='$bleatID' />
510 <input type='submit' value='Reply' style='float:right;' />
511</form>
512eof
513}
514
515#
516# trims whitespace from a string
517#
518sub trim {
519 my ($poop) = @_;
520 $poop =~ s/^\s+|\s+$//g;
521 return $poop;
522}
523
524#
525# does a user exist
526#
527sub user_exists {
528 my ($username) = @_;
529 $username = &trim(lc($username));
530
531 # first if the user does not exist at all, return 0
532 return 0 if !( -d "$users_dir/$username" );
533
534 # but then check if they are suspended
535 open my $suspended, "<$users_dir/suspended.txt" or die "Couldn't open suspended.txt: $!";
536 while (my $line = <$suspended>) {
537 $line = &trim($line);
538 if (lc($line) eq lc($username)) {
539 close $suspended;
540 return 0;
541 }
542 }
543 close $suspended;
544
545 # return true if passed all the tests
546 return 1;
547}
548
549#
550# return the message when you can't find a user
551#
552sub user_not_found {
553 return "User @_ not found\n";
554}
555
556#
557# return the message when a page is not found
558#
559sub page_not_found {
560 return "Page @_ not found\n";
561}
562
563#
564# given a username, return the path to that user's display picture
565# (or the default picture if they do not have one)
566#
567sub get_display_picture {
568 my ($username) = @_;
569
570 if ( -f "$users_dir/$username/profile.jpg" ) {
571 return "../$users_dir/$username/profile.jpg";
572 } else {
573 return "$default_picture";
574 }
575}
576
577#
578# given a string (assumed to be a bleat), return a string where @___ and #____ are
579# replaced with links
580#
581sub bleat_tags {
582 my ($bleat, $bleatID) = @_;
583 $bleat = escapeHTML($bleat);
584
585 while ($bleat =~ /(\@[a-zA-Z0-9-_]+)/g) {
586 my $tagged = substr $1, 1;
587 next if (!user_exists($tagged));
588 my $temp = a( { -href => "?p=$tagged" }, '@' . $tagged );
589 $bleat =~ s/\@$tagged/$temp/;
590 }
591
592 # replace hashtags
593 $bleat =~ s/#([a-zA-Z][a-zA-Z0-9-_]*)/a( { -href => "?f=%23$1&fb=bleats" }, '#' . $1 );/ge;
594
595 return $bleat;
596}
597
598#
599# given a bleat ID, return a hash containing the info of the bleat
600#
601sub format_bleat {
602 my ($bleatID) = @_;
603 #print $bleatID . "\n";
604
605 # open it and add all the shit to the hash
606 open my $bleat, "<$bleats_dir/$bleatID" or die "Couldn't open $bleats_dir/$bleatID: $!";
607 my %bleat_data;
608 while (<$bleat>) {
609 next if $_ =~ /^\s*$/;
610
611 my @pair = split /: /, $_, 2; # only split it once
612 chomp $pair[0];
613 chomp $pair[1];
614 #print "<!-- LINE: $line -->\n";
615 #print "<!--" . join(", ", @pair) . "-->\n";
616 $bleat_data{$pair[0]} = $pair[1];
617 }
618 close $bleat;
619
620 $bleat_data{'id'} = $bleatID;
621 return %bleat_data if (!user_suspended($bleat_data{'username'}));
622
623 # if they are suspended, return some random shti
624 my %default_bleat;
625 $default_bleat{'username'} = $bleat_data{'username'};
626 $default_bleat{'bleat'} = 'Bleat deleted.';
627 $default_bleat{'time'} = 0;
628 return %default_bleat;
629}
630
631#
632# given a username, return a hash containing the info of the user
633#
634sub format_user {
635 my ($username) = @_;
636
637 # open it and add all the shit to the hash
638 open my $deets, "<$users_dir/$username/details.txt" or die "Couldn't open $users_dir/$username/details.txt:$!";
639 my %user_data;
640 while (<$deets>) {
641 my @pair = split /: /, $_, 2; # only split it once
642 chomp $pair[0];
643 chomp $pair[1];
644 $user_data{$pair[0]} = $pair[1];
645 }
646 close $deets;
647
648 #add the description
649 my $description = "";
650 if (-f "$users_dir/$username/description.txt") {
651 open my $desc, "<$users_dir/$username/description.txt" or die "Couldn't open Description.txt: $!";
652 chomp ($description = join "", <$desc>);
653 close $desc;
654 }
655
656 $user_data{'description'} = $description;
657
658 return %user_data;
659}
660
661#
662# given a username, get a list of the users bleats
663#
664sub get_users_bleats {
665 my ($username) = @_;
666 my @empty = ();
667 return @empty if !user_exists($username) or user_suspended($username);
668 open my $bleats, "<$users_dir/$username/bleats.txt" or die "Couldn't open $users_dir/$username/bleats.txt: $!";
669 my @list;
670 while (<$bleats>) {
671 push @list, trim($_);
672 }
673 close $bleats;
674
675 return @list;
676}
677
678############################ FUNCTIONS FOR USER PROFILES ############################
679
680#
681# given a username, renders a user profile
682#
683sub render_user_profile {
684 my ($username) = @_;
685 print div({-id=>'user-profile-container'}, table( { -class => 'profile' },
686 Tr(
687 td( { -class => 'user_sidebar' }, display_sidebar($username)),
688 td( { -class => 'user_bleats' }, list_bleats_given_an_array(get_users_bleats($username)))
689 )
690 ));
691 #print end_table;
692}
693
694#
695# does user have a background?
696#
697sub user_has_background {
698 my ($user) = @_;
699 if (-f "$users_dir/$user/background.jpg") {
700 #print "$users_dir/$user/background.jpg";
701 return "$users_dir/$user/background.jpg";
702 } else {
703 #print "NO BACKGROUND";
704 return undef;
705 }
706}
707
708#
709# returns a sexy line
710#
711sub sexy_line {
712 return "\n<div><span class='sexy-line'></span></div>\n";
713}
714
715#
716# given a username, render the sidebar
717#
718sub display_sidebar {
719 my ($username) = @_;
720
721 # first grab the dp and user details
722 my $picture = get_display_picture($username);
723 my %details = format_user($username);
724
725 # make sure it is not malicious
726 foreach (keys %details) {
727 if ($escape_description and $_ eq 'description') {
728 # if we want to escape the description (im not sure what we are supposed to do so i just have a flag)
729 } else {
730 $details{$_} = escapeHTML($details{$_});
731 if ($_ eq 'description') {
732 $details{$_} =~ s/<\s*b\s*>/<b>/gi;
733 $details{$_} =~ s/<\s*\/\s*b\s*>/<\/b>/gi;
734 $details{$_} =~ s/<\s*i\s*>/<i>/gi;
735 $details{$_} =~ s/<\s*\/\s*i\s*>/<\/i>/gi;
736 #added support for bold and italics
737 }
738 }
739 }
740
741 my @listening = grep { !user_suspended($_) } split(/\s+/, $details{'listens'}) if defined($details{'listens'});
742
743 my $string = "";
744
745 # first print the dp
746 $string .= img( { -src => $picture, -alt => $username, -id => 'profile-pic' }) . br;
747
748 # then the details
749 $string .= render_user_details(%details) . br;
750
751 # then the grid
752 $string .= '<b>Listening to:</b>' . br;
753 $string .= render_listeners_grid(@listening) if @listening;
754 $string .= br;
755
756 if ($c_user and $username !~ /^$c_user$/i) {
757 $string .= listen_button($username);
758 }
759 $string .= br;
760
761 return $string;
762}
763
764#
765# given a hash of user details, pretty print :D
766#
767sub render_user_details {
768 my (%deets) = @_;
769 my $string = "";
770
771 # name
772 $string .= '<div id="full_name">' . $deets{'full_name'} . '</div>' . br if (defined($deets{'full_name'}));
773
774 # suburb
775 $string .= '<b>Lives in</b>: ';
776 $string .= $deets{'home_suburb'} if (defined($deets{'home_suburb'}));
777
778 # map
779 if (defined($deets{'home_latitude'}) and defined($deets{'home_longitude'})) {
780 $string .= ' ' . a( {-href=>"http://www.latlong.net/c/?lat=$deets{'home_latitude'}&long=$deets{'home_longitude'}", -target => '_blank' },
781 "(map)");
782 }
783 $string .= br;
784
785 #description
786 if ($deets{'description'}) {
787 $string .= b('Description: ') . p($deets{'description'}) . br;
788 }
789
790 return $string;
791}
792
793#
794# given a list of users, return html for
795# a grid with 3 width containing links to
796# each user
797#
798sub render_listeners_grid {
799 my @users = @_;
800
801 my $string = "";
802
803 # make a 3x? table
804 my $remainder = (scalar @users) % 3;
805 my $rows = ($remainder) ? (((scalar @users) + (3-$remainder)) / 3) : ((scalar @users) / 3);
806
807 # add the table
808 $string .= "<table class='listener_grid'>\n";
809 my $i = 0;
810 while ($rows > 0) {
811 $string .= '<tr>' . "\n";
812 for (0..2) {
813 if ($users[$i]) {
814 $string .= "<td class='listening_grid_image'><a href='?p=$users[$i]'><img src='" . get_display_picture($users[$i]) ."' class='listening_grid_image' alt=$users[$i] /></a></td>\n";
815 } else {
816 $string .= "<td></td>\n";
817 }
818 $i++;
819 }
820 $string .= '</tr>' . "\n";
821 $rows--;
822 }
823 $string .= '</table>' . "\n";
824
825 return $string;
826}
827
828
829############################ FUNCTIONS FOR DETAILED BLEAT VIEWS #####################
830
831#
832# given a bleat ID, print the bleats it is replying to as well in a
833# list view
834#
835sub render_full_bleat {
836 my ($bleatID) = @_;
837
838 print "<div id='bleat-view-container'>\n";
839
840 # print the first bleat
841 print print_bleat($bleatID);
842
843 # print the replies
844 my @replies = list_replies_to_bleat($bleatID);
845 @replies = sort { $b <=> $a } @replies;
846 if (@replies) {
847 print h4('Replies') . "\n";
848 }
849 foreach (@replies) {
850 print br . "\n";
851 print sexy_line();
852 print br . "\n";
853 print print_bleat($_);
854 }
855
856 print "</div>\n";
857}
858
859#
860# given a bleat ID, return a list of IDs which reply to the bleat
861#
862sub list_replies_to_bleat {
863 # pretty self explanatory code here
864 my ($bleatID) = @_;
865 my @all_bleats = glob("$bleats_dir/*");
866 my @final = ();
867
868 foreach (@all_bleats) {
869 $_ =~ s/$bleats_dir\///;
870
871 my %b = format_bleat($_);
872 if ($b{'in_reply_to'} and trim($b{'in_reply_to'}) =~ /^$bleatID$/) {
873 push @final, $b{'id'};
874 }
875 }
876 return @final;
877}
878
879#
880# given a bleat hash, pretty print
881# THIS IS FOR SINGLE BLEAT VIEW
882#
883sub print_bleat {
884 my ($bleatID) = @_;
885 my %bleat = format_bleat($bleatID);
886
887 # FIRST GET ALL THE DATA INTO VARIABLES
888 my $username = "<span class='username-link'><a href='?p=" . $bleat{'username'} . "'>$bleat{'username'}</a></span>\n";
889 my $time = "<a href='?b=" . $bleat{'id'} . "'>" . localtime($bleat{'time'}) . "</a>\n";
890 my $formatted_bleat = bleat_tags($bleat{'bleat'}, $bleat{'id'}) . "\n";
891 my $pic = "<img class='bleat-picture' src='" . get_display_picture($bleat{'username'}) . "' alt=$bleat{'username'} />\n";
892 my ($location, $in_reply_to) = ("", "");
893 if (defined($bleat{'home_longitude'}) and defined($bleat{'home_latitude'})) {
894 $location = "<a href='http://www.latlong.net/c/?lat=" . $bleat{'home_latitude'} . "&long=" . $bleat{'home_longitude'} . " target='_blank'>\@</a>\n";
895 }
896 if (defined($bleat{'in_reply_to'})) {
897 $in_reply_to = "in reply to <span class='username-link'><a href='?b=" . $bleat{'in_reply_to'} . "'>" . bleatID_to_username($bleat{'in_reply_to'}) . "</a></span>\n";
898 }
899
900 # ADD THE OPTIONS TO REPLY, DELETE, SEE ATTACHMENTS IF ANY, AND SHOW REPLIES
901 my ($reply_string, $delete_string, $see_attachments) = ("", "", "");
902
903 # reply
904 $reply_string = a({-href=>"javascript:show_reply_form('" . $bleat{'id'} . "');"}, 'Reply') . "\n";
905
906 # delete
907 $delete_string = a({-href=>"javascript:delete_bleat('" . $bleat{'id'} . "');"}, 'Delete') . "\n" if $bleat{'username'} =~ /^$c_user$/i;
908
909 # show attachments
910 if ($bleat{'attachments'}) {
911 $see_attachments = "Attachments: ";
912 my @attachments = split /\s+/, $bleat{'attachments'};
913 my $i = 1;
914 foreach (@attachments) {
915 $see_attachments .= a({-href=>"javascript:see_attachments('../$_', $bleat{'id'});"}, $i) . " \n";
916 $i++;
917 }
918 }
919
920
921 my $form = generate_reply_form($bleat{'username'}, $bleat{'id'});
922 my $string = <<"eof";
923<div class='bleat-picture'>$pic</div>
924<div class='individual-bleat'>
925<div class='bleat-info'>
926$username $in_reply_to
927<span class='bleat-options'>
928$see_attachments $delete_string $reply_string
929</span>
930<br />
931$time $location
932</div>
933<div class='bleat-message'>$formatted_bleat</div>
934<br />
935<div id="b$bleat{'id'}">$form</div>
936<div id="a$bleat{'id'}"></div>
937<script type="text/javascript">document.getElementById("b$bleat{'id'}").style.display = "none";</script>
938</div>
939<br />
940eof
941
942 return $string . "\n";
943}
944
945#
946# does a certain bleat exist
947#
948sub bleat_exists {
949 my ($bleat) = @_;
950 $bleat = &trim($bleat);
951
952 return ( -f "$bleats_dir/$bleat" ) ? 1 : 0;
953}
954
955#
956# bleat not found
957#
958sub bleat_not_found {
959 return "Bleat @_ not found\n";
960}
961
962#
963# given a bleat ID, convert to a username
964#
965sub bleatID_to_username {
966 my ($bleat) = @_;
967 my %temp = format_bleat($bleat);
968 return $temp{'username'};
969}
970
971############################ FUNCTIONS FOR MENU #####################################
972
973#
974# render the menu I guess
975#
976sub render_menu {
977 # if the user hasn't logged in,
978 if ($c_user) {
979 my $menu = ul({-class=>'menu'},
980 li(a{-href=>'bitter.cgi'}, 'Home'),
981 li(a{-href=>"?p=$c_user"}, 'Profile'),
982 li(a{-href=>'?page=settings'}, 'Settings'),
983 li(a{-href=>'?page=logout'}, 'Logout')
984 );
985 } else {
986 my $menu = ul({-class=>'menu'},
987 li(a{-href=>'?page=login'}, 'Login'),
988 li(a{-href=>'?page=register'}, 'Register')
989 );
990 }
991}
992
993####################### FUNCTIONS FOR SEARCH ########################################
994
995#
996# searches everything given a keyword
997#
998sub render_search_page {
999 my ($search_term) = @_;
1000 #sanitize the search term
1001 $search_term =~ s/[^a-z0-9#]//gi;
1002 $search_term =~ s/\s+/ /g;
1003 $search_term = &trim($search_term);
1004 $search_term = escapeHTML($search_term);
1005 # replace hashtags
1006 $search_term =~ s/%23/#/g;
1007 #print "Search term: $search_term";
1008
1009 my $search_results_per_page = 10;
1010 #users
1011 my $users_string = "";
1012 #bleats
1013 my $bleats_string = "";
1014 my @results = ();
1015
1016 # first search usernames
1017 # if we are looking at users
1018 if (!param('fb')) {
1019 open my $search, "<$users_dir/search.txt" or die "Couldn't open $users_dir/search.txt: $!";
1020 chomp (my @names = <$search>);
1021 close $search;
1022 push @results, grep { $_ =~ /$search_term/i } @names;
1023 $_ =~ s/.*:(.*)$/$1/ for @results;
1024
1025 my $page = param('n') || 1;
1026 $page = int($page);
1027
1028 # sanity check for page number
1029 my $total_pages = (scalar @results);
1030 while ($total_pages % $search_results_per_page != 0) {
1031 $total_pages++;
1032 }
1033 $total_pages /= $search_results_per_page;
1034 $page = 1 if ($page > $total_pages or $page < 1);
1035
1036 @results = paginate($page, $search_results_per_page, @results);
1037
1038 #$users_string .= "<div id='search-results-container'>\n";
1039 $users_string .= list_users(@results);
1040
1041 #list page numbers
1042 $users_string .= "<div id='page-numbers'>\n";
1043 my $i = 1;
1044 while ($i < $total_pages) {
1045 $users_string .= "<a href='?f=$search_term&fu=users&n=$i'>$i</a> ";
1046 $i++;
1047 }
1048 $users_string .= "</div>\n";
1049 #$users_string .= "</div>\n";
1050
1051 # now we do bleats
1052 } else {
1053 my @bleat_array = glob("$bleats_dir/*");
1054 my @bleat_results = ();
1055
1056 foreach my $b (@bleat_array) {
1057 $b =~ s/$bleats_dir\///;
1058 my %formatted_bleat = format_bleat($b);
1059 next if user_suspended($formatted_bleat{'username'});
1060 # search the bleat
1061 if ($formatted_bleat{'bleat'} =~ /$search_term/i) {
1062 push @bleat_results, $b;
1063 }
1064 }
1065
1066 # if there are results
1067 if (@bleat_results) {
1068 $bleats_string = list_bleats_given_an_array(@bleat_results);
1069 } else {
1070 $bleats_string = div({-class=>'no-results'}, "No bleats");
1071 }
1072 }
1073
1074 # print the buttons for toggling users and bleats search results
1075 print '<div id="search-results-container">' . "\n";
1076 print '<div class="users-bledats">' . "\n";
1077 print start_form({-action=>'bitter.cgi', -method=>'get'}) .
1078 hidden({-value=>"$search_term", -name=>'f'}) . hidden({-value=>'users', -name=>'fu'}) .
1079 submit({-value=>'Users', -id=>'search-users-button', -class=>'hidden'}) . end_form .
1080 start_form({-action=>'bitter.cgi', -method=>'get'}) .
1081 hidden({-value=>"$search_term", -name=>'f'}) . hidden({-value=>'bleats', -name=>'fb'}) .
1082 submit({-value=>'Bleats', -id=>'search-bleats-button', -class=>'hidden'}) . end_form;
1083 print '</div>' . "\n";
1084 if ($bleats_string) {
1085 print '<div id="search-toggle"><label class="toggle-off" for="search-users-button">Users</label>' . ' ' .
1086 '<label class="toggle-on" for="search-bleats-button">Bleats</label></div>' . br;
1087 print '<div id="results">' . $bleats_string . '</div>' . "\n";
1088 } else {
1089 print '<div id="search-toggle"><label class="toggle-on" for="search-users-button">Users</label>' . ' ' .
1090 '<label class="toggle-off" for="search-bleats-button">Bleats</label></div>' . br;
1091 print '<div id="results">' . $users_string . '</div>' . "\n";
1092 }
1093 print '</div>' . "\n";
1094}
1095
1096#
1097# display a list of users given an array of usernames
1098#
1099sub list_users {
1100 my @users = @_;
1101 my $valid_users = 0;
1102 my $string = "";
1103 foreach (@users) {
1104 my $user = $_;
1105 next if !user_exists($user) or user_suspended($user);
1106
1107 $valid_users++;
1108 $string .= "<div class='individual-result'>\n";
1109 my %user_hash = format_user($user);
1110 $string .= div({-class=>'results-picture'},
1111 img({-src=>get_display_picture($user_hash{'username'}), -alt=>$user_hash{'full_name'},
1112 -class=>'results-image'})) . "\n";
1113 $string .= div({-class=>'results-data'},
1114 div({-class=>'results-name'}, $user_hash{'full_name'}, a({-href=>"?p=$user_hash{'username'}"}, "(\@$user_hash{'username'})")),
1115 div({-class=>'results-other'},
1116 "<b>Lives in</b>: ", $user_hash{'home_suburb'})) . "\n";
1117 $string .= "</div>\n";
1118 $string .= br;
1119 $string .= span({-class=>'sexy-line'}, "");
1120 $string .= br. "\n";
1121 }
1122
1123 # if there are no results
1124 $string .= div({-class=>'no-results'}, "No users") if ($valid_users == 0);
1125
1126 return $string;
1127}
1128
1129#
1130# given a list of things, a page number and number of results per page,
1131# return a new array
1132# in this order: page number (starting from 1), number of results, then the array
1133#
1134sub paginate {
1135 my ($page, $n, @usernames) = @_;
1136 my $i = ($page - 1) * $n;
1137 my @new_array = ();
1138 while ($n > 0) {
1139 last if !($usernames[$i]);
1140 push @new_array, $usernames[$i];
1141 $i++;
1142 $n--;
1143 }
1144
1145 return @new_array;
1146}
1147
1148############################# FUNCTIONS FOR COOKIES AND LOGGING IN #######################
1149
1150sub render_login_page {
1151 my $username = param('username') || "";
1152 my $password = param('password') || "";
1153 my $remember = param('remember_me') || 0;
1154 my $error_message = "";
1155
1156 if ($username and $password) {
1157 if (validate_user($username, $password)) {
1158 #new_session($username, $password, $remember);
1159 # redirect script
1160 #return;
1161 } else {
1162 # cannot validate
1163 if (user_exists($username) or user_suspended($username)) {
1164 # if the username exists
1165 $error_message = "Incorrect password!";
1166 } else {
1167 $error_message = "User '$username' doesn't exist.";
1168 }
1169 }
1170 } else {
1171 $error_message = "One or more fields are missing." unless (!$username and !$password);
1172 }
1173
1174
1175 print '<div class="login-container">';
1176 print '<div class="login-title">Log In</div>';
1177 if ($error_message) {
1178 # if there is an error message, print the flash thingo ( i think that is what it is called )
1179 print '<div id="error-flash">' . $error_message . '</div>';
1180 }
1181 print br, br;
1182 print '<div class="login-form">';
1183 print start_form({-method=>'POST', -action=>'?page=login'}),
1184 label('Username'), br, textfield({-id=>'username-field', -name=>'username', -value=>$username}), br, br,
1185 label('Password'), br, password_field({-id=>'password-field', -name=>'password'}), br, br,
1186 submit({-class=>'login-button', -value=>'Log In'}), br, br,
1187 checkbox(-name=>'remember_me',-checked=>0,-value=>'ON',-label=>'Remember this account?'),
1188 hidden({-value=>'login', -name=>'page'}),
1189 end_form;
1190 print '</div>'; # end of reg form
1191 print br . p({-class=>'signup-text'}, 'Forgot your password? ' . a({-href=>'?page=passwordrecovery'}, 'Click here to recover it!'));
1192 print br . p({-class=>'signup-text'}, 'Don\'t have an account? ' . a({-href=>'?page=register'}, 'Sign up here!'));
1193 print '</div>';
1194}
1195
1196sub render_register_page {
1197 my $error_message = "";
1198 my $username = "";
1199 my $password = "";
1200 my $email = "";
1201 my $full_name = "";
1202
1203 if ($ENV{REQUEST_METHOD} eq 'POST') {
1204 $username = param('username') || "";
1205 $password = param('password') || "";
1206 $email = param('email') || "";
1207 $full_name = param('full_name') || "";
1208
1209 # check if everything is valid and entered
1210 # if nothing is supplied, don't show any error
1211 if (!$username and !$password and !$email and !$full_name) {
1212 $error_message = "";
1213 } else {
1214 if (!$username) {
1215 $error_message = "Please enter a username.";
1216 } elsif (!$password) {
1217 $error_message = "Please enter a password.";
1218 } elsif (!$email) {
1219 $error_message = "Please enter a valid e-mail address.";
1220 } elsif (!$full_name) {
1221 $error_message = "Please enter a full name.";
1222 }
1223
1224 if ($username) {
1225 if (user_exists($username) or user_suspended($username) or user_not_verified($username)) {
1226 # user already exists
1227 $error_message = "User '$username' already exists!";
1228 $username = "";
1229 } elsif (!valid_username($username)) {
1230 # invalid
1231 $error_message = "Username '$username' is invalid. Usernames must start with a letter and contain only letters and numbers.";
1232 $username = "";
1233 }
1234 }
1235
1236 if ($email) {
1237 if (!valid_email($email)) {
1238 $error_message = "Email '$email' invalid.";
1239 $email = "";
1240 }
1241 }
1242
1243
1244 }
1245
1246 #after validation checks, check if everything has been supplied
1247 if ($username and $password and $email and $full_name) {
1248 # make account
1249 $error_message = "Success!";
1250 create_user($username, $password, $email, $full_name);
1251 send_email($username, $email, $full_name);
1252 }
1253 }
1254
1255 print '<div class="register-container">';
1256 print '<div class="register-title">Register</div>';
1257 if ($error_message) {
1258 # if there is an error message, print the flash thingo ( i think that is what it is called )
1259 if ($error_message eq "Success!") {
1260 print '<div id="success-flash">' . $error_message . '</div>';
1261 } else {
1262 print '<div id="error-flash">' . $error_message . '</div>';
1263 }
1264 }
1265
1266 # print the register form
1267 print br, br;
1268 print '<div class="register-form">';
1269 print start_form({-method=>'POST', -action=>''}), label('Username'), br, textfield({-id=>'username-field', -name=>'username', -value=>$username}), br,br,
1270 label('Password'), br, password_field({-id=>'password-field', -name=>'password'}), br, br,
1271 label('Full name'), br, textfield({-id=>'name-field', -name=>'full_name', -value=>$full_name}), br, br,
1272 label('Email'), br, textfield({-id=>'email-field', -name=>'email', -value=>$email}), br, br,
1273 submit({-class=>'signup-button', -value=>'Register'}),
1274 # hidden thing to send hte page because its not working HELP
1275 hidden({-value=>'register', -name=>'page'}), end_form;
1276 print '</div>'; # end of reg form
1277 print br;
1278 print '</div>';
1279}
1280
1281#
1282# delete the cookie
1283#
1284sub logout {
1285 my $ck = CGI::Cookie->new(-name => 'login', -value => '', -expires => '-2y');
1286 return $ck->bake;
1287}
1288
1289
1290#
1291# validates an account and redirects to the profile page
1292#
1293sub account_validation {
1294 my ($username) = @_;
1295 # move the user from temp to normal
1296 move("$users_dir/temp/$username", "$users_dir/$username");
1297
1298
1299 my %user = format_user($username);
1300 # add their username, full name and email to the files
1301 open my $name_file, '>>', "$users_dir/search.txt" or die "$!";
1302 print $name_file "$user{'full_name'}" . ":" . "$username" . "\n";
1303 close $name_file;
1304
1305 open my $email_file, '>>', "$users_dir/email.txt" or die "$!";
1306 print $email_file "$user{'email'}\n";
1307 close $email_file;
1308
1309 redirect('?page=login');
1310}
1311
1312#
1313# if we are still waiting for the verification
1314#
1315sub user_not_verified {
1316 my ($user) = @_;
1317 if ( -d "$users_dir/temp/$user" ) {
1318 return 1;
1319 } else {
1320 return 0;
1321 }
1322}
1323
1324#
1325# creates a new user file given username, password, email, and full name
1326# in a temp directory (until they validate)
1327#
1328sub create_user {
1329 my ($username, $password, $email, $full_name) = @_;
1330 mkdir "$users_dir/temp/$username", 0755;
1331
1332 # details.txt
1333 open my $f, ">$users_dir/temp/$username/details.txt" or die "$!";
1334 my $p = <<"eof";
1335listens:
1336email: $email
1337full_name: $full_name
1338password: $password
1339username: $username
1340home_suburb:
1341home_latitude:
1342home_longitude:
1343eof
1344 print $f $p;
1345 close $f;
1346
1347 # bleats.txt
1348 open my $s, ">$users_dir/temp/$username/bleats.txt" or die "$!";
1349 print $s "";
1350 close $s;
1351
1352}
1353
1354#
1355# is it a valid username? Pair this with 'user_exists' function.
1356#
1357sub valid_username {
1358 my ($username) = @_;
1359 return 1 if ($username =~ /^[a-z][a-z0-9][a-z0-9][a-z0-9]*$/i);
1360 return 0;
1361}
1362
1363#
1364# is it a valid e-mail?
1365#
1366sub valid_email {
1367 my ($email) = @_;
1368 return 1 if ($email =~ /\A[\w+\-.]+@[a-z\d\-.]+\.[a-z]+\z/i);
1369 return 0;
1370}
1371
1372#
1373# does an e-mail exist?
1374#
1375sub email_exists {
1376 my ($email) = @_;
1377
1378 open my $f, '<' . "$users_dir" . "/email.txt" or die "Couldn't open email.txt: $!";
1379 chomp(my @emails = <$f>);
1380 close $f;
1381
1382 return grep { $_ =~ /^$email$/i } @emails;
1383}
1384
1385#
1386# encrypts a string
1387#
1388sub encrypt_username {
1389 my ($string) = @_;
1390 return $string;
1391}
1392
1393#
1394# does username match password
1395#
1396sub validate_user {
1397 my ($username, $password) = @_;
1398 if (user_exists($username) or user_suspended($username)) {
1399 my %user = format_user($username);
1400 if ($password eq $user{'password'}) {
1401 return 1;
1402 }
1403 }
1404
1405 return 0;
1406}
1407
1408#
1409# is user suspended?
1410#
1411sub user_suspended {
1412 my ($user) = @_;
1413 open my $suspended, "<$users_dir/suspended.txt" or die "Couldn't open suspended.txt: $!";
1414 chomp(my @suspended_list = <$suspended>);
1415 close $suspended;
1416 return grep { $_ =~ /^$user$/i } @suspended_list;
1417}
1418
1419
1420#
1421# logs in a user
1422#
1423sub new_session {
1424 if (defined($cookies{'login'})) {
1425 # if someone is already logged in there is a problem
1426 die ;
1427 }
1428 my $expiry_date = "+20m";
1429 my ($username, $password, $remember) = @_;
1430 $expiry_date = "+1y" if ($remember);
1431
1432 $login = CGI::Cookie->new(-name=>'login', -value=>{username=>$username,
1433 password=>$password},
1434 -expires=>$expiry_date);
1435 return $login;
1436}
1437
1438
1439####################################### HOME PAGE / NEWS FEED ###########################
1440
1441sub render_homepage {
1442 # if someone is logged in, render their news feed. otherwise, try and persuade them to sign up
1443 if ($c_user) {
1444 render_newsfeed($c_user);
1445 } else {
1446 print '<div class="homepage-container">' . "\n";
1447 print '<div class="homepage-header">Welcome to Bitter.</div>' . "\n";
1448 print '<div class="homepage-signup-button"><a href="?page=register">Sign Up!</a></div>' . "\n";
1449 print '</div>';
1450 }
1451}
1452
1453sub render_newsfeed {
1454 my ($user) = @_;
1455 my $bleat_form = <<eof;
1456<script type="text/javascript">
1457function showForm() {
1458 if (document.getElementById('new-bleat-form').style.display=="none") {
1459 document.getElementById('new-bleat-form').style.display="block";
1460 } else {
1461 document.getElementById('new-bleat-form').style.display="none";
1462 }
1463}
1464</script>
1465eof
1466
1467 # warm greeting :D
1468 my %user = format_user($c_user);
1469 my $name = $user{'full_name'};
1470 $name =~ s/\s.*//;
1471
1472 #NEW BLEAT FORM
1473 print $bleat_form . "\n";
1474 print '<div class="newsfeed-container">' . "\n";
1475 print h3("Hello, $name.");
1476 print center(a({-href=>'javascript:showForm();', -class=>'compose-new-bleat'}, 'Compose new bleat')) . "\n";
1477 print '<div>' . "\n";
1478 print start_form({-id => 'new-bleat-form', -action=>'bitter.cgi'}) . br .
1479 textarea({-maxlength=>$max_length_of_bleat, -id=>'bleat-message-box', -name=>'new_bleat'}) . br . br.
1480 "<input type='file' name='bleat_attachment' multiple/>" .
1481 '<right>' . submit({-style=>'float:right;', -name=>'Bleat!'}) . '</right>' .
1482 end_form . "\n" . br . br;
1483 print '</div>' . "\n";
1484 render_relevant_bleats($user);
1485 print '</div>' . "\n";
1486
1487 # don't forget to hide the form
1488 print '<script type="text/javascript">document.getElementById("new-bleat-form").style.display = "none";</script>';
1489
1490}
1491
1492
1493#
1494# given a user and a bleat message, add it, and a reply
1495#
1496sub add_new_bleat {
1497 my ($user, $message, $reply, @uploaded) = @_;
1498
1499 # first sanitize it and remove newlines
1500 $message = &trim($message);
1501 $message =~ tr{\n}{ };
1502
1503 my $t = time();
1504 # then add the bleat to the list of bleats in the users file
1505 # then create a new file with the bleat
1506 my $bleat = <<"eof";
1507username: $user
1508bleat: $message
1509time: $t
1510eof
1511 #add longitude later
1512
1513 # first find the latest bleat
1514 my @bleats = sort glob("$bleats_dir/*");
1515 my $latest_bleat_number = 0;
1516 if (@bleats) {
1517 $latest_bleat_number = $bleats[$#bleats];
1518 # format it a bit
1519 $latest_bleat_number =~ s/$bleats_dir\///;
1520 $latest_bleat_number = int($latest_bleat_number);
1521 }
1522 #increase by one to get new bleat
1523 $latest_bleat_number++;
1524 open my $user_file, ">>$users_dir/$user/bleats.txt" or die "Couldn't open user file to add bleat: $!";
1525 print $user_file "$latest_bleat_number\n";
1526 close $user_file;
1527
1528 # now make a new file
1529 open my $bleats_file, ">$bleats_dir/$latest_bleat_number" or die "Couldn't create a new bleat: $!";
1530 print $bleats_file "$bleat";
1531 #print $bleats_file "latitude: $latitude\n" if $latitude;
1532 #print $bleats_file "longitude: $longitude\n" if $longitude;
1533 print $bleats_file "in_reply_to: $reply\n" if $reply;
1534 if (@uploaded) {
1535 print $bleats_file "attachments: " . join " ", @uploaded;
1536 }
1537 close $bleats_file;
1538
1539 #send a message if notifications are on to the replyee
1540 if ($reply) {
1541 my %reply_to = format_bleat($reply);
1542 if (get_notification_settings($reply_to{'username'}, 'reply')) {
1543 send_notification_email_reply($reply_to{'username'}, $latest_bleat_number);
1544 }
1545 }
1546
1547 # send emails to people who are tagged
1548 while ($bleat =~ /\@([a-zA-Z0-9-_]+)/g) {
1549 if (get_notification_settings($1, 'mention')) {
1550 send_notification_email_mention($1, $bleatID);
1551 }
1552 }
1553}
1554
1555#
1556# given a username, return alist of people they follow
1557#
1558sub list_following {
1559 my ($user) = @_;
1560 my %asd = format_user($user);
1561 my @following = split / /, $asd{'listens'};
1562 return @following;
1563}
1564
1565#
1566# get a list of bleats of people mentioning the given usernaem
1567#
1568sub get_bleats_which_I_am_tagged_in {
1569 my ($me) = @_;
1570 my $regex = '@' . "$me";
1571
1572 my @final = ();
1573
1574 # open each bleat file
1575 my @files = glob("$bleats_dir/*");
1576
1577 foreach my $bl (@files) {
1578 $bl =~ s/$bleats_dir\///;
1579 my %b = format_bleat($bl);
1580 next if !user_exists($b{'username'}) or user_suspended($b{'username'});
1581 #print "BL: $bl\n";
1582 # check if tagged or something
1583 if ($b{'bleat'} =~ /($regex)([^a-zA-Z0-9]|$)?/i) {
1584 #print "$#final\n";
1585 push @final, int($bl);
1586 }
1587 }
1588
1589 return @final;
1590}
1591
1592#
1593# draw something which contains relevant bleats to the user
1594#
1595sub render_relevant_bleats {
1596 my ($me) = @_;
1597 my @bleat_list = ();
1598
1599 # tagged
1600 push @bleat_list, get_bleats_which_I_am_tagged_in($me);
1601
1602 # my own
1603 push @bleat_list, get_users_bleats($me);
1604
1605 # following
1606 foreach (list_following($me)) {
1607 next if !user_exists($_) or user_suspended($_);
1608 push @bleat_list, get_users_bleats($_);
1609 }
1610
1611 # remove duplicates
1612 @bleat_list = remove_dups(@bleat_list);
1613
1614 # sort reversed
1615 @bleat_list = sort { $b <=> $a } @bleat_list;
1616
1617 # paginate it later
1618
1619 # print it out
1620 print list_bleats_given_an_array(@bleat_list);
1621}
1622
1623#
1624# remove duplicates from list
1625#
1626sub remove_dups {
1627 my @list = @_;
1628 my %temp_hash;
1629 foreach (@list) {
1630 $_ = trim($_);
1631 $temp_hash{$_} = '420 swag';
1632 }
1633 return keys %temp_hash;
1634}
1635
1636#
1637# given an array of bleats, list the bleats
1638#
1639sub list_bleats_given_an_array {
1640 my @bleats = @_;
1641 my $string = "";
1642
1643 # firstly sort the bleats
1644 @bleats = sort { $b <=> $a } @bleats;
1645
1646 # check if we are supposed to be on a specific page of results
1647 my $page = param('n') || 1;
1648 $page = int($page);
1649
1650 # check for invalid page number
1651 my $total_pages = (scalar @bleats);
1652 while ($total_pages % $bleats_per_page != 0) {
1653 $total_pages++;
1654 }
1655 $total_pages /= $bleats_per_page;
1656 $page = 1 if ($page > $total_pages or $page < 1);
1657
1658 # paginate
1659 @bleats = paginate($page, $bleats_per_page, @bleats);
1660
1661 # sort again just in case lol
1662 @bleats = sort { $b <=> $a } @bleats;
1663
1664 # add the bleats part to the string
1665 foreach (@bleats) {
1666 $string .= print_bleat($_) . "\n";
1667 $string .= sexy_line();
1668 $string .= br;
1669 }
1670
1671 # then add the pages if needed
1672 if ($total_pages > 1) {
1673 $string .= "<div id='page-numbers'>\n";
1674 my $i = 1;
1675 while ($i <= $total_pages) {
1676 # this next part is just preserving the query string so this
1677 # code can be used on any page :D
1678 my $current_request = $ENV{QUERY_STRING};
1679 if ($current_request =~ s/(^|&|;)n=[0-9]+/$1n=$i/i) {} else {
1680 if ($current_request) {
1681 # if there are existing params
1682 $current_request .= "&n=$i";
1683 } else {
1684 $current_request = "n=$i";
1685 }
1686 }
1687 if ($page == $i) {
1688 $string .= "<a class='highlighted-page' href='" . "?$current_request" . "'>$i</a> ";
1689 } else {
1690 $string .= "<a class='nonhighlighted-page' href='" . "?$current_request" . "'>$i</a> ";
1691 }
1692 $i++;
1693 }
1694 $string .= "</div>\n";
1695 }
1696
1697 return $string;
1698}
1699
1700#
1701# given an array of bleats, list the bleats
1702#
1703sub list_bledats_given_an_array {
1704 my @bleats = @_;
1705
1706 my $string = "";
1707 # sort in reverse
1708 @bleats = sort { $b <=> $a } @bleats;
1709 # then paginate i guess
1710 my $bleats_per_page = 10;
1711 my $page = param('n') || 1;
1712 $page = int($page);
1713
1714 # sanity check for page number
1715 my $total_pages = (scalar @bleats);
1716 while ($total_pages % $bleats_per_page != 0) {
1717 $total_pages++;
1718 }
1719 $total_pages /= $bleats_per_page;
1720 $page = 1 if ($page > $total_pages or $page < 1);
1721
1722 @bleats = paginate($page, $bleats_per_page, @bleats);
1723
1724 # sort in reverse again just in case
1725 @bleats = sort { $b <=> $a } @bleats;
1726
1727 # sort in reverse order
1728 foreach $bleatID (@bleats) {
1729 chomp $bleatID;
1730 my %bleat_data = format_bleat($bleatID);
1731 #print "LIST_BLEATS: $bleatID\n";
1732 my $t = localtime($bleat_data{'time'});
1733 my $dp = get_display_picture($bleat_data{'username'});
1734 $string .= '<div>' . "\n";
1735 $string .= "<a href=\"?p=$bleat_data{'username'}\">" .
1736 img({-src => $dp, -alt => $bleat_data{'username'}, -class => 'newsfeed-dps'}) . "</a>";
1737 $string .= '<b>' . a({-href=>"?p=$bleat_data{'username'}"}, $bleat_data{'username'}) . " @ " . a( { -href => "?b=$bleatID" }, $t) . '</b>' . br;
1738 $string .= '<div class="bleat-msg">' . bleat_tags($bleat_data{'bleat'}, $bleat_data{'id'}) . '</div>';
1739 $string .= br;
1740 # now do the reply or delete
1741 $string .= a({href=>"javascript:show_reply_form('$bleatID');"}, 'Reply');
1742 $string .= " " . a({href=>"javascript:delete_bleat('$bleatID');"}, 'Delete') if $bleat_data{'username'} =~ /^$c_user$/i;
1743 # attahcments
1744 my $see_attachments = "";
1745 if ($bleat_data{'attachments'}) {
1746 $see_attachments = " Attachments: ";
1747 my @attachments = split /\s+/, $bleat_data{'attachments'};
1748 my $i = 1;
1749 foreach (@attachments) {
1750 $see_attachments .= " " . a({-href=>"javascript:see_attachments('../$_', $bleat_data{'id'});"}, $i);
1751 $i++;
1752 }
1753 }
1754 $string .= $see_attachments;
1755 $string .= br . '<div id="b' . $bleatID . '">' . "\n" . generate_reply_form($bleat_data{'username'}, $bleatID) . '</div>';
1756 $string .= br . '<div id="a' . $bleatID . '"></div>';
1757 # hide it first
1758 $string .= '<script type="text/javascript">document.getElementById("b' . $bleatID . '").style.display = "none";</script>';
1759 $string .= br . br . span({-class=>'sexy-line'}, "") . br;
1760 $string .= '</div>' . "\n";
1761 }
1762 # if there are multiple pages, add the page number thingo
1763 if ($total_pages > 1) {
1764 $string .= "<div id='page-numbers'>\n";
1765 $string .= "<ul>\n";
1766 my $i = 1;
1767 while ($i < $total_pages) {
1768 my $current_request = $ENV{QUERY_STRING};
1769 #print "QUERY STRING: $ENV{QUERY_STRING}";
1770 #chomp $current_request;
1771 if ($current_request =~ s/(^|&|;)n=[0-9]+/$1n=$i/i) {} else {
1772 if ($current_request) {
1773 # if there are existing params
1774 $current_request .= "&n=$i";
1775 } else {
1776 $current_request = "n=$i";
1777 }
1778 }
1779 $string .= "<li><a href='" . "?$current_request" . "'>$i</a></li>";
1780 $i++;
1781 #add a new line every 10 pages
1782 if ($i != 0 and $i % 10 == 0) {
1783 $string .= br;
1784 }
1785 }
1786 $string .= "</ul>\n";
1787 $string .= "</div>\n";
1788 }
1789 return $string;
1790}
1791
1792#
1793# print the listen button given the user in question
1794#
1795sub listen_button {
1796 return if !$c_user;
1797 my ($q) = @_;
1798 my $string = "";
1799
1800 my %me = format_user($c_user);
1801
1802 # grab list of people this guy is listening to
1803 my @listening = split /\s+/, $me{'listens'};
1804 # if the user is in the list
1805 if (grep {$_ =~ /^$q$/i} @listening) {
1806 $string .= start_form({-action => "bitter.cgi", -method=>'get'}) .
1807 hidden({-name=>'p', -value=>$q}) .
1808 hidden({-name=>'unlisten', -value=>$q}) .
1809 submit({-value => 'Unlisten', -name=>''}) . end_form;
1810 } else {
1811 $string .= start_form({-action => "bitter.cgi", -method=>'get'}) .
1812 hidden({-name=>'p', -value=>$q}) .
1813 hidden({-name=>'listen', -value=>$q}) .
1814 submit({-value => 'Listen', -name=>''}) . end_form;
1815 }
1816
1817 return $string;
1818}
1819
1820#
1821# unlisten to someone
1822#
1823sub unlisten_to {
1824 return if !$c_user;
1825 my ($person_to_unfollow) = @_;
1826 open my $f, "<$users_dir/$c_user/details.txt" or die "Couldn't open user file: $!";
1827 chomp(my @temp_file = <$f>);
1828 close $f;
1829
1830 # change the line
1831 foreach my $line (@temp_file) {
1832 next if $line !~ /^listens: /;
1833 my @following = split /\s+/, $line;
1834 shift @following;
1835 @following = grep { $_ !~ /$person_to_unfollow/i } @following;
1836 $line = "listens: " . join " ", @following;
1837 last;
1838 }
1839
1840 open my $ff, ">$users_dir/$c_user/details.txt" or die "Couldn't open user file: $!";
1841 print $ff join "\n", @temp_file;
1842 close $ff;
1843}
1844
1845#
1846# listen to someone
1847#
1848sub listen_to {
1849 return if !$c_user;
1850 my ($person_to_follow) = @_;
1851
1852 open my $f, "<$users_dir/$c_user/details.txt" or die "Couldn't open user file: $!";
1853 chomp(my @temp_file = <$f>);
1854 close $f;
1855
1856 # change the line
1857 foreach my $line (@temp_file) {
1858 next if $line !~ /^listens: /;
1859 my @following = split /\s+/, $line;
1860 if (grep {$_ =~ /^$person_to_follow$/i} @following) {return;} # return if already following
1861 shift @following;
1862 push @following, $person_to_follow;
1863 $line = "listens: " . join " ", @following;
1864 last;
1865 }
1866
1867 open my $ff, ">$users_dir/$c_user/details.txt" or die "Couldn't open user file: $!";
1868 print $ff join "\n", @temp_file;
1869 close $ff;
1870
1871 # send the email
1872 if (get_notification_settings($person_to_follow, 'listen')) {
1873 send_notification_email_listen($person_to_follow, $c_user);
1874 }
1875}
1876
1877
1878########################### FUNCTIONS FOR SETTINGS PAGE #################################
1879
1880sub render_settings_page {
1881 my %user_details = format_user($c_user);
1882 print "<div id='settings-container'>\n";
1883 print h4('Settings') . br;
1884 $CGI::POST_MAX = 1024 * 5000; # 5 mb limit
1885
1886 # if we have params here, print a green flash thing
1887 my $error_message = "";
1888 my $success_message = "";
1889 my @changed_details = ();
1890
1891 #NORMAL DETAILS
1892 my $full_name = param('full_name') || "";
1893 my $location = param('location') || "";
1894 my $email = param('email') || "";
1895 my $description = param('description') || "";
1896 my $updated = param('updated') || ""; # to see if we pressed the button so we don't update anythign when we
1897 # come to the page
1898
1899 # BACKGROUND AND DP STUFF
1900 my $new_dp = upload('new_dp');
1901 my $new_bg = upload('new_bg');
1902 my $dp_update = param('dp_update') || "";
1903 my $delete_dp = param('delete_dp') || "";
1904 my $bg_update = param('bg_update') || "";
1905 my $delete_bg = param('delete_bg') || "";
1906
1907 #NOTIFICAION STUFF
1908 my $mention = param('mention') ? 1:0;
1909 my $reply = param('reply') ? 1:0;
1910 my $listen = param('listen') ? 1:0;
1911 if ($updated) {
1912 if ($mention != get_notification_settings($c_user, 'mention')) {
1913 push @changed_details, 'notification settings';
1914 }
1915 if ($reply != get_notification_settings($c_user, 'reply')) {
1916 push @changed_details, 'notification settings';
1917 }
1918 if ($listen != get_notification_settings($c_user, 'listen')) {
1919 push @changed_details, 'notification settings';
1920 }
1921 }
1922 set_notification_settings($c_user, $mention, $reply, $listen) if $updated;
1923
1924 #sanitize
1925 $full_name = &trim($full_name);
1926 $location = &trim($location);
1927 $email = &trim($email);
1928 $description = &trim($description);
1929
1930 if ($updated and $full_name and $full_name ne $user_details{'full_name'}) {
1931 change_name($c_user, $full_name);
1932 push @changed_details, "name";
1933 }
1934 if ($updated and $email and $email ne $user_details{'email'}) {
1935 change_email($c_user, $email);
1936 push @changed_details, "email";
1937 }
1938 if ($updated and $description ne $user_details{'description'}) {
1939 change_desc($c_user, $description);
1940 push @changed_details, "description";
1941 }
1942 if ($updated and $location ne $user_details{'home_suburb'}) {
1943 change_location($c_user, $location);
1944 push @changed_details, "location";
1945 }
1946 if ($dp_update and $new_dp) {
1947 my $dp_name = param('new_dp');
1948
1949 # make sure it is an image
1950 if ($dp_name =~ /^[a-z0-9_-]+\.jpe?g$/i) { # make sure it is not malicious
1951 open my $dp, ">$users_dir/$c_user/profile.jpg" or die "Couldn't open profile.jpg: $!";
1952 binmode $dp;
1953 while (my $line = <$new_dp>) {
1954 print $dp $line;
1955 }
1956 close $dp;
1957 push @changed_details, "profile picture";
1958 } else {
1959 $error_message = "Only .jpg files allowed.";
1960 }
1961 }
1962 if ($bg_update and $new_bg) {
1963 my $bg_name = param('new_bg');
1964 # make sure it is an image
1965 if ($bg_name =~ /^[a-z0-9_-]+\.jpe?g$/i) { # make sure it is not malicious
1966 open my $bg, ">$users_dir/$c_user/background.jpg" or die "Couldn't open background.jpg: $!";
1967 binmode $bg;
1968 while (my $line = <$new_bg>) {
1969 print $bg $line;
1970 }
1971 close $bg;
1972 push @changed_details, "background";
1973 } else {
1974 $error_message = "Only .jpg files allowed.";
1975 }
1976 }
1977 if ($delete_dp) {
1978 unlink "$users_dir/$c_user/profile.jpg";
1979 $success_message = "Successfully deleted profile picture.";
1980 }
1981 if ($delete_bg) {
1982 unlink "$users_dir/$c_user/background.jpg";
1983 $success_message = "Successfully deleted background.";
1984 }
1985
1986 # FLASHY COOL ERROR AND SUCCESS BUBBLE STUFF
1987 @changed_details = remove_dups(@changed_details);
1988 if (@changed_details) {
1989 $success_message = "Successfully changed " . join(", ", @changed_details) . ".";
1990 }
1991 if ($success_message) {
1992 print div({-id=>'success-flash'}, $success_message) . "\n";
1993 }
1994 if ($error_message) {
1995 print div({-id=>'error-flash'}, $error_message) . "\n";
1996 }
1997
1998 # form for normal details
1999 print '<div id="normal-details">';
2000 print start_form .
2001 '<fieldset><legend>User details</legend>' .
2002 '<center>' .
2003 label('Full name') . br . textfield({-value=>$user_details{'full_name'}, -name=>'full_name', -class=>'settings-textbox'}) . br .
2004 label('Location') . br . textfield({-value=>$user_details{'home_suburb'}, -name=>'location', -class=>'settings-textbox'}) . br .
2005 label('E-mail') . br . textfield({-value=>$user_details{'email'}, -name=>'email', -class=>'settings-textbox'}) . br .
2006 label('Description') . br . textarea({-value=>$user_details{'description'}, -name=>'description', -class=>'settings-textarea'}) . br .
2007 '</center>' .
2008 '</fieldset>' . br;
2009
2010 #notification settings
2011 print '<fieldset><legend>Notifications</legend>';
2012 print checkbox(-name=>'mention', -checked=>get_notification_settings($c_user, 'mention'),
2013 -value=>'ON', -label=>'Mentioned in a bleat') . br;
2014 print checkbox(-name=>'reply', -checked=>get_notification_settings($c_user, 'reply'),
2015 -value=>'ON', -label=>'Someone posts a reply to my bleat') . br;
2016 print checkbox(-name=>'listen', -checked=>get_notification_settings($c_user, 'listen'),
2017 -value=>'ON', -label=>'I get a new listener') . br;
2018 print '</fieldset>' . br .
2019
2020 #page params
2021 hidden({-name=>'page',-value=>'settings'}) .
2022 hidden({-name=>'updated',-value=>'69'}) .
2023 center(submit) .
2024 end_form;
2025
2026 # delete/suspend account
2027 print '<center>';
2028 print '<button onclick="javascript:suspend();">Suspend account</button> ';
2029 print '<script type="text/javascript">function suspend() {if (confirm("Are you sure you want to suspend your account?")) {window.location="?page=suspend";}}</script>';
2030 print ' <button onclick="javascript:delete_account();">Delete account</button>';
2031 print '<script type="text/javascript">function delete_account() {if (confirm("Are you sure you want to delete your account?")) {window.location="?page=delete";}}</script>';
2032 print '</center>';
2033 print '</div>';
2034
2035
2036
2037 # PROFILE PICTURE
2038 print '<div id="change-profile-pic">';
2039 print '<fieldset><legend>Customise your look</legend>' . "\n";
2040 print b('Current profile picture') . br;
2041 print img({-src=>get_display_picture($c_user), -alt=>$user_details{'full_name'}, -id=>'settings-dp'}) . br;
2042 print start_form({-enctype=>'multipart/form-data'});
2043 print filefield(-name=>'new_dp') . br;
2044 print hidden({-name=>'page', -value=>'settings'});
2045 print hidden({-name=>'dp_update', -value=>'420'});
2046 print submit('Upload');
2047 print end_form;
2048 if (get_display_picture($c_user) ne "$default_picture") {
2049 print start_form . hidden({-name=>'page', -value=>'settings'}) .
2050 hidden({-name=>'delete_dp', -value=>'123'}) . submit('Delete') . end_form;
2051 }
2052 print br . br;
2053
2054 # BACKGROUND
2055 if (my $bg = user_has_background($c_user)) {
2056 print b('Current background') . br . img({-src=>"../$bg", -alt=>"Background", -id=>'settings-bg'});
2057 } else {
2058 print b('Upload a background');
2059 }
2060 print start_form({-enctype=>'multipart/form-data'});
2061 print filefield(-name=>'new_bg') . br;
2062 print hidden({-name=>'page', -value=>'settings'});
2063 print hidden({-name=>'bg_update', -value=>'420'});
2064 print submit('Upload');
2065 print end_form;
2066 if (user_has_background($c_user)) {
2067 print start_form . hidden({-name=>'page', -value=>'settings'}) .
2068 hidden({-name=>'delete_bg', -value=>'123'}) . submit('Delete') . end_form;
2069 }
2070 print '</fieldset>';
2071 print '</div>';
2072 print "</div>\n";
2073}
2074
2075#
2076# get notification settings from someone
2077# arguments: 'mention' for mention, 'reply' for reply
2078# and 'listen' for listener
2079#
2080sub get_notification_settings {
2081 my ($user, $which) = @_;
2082 my @settings = ();
2083 if ( -f "$users_dir/$user/notification.txt" ) {
2084 open my $n, "<$users_dir/$user/notification.txt" or die "Couldn't open notifcations.txt, user : $user: $!";
2085 chomp (@settings = <$n>);
2086 close $n;
2087 } else {
2088 # doesnt exist then make one
2089 open my $n, ">$users_dir/$user/notification.txt" or die "Couldn't open notifcations.txt,user: $user: $!";
2090 print $n "\n";
2091 close $n;
2092 @settings = ('ben');
2093 }
2094 return (grep { $_ =~ /$which/i } @settings) ? 1:0;
2095}
2096
2097#
2098# set notification settings for user
2099# arguments: USER, MENTIONED, REPLIED TO, NEW LISTENER
2100#
2101sub set_notification_settings {
2102 my ($user, $mention, $reply, $listen) = @_;
2103 open my $n, ">$users_dir/$user/notification.txt" or die "Couldn't open notifcations.txt: $!";
2104 print $n "mention\n" if $mention;
2105 print $n "reply\n" if $reply;
2106 print $n "listen\n" if $listen;
2107 close $n;
2108}
2109
2110#
2111# changes the name of someone
2112#
2113sub change_name {
2114 my ($user, $new_name) = @_;
2115 my %u = format_user($user);
2116 #$new_name = escapeHTML($new_name);
2117 my @new_file = ();
2118 open my $deets, "<$users_dir/$user/details.txt" or die "Couldn't open details.txt: $!";
2119 while (my $line = <$deets>) {
2120 chomp $line;
2121 push @new_file, $line if $line !~ /^full_name: /;
2122 push @new_file, "full_name: $new_name" if $line =~ /^full_name: /;
2123 }
2124 close $deets;
2125
2126 #create new file
2127 open my $july, ">$users_dir/$user/details.txt" or die "Couldn't open details.txt: $!";
2128 print $july join "\n", @new_file;
2129 close $july;
2130
2131 #change search file
2132 open my $email_file, "<$users_dir/search.txt" or die "Couldn't open search file: $!";
2133 chomp (my @search = <$email_file>);
2134 close $email_file;
2135 foreach (@search) {
2136 chomp $_;
2137 if ($_ =~ /^$u{'full_name'}:$user$/i) {
2138 $_ = "$new_name:$user";
2139 }
2140 }
2141 open my $e_file, ">$users_dir/search.txt" or die "Couldn't open search file: $!";
2142 print $e_file join("\n", @search);
2143 print $e_file "\n";
2144 close $e_file;
2145}
2146
2147#
2148# changes the location of someone
2149#
2150sub change_location {
2151 my ($user, $new_name) = @_;
2152 #$new_name = escapeHTML($new_name);
2153 my @new_file = ();
2154 open my $deets, "<$users_dir/$user/details.txt" or die "Couldn't open details.txt: $!";
2155 while (my $line = <$deets>) {
2156 chomp $line;
2157 push @new_file, $line if $line !~ /^home_suburb: /;
2158 push @new_file, "home_suburb: $new_name" if $line =~ /^home_suburb: /;
2159 }
2160 close $deets;
2161
2162 #create new file
2163 open my $july, ">$users_dir/$user/details.txt" or die "Couldn't open details.txt: $!";
2164 print $july join "\n", @new_file;
2165 close $july;
2166}
2167
2168#
2169# changes the email of someone
2170#
2171sub change_email {
2172 my ($user, $new_name) = @_;
2173 my %u = format_user($user);
2174 #$new_name = escapeHTML($new_name);
2175 my @new_file = ();
2176 open my $deets, "<$users_dir/$user/details.txt" or die "Couldn't open details.txt: $!";
2177 while (my $line = <$deets>) {
2178 chomp $line;
2179 push @new_file, $line if $line !~ /^email: /;
2180 push @new_file, "email: $new_name" if $line =~ /^email: /;
2181 }
2182 close $deets;
2183
2184 #create new file
2185 open my $july, ">$users_dir/$user/details.txt" or die "Couldn't open details.txt: $!";
2186 print $july join "\n", @new_file;
2187 close $july;
2188
2189 #change email file
2190 open my $email_file, "<$users_dir/email.txt" or die "Couldn't open e-mail file: $!";
2191 chomp (my @emails = <$email_file>);
2192 close $email_file;
2193 foreach (@emails) {
2194 chomp $_;
2195 if ($_ =~ /^$u{'email'}$/i) {
2196 $_ = $new_name;
2197 }
2198 }
2199 open my $e_file, ">$users_dir/email.txt" or die "Couldn't open email file: $!";
2200 print $e_file join("\n", @emails);
2201 print $e_file "\n";
2202 close $e_file;
2203}
2204
2205#
2206# changes the description of someone
2207#
2208sub change_desc {
2209 my ($user, $new_name) = @_;
2210 #$new_name = escapeHTML($new_name);
2211 open my $deets, ">$users_dir/$user/description.txt" or die "Couldn't open details.txt: $!";
2212 print $deets $new_name;
2213 close $deets;
2214}
2215
2216#
2217# deletes a user
2218#
2219sub delete_user {
2220 my ($user) = @_;
2221 my %u = format_user($user);
2222 my $user_email = $u{'email'};
2223 my $user_full_name = $u{'full_name'};
2224 #remove from email.txt and name.txt and search.txt
2225 open my $emails, "<$users_dir/email.txt" or die "Couldn't open email.txt: $!";
2226 chomp (my @lines = <$emails>);
2227 close $emails;
2228 @lines = grep {$_ !~ /^$user_email$/i} @lines;
2229 open my $email, ">$users_dir/email.txt" or die "Couldn't open email.txt: $!";
2230 print $email join("\n", @lines);
2231 print $email "\n";
2232 close $email;
2233
2234 #open my $names, "<$users_dir/name.txt" or die "Couldn't open name.txt: $!";
2235 #chomp (my @lines2 = <$names>);
2236 #close $names;
2237 #@lines2 = grep {$_ !~ /^$user_full_name$/i} @lines2;
2238 #open my $names, ">$users_dir/name.txt" or die "Couldn't open name.txt: $!";
2239 #print $names join("\n", @lines2);
2240 #print $names "\n";
2241 #close $names;
2242
2243 open my $searches, "<$users_dir/search.txt" or die "Couldn't open search.txt: $!";
2244 chomp (my @lines3 = <$searches>);
2245 close $searches;
2246 @lines3 = grep {$_ !~ /^$user_full_name:$user$/i} @lines3;
2247 open my $search, ">$users_dir/search.txt" or die "Couldn't open search.txt: $!";
2248 print $search join("\n", @lines3);
2249 print $search "\n";
2250 close $search;
2251
2252 # now delete all their bleats
2253 open my $bleat_file, "<$users_dir/$user/bleats.txt" or die "Couldn;t open blet file : $!";
2254 chomp (my @bleats = <$bleat_file>);
2255 close $bleat_file;
2256
2257 # first remove all the replies tot heir bleats
2258 my @l;
2259 my @all_bleats = glob("$bleats_dir/*");
2260 foreach my $file (@all_bleats) {
2261 @l = ();
2262 open my $b, "<$file" or die "Couldn't open: $!";
2263 while (<$b>) {
2264 push @l, $_;
2265 next unless $_ =~ /^in_reply_to: (.*)/;
2266 my $temp = $1;
2267 chomp $temp;
2268 if (grep {$_ =~ /^$temp$/} @bleats) {
2269 pop @l; # undo the push if it is a reply to one of the deleted users' bleats
2270 }
2271 }
2272 close $b;
2273 next if (grep {$_ =~ /^in_reply_to: /} @l); # to save some time
2274 open my $c, ">$file" or die "Couldn't open to write: $!";
2275 print $c join("\n", @l);
2276 print $c "\n";
2277 close $c;
2278 }
2279
2280 # now delete the bleat files
2281 foreach my $to_delete (@bleats) {
2282 if (-f "$bleats_dir/$to_delete") {
2283 unlink "$bleats_dir/$to_delete";
2284 }
2285 }
2286
2287 #finally delete the user profile folder
2288 rmtree "$users_dir/$user";
2289}
2290
2291#
2292# suspsneds a user
2293#
2294sub suspend_user {
2295 my ($user) = @_;
2296 # add to file
2297 open my $suspend, "<$users_dir/suspended.txt" or die "Couldn't open suspended: $!";
2298 chomp (my @lines = <$suspend>);
2299 close $suspend;
2300
2301 push @lines, "$user\n";
2302 open my $sus9audpaosusidah9839025b890dniskcjnoixmcpozi90q84b9ns98d, ">$users_dir/suspended.txt" or die "$!"; # i am tired ok
2303 print $sus9audpaosusidah9839025b890dniskcjnoixmcpozi90q84b9ns98d join "\n", @lines;
2304 close $sus9audpaosusidah9839025b890dniskcjnoixmcpozi90q84b9ns98d;
2305}
2306
2307#
2308# unsuspends a user
2309#
2310sub unsuspend_user {
2311 my ($user) = @_;
2312 open my $suspend, "<$users_dir/suspended.txt" or die "Couldn't open suspended: $!";
2313 chomp (my @lines = <$suspend>);
2314 close $suspend;
2315 trim($_) for @lines;
2316 @lines = grep { $_ !~ /^$user$/i } @lines;
2317
2318 open my $sus9audpaosusidah9839025b890dniskcjnoixmcpozi90q84b9ns98d, ">$users_dir/suspended.txt" or die "$!"; # i am tired ok
2319 print $sus9audpaosusidah9839025b890dniskcjnoixmcpozi90q84b9ns98d join "\n", @lines;
2320 close $sus9audpaosusidah9839025b890dniskcjnoixmcpozi90q84b9ns98d;
2321}
2322
2323
2324#
2325##################### PASSWORD RECOVERY ##############################################
2326#
2327
2328sub render_password_recovery_page {
2329 my $update = param('update_pwd') || "";
2330 if ($update) {
2331 my $user = param('user');
2332 $update = trim($update);
2333 $user = trim($user);
2334 #print $user;
2335 change_password($user, $update);
2336 print '<div id="recovery-container">';
2337 print p('Password successfully changed. Please click <a href="?page=login">here</a> to sign in.');
2338 print '</div>';
2339 print end_html;
2340 exit 0;
2341 }
2342
2343 # if they have received the e-mail, then
2344 # verify that the randomly generated filename
2345 # contains the correct username
2346 my $recover = param('recover') || "";
2347 if ($recover) {
2348 if (-f "$users_dir/$recover.txt") {
2349 # if there is a file then hoorah
2350 open my $u, "<$users_dir/$recover.txt" or die "$!";
2351 my $user_to_reset = "";
2352 while (<$u>) {
2353 $user_to_reset = $_ if $_;
2354 }
2355 close $u;
2356 unlink "$users_dir/$recover.txt";
2357
2358 print "<div id='recovery-container'>";
2359 print label('Enter new password:') . br . password_field({-id=>'passone'}) . br .
2360 label('Enter it again:') . br . password_field({-id=>'passtwo'}) . a({-href=>"javascript:check_password('$user_to_reset');"}, 'Change');
2361
2362 my $js_check = <<"eof";
2363<script type="text/javascript">
2364function check_password(user){
2365 var one = document.getElementById("passone");
2366 var two = document.getElementById("passtwo");
2367 if (one.value == two.value) {
2368 var dict = get_params();
2369 dict["update_pwd"] = one.value;
2370 dict["user"] = user;
2371 post("bitter.cgi", dict);
2372 } else {
2373 alert('Passwords do not match.');
2374 }
2375}
2376</script>
2377eof
2378 print $js_check;
2379 print "</div>";
2380 print end_html;
2381 exit 0;
2382 }
2383 }
2384
2385 # if they submit an e-mail, check that it exists
2386 # then if it does, make a file with a random name
2387 # and send them an e-mail
2388 my $email = param('email') || "";
2389 if ($email) {
2390 $email = trim($email);
2391 open my $emails, "<$users_dir/email.txt" or die "$!";
2392 chomp(my @eee = <$emails>);
2393 close $emails;
2394 if (grep {$_ =~ /^$email$/i} @eee) {
2395 # find whose thing it belongs to
2396 my @users = glob("$users_dir/*");
2397 foreach my $user (@users) {
2398 if (-d $user and -f "$user/details.txt") {
2399 open my $details, "<$user/details.txt" or die "Couldn't open $user/details.txt: $!";
2400 chomp(my @deets = <$details>);
2401 close $details;
2402 if (grep { $_ =~ /^email: $email$/i } @deets) {
2403 #found the email
2404 # we make a file using randomly generated name
2405 $user =~ s/$users_dir\///;
2406 my $random = generate_random_name();
2407 open my $pwd_recovery, ">$users_dir/$random.txt" or die "Couldn't create pwd recovery: $!";
2408 print $pwd_recovery $user."\n";
2409 close $pwd_recovery;
2410 # send email
2411 send_password_recovery_email($random, $email);
2412 print div({-id=>'recovery-container'}, p('Please check your e-mail.'));
2413 }
2414 }
2415 }
2416 } else {
2417 print '<div id="recovery-container">' . "\n";
2418 print '<p>Sorry, that e-mail does not exist. Please try again.</p>';
2419 print start_form . textfield({-name=>'email'}) . hidden({-name=>'page', -value=>'passwordrecovery'}) . submit . end_form;
2420 print '</div>' . "\n";
2421 }
2422 } else {
2423 print '<div id="recovery-container">' . "\n";
2424 print '<p>Enter your e-mail and we will send you a password recovery link.</p>';
2425 print start_form . textfield({-name=>'email'}) . hidden({-name=>'page', -value=>'passwordrecovery'}) . submit . end_form;
2426 print '</div>' . "\n";
2427 }
2428}
2429
2430#
2431# generates a cool name
2432#
2433sub generate_random_name {
2434 my @array = ('apple', 'banana', 'carrot', 'durian', 'e', 'falafel', 'grape', 'hommus', 'italian', 'jelly', 'kangaroo');
2435 return 'pwd' . $array[int(rand(11))];
2436}
2437
2438#
2439# change someones password
2440#
2441sub change_password {
2442 my ($user, $pwd) = @_;
2443
2444 # get the file contents into an array
2445 open my $file, "<$users_dir/$user/details.txt" or die "couldn't open details: $!";
2446 chomp(my@lines=<$file>);
2447 close $file;
2448
2449 # modify the array
2450 foreach (@lines) {
2451 $_ = "password: $pwd" if ($_ =~ /^password: /);
2452 }
2453
2454 # write back to the file
2455 open my $file1, ">$users_dir/$user/details.txt" or die "couldn't open details: $!";
2456 print $file1 join "\n", @lines;
2457 print $file1 "\n";
2458 close $file1;
2459}
2460
2461############################ FUNCTIONS FOR SENDING EMAILS ####################################
2462
2463#
2464# sends a notification e-mail for mention
2465#
2466sub send_notification_email_mention {
2467 my ($to, $bleatID) = @_;
2468 my %user = format_user($to);
2469 my $text = <<"eof";
2470Hello, $user{'full_name'}!
2471
2472Someone has mentioned you in a bleat! Go to bitter.cgi?b=$bleatID to check it out!
2473
2474eof
2475 system("python", "sendmail.py", "Bitter", "$user{'email'}", "Account verification", "$text") == 0 or die "couldnt send email: $!";
2476}
2477
2478#
2479# sends a notification e-mail for new replies
2480#
2481sub send_notification_email_reply {
2482 my ($to, $bleatID) = @_;
2483 my %user = format_user($to);
2484 my $text = <<"eof";
2485Hello, $user{'full_name'}!
2486
2487Someone has replied to your bleat!. Go to bitter.cgi?b=$bleatID to check it out!
2488
2489eof
2490 system("python", "sendmail.py", "Bitter", "$user{'email'}", "Account verification", "$text") == 0 or die "couldnt send email: $!";
2491}
2492
2493#
2494# sends a notification e-mail for new listener
2495#
2496sub send_notification_email_listen {
2497 my ($to, $listener) = @_;
2498 my %user = format_user($to);
2499 my $text = <<"eof";
2500Hello, $user{'full_name'}!
2501
2502$listener just followed you! POPULAR. Check out their profile at bitter.cgi?p=$listener!
2503
2504
2505
2506
2507eof
2508 system("python", "sendmail.py", "Bitter", "$user{'email'}", "Account verification", "$text") == 0 or die "couldnt send email: $!";
2509}
2510
2511
2512#
2513# sends a validation e-mail
2514#
2515sub send_email {
2516 my ($username, $email, $full_name) = @_;
2517 my $text = <<"eof";
2518Hello, $full_name!
2519
2520Welcome to Bitter. Please go to bitter.cgi?v=$username to complete your registration.
2521
2522eof
2523 system("python", "sendmail.py", "Bitter", "$email", "Account verification", "$text") == 0 or die "couldnt send email: $!";
2524}
2525
2526
2527#
2528# sends a password recovery e-mail
2529#
2530sub send_password_recovery_email {
2531 my ($random, $email) = @_;
2532 my $text = <<"eof";
2533Hello!
2534
2535Please go to bitter.cgi?page=passwordrecovery&recover=$random to complete your registration.
2536
2537eof
2538 system("python", "sendmail.py", "Bitter", "$email", "Password recovery", "$text") == 0 or die "couldnt send email: $!";
2539}