From e9192b3d42660a5781101df4357d276318151e8a Mon Sep 17 00:00:00 2001 From: Jules Laplace Date: Fri, 2 Aug 2013 17:14:41 -0500 Subject: cgi-bin & lib --- cgi-bin/2 | 1 + cgi-bin/adminz | 207 ++++ cgi-bin/bless | 23 + cgi-bin/category | 290 ++++++ cgi-bin/comment | 186 ++++ cgi-bin/details | 275 +++++ cgi-bin/import | 286 ++++++ cgi-bin/inbox | 125 +++ cgi-bin/index | 293 ++++++ cgi-bin/invite | 123 +++ cgi-bin/localbucky.pm | 70 ++ cgi-bin/localbucky.pm.tmpl | 54 + cgi-bin/login | 86 ++ cgi-bin/logout | 12 + cgi-bin/maintain | 289 ++++++ cgi-bin/message | 149 +++ cgi-bin/murder | 23 + cgi-bin/playlist | 81 ++ cgi-bin/post | 267 +++++ cgi-bin/profile | 167 +++ cgi-bin/recipe | 148 +++ cgi-bin/services_f | 83 ++ cgi-bin/services_k | 62 ++ cgi-bin/services_th | 54 + cgi-bin/settings | 24 + cgi-bin/tag | 290 ++++++ cgi-bin/users | 228 +++++ lib/Bucky1.pm | 53 + lib/RGB.pm | 151 +++ lib/boxes.pm | 165 +++ lib/color.pm | 117 +++ lib/comments.pm | 287 ++++++ lib/constants.pm | 82 ++ lib/cookies.pm | 55 + lib/db.pm | 2400 ++++++++++++++++++++++++++++++++++++++++++++ lib/files.pm | 241 +++++ lib/format.pm | 414 ++++++++ lib/forms.pm | 854 ++++++++++++++++ lib/getargs.pm | 134 +++ lib/headers.pm | 347 +++++++ lib/images.pm | 509 ++++++++++ lib/import.pm | 204 ++++ lib/invite.pm | 485 +++++++++ lib/keywords.pm | 187 ++++ lib/lastlog.pm | 29 + lib/message.pm | 195 ++++ lib/privacy.pm | 133 +++ lib/profile.pm | 127 +++ lib/radio.pm | 100 ++ lib/rand.pm | 20 + lib/randbg.pm | 26 + lib/session.pm | 262 +++++ lib/settings.pm | 315 ++++++ lib/tags.pm | 147 +++ lib/threads.pm | 411 ++++++++ 55 files changed, 12346 insertions(+) create mode 120000 cgi-bin/2 create mode 100755 cgi-bin/adminz create mode 100755 cgi-bin/bless create mode 100755 cgi-bin/category create mode 100755 cgi-bin/comment create mode 100755 cgi-bin/details create mode 100755 cgi-bin/import create mode 100755 cgi-bin/inbox create mode 100755 cgi-bin/index create mode 100755 cgi-bin/invite create mode 100644 cgi-bin/localbucky.pm create mode 100644 cgi-bin/localbucky.pm.tmpl create mode 100755 cgi-bin/login create mode 100755 cgi-bin/logout create mode 100755 cgi-bin/maintain create mode 100755 cgi-bin/message create mode 100755 cgi-bin/murder create mode 100755 cgi-bin/playlist create mode 100755 cgi-bin/post create mode 100755 cgi-bin/profile create mode 100755 cgi-bin/recipe create mode 100755 cgi-bin/services_f create mode 100755 cgi-bin/services_k create mode 100755 cgi-bin/services_th create mode 100644 cgi-bin/settings create mode 100755 cgi-bin/tag create mode 100755 cgi-bin/users create mode 100644 lib/Bucky1.pm create mode 100644 lib/RGB.pm create mode 100644 lib/boxes.pm create mode 100644 lib/color.pm create mode 100644 lib/comments.pm create mode 100644 lib/constants.pm create mode 100644 lib/cookies.pm create mode 100644 lib/db.pm create mode 100644 lib/files.pm create mode 100644 lib/format.pm create mode 100644 lib/forms.pm create mode 100644 lib/getargs.pm create mode 100644 lib/headers.pm create mode 100644 lib/images.pm create mode 100644 lib/import.pm create mode 100644 lib/invite.pm create mode 100644 lib/keywords.pm create mode 100644 lib/lastlog.pm create mode 100644 lib/message.pm create mode 100644 lib/privacy.pm create mode 100644 lib/profile.pm create mode 100644 lib/radio.pm create mode 100644 lib/rand.pm create mode 100644 lib/randbg.pm create mode 100644 lib/session.pm create mode 100644 lib/settings.pm create mode 100644 lib/tags.pm create mode 100644 lib/threads.pm diff --git a/cgi-bin/2 b/cgi-bin/2 new file mode 120000 index 0000000..1c9ed49 --- /dev/null +++ b/cgi-bin/2 @@ -0,0 +1 @@ +/var/www/vhosts/carbonpictures.com/bucky2/cgi-bin/ \ No newline at end of file diff --git a/cgi-bin/adminz b/cgi-bin/adminz new file mode 100755 index 0000000..4a71e38 --- /dev/null +++ b/cgi-bin/adminz @@ -0,0 +1,207 @@ +#!/usr/bin/perl +######################################### +# administration of threads, keywords, +# privacy, etc. + +use localbucky; + +our $id; +our $files; + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); +logout() unless ($USER != -1); + +if ($USER->{ulevel} != 3) + { redirect("/"); } +else + { + header( { title => "bucky administrauma", color => "red" } ); + menu(); + if (exists($input->{c})) + { + if ($input->{c} eq "s") + { + update_thread_title($id, $input->{title}); + $t->{title} = $input->{title}; + print "Changed thread $id title to: $t->{title}
\n"; + } + elsif ($input->{c} eq "pass") + { + do_password_reset(); + } + elsif ($input->{c} eq "p") + { + if ($input->{private} == 1) + { + print "Thread is now private.
"; + switch_thread_privacy($id, 1); + $t->{allowed} = update_whitelist(); + $t->{private} = 1; + } + else + { + print "Thread is now public.
"; + switch_thread_privacy($id, 0); + $t->{private} = 0; + } + } + elsif ($input->{c} eq "f") + { + my @flagged = corral($input, "file"); + if ($DEBUG) + { + print "
\nfiles flagged: "; + foreach (@flagged) + { print; print " "; } + print "
\n"; + } + if ($input->{verb} eq "flag") + { + print "Flagged file $flagged[0]
"; + update_flagged($id, $flagged[0]); + $t->{flagged} = $flagged[0]; + admin_form($id, $t, $files, $k); + } + elsif ($input->{verb} eq "move") + { + print "When this works it will be like this:!
\n"; + print "Where do you want to move these files here
\n"; + print "Moving files...
\n"; + # system("mv", $data_path/$oldpid/$filenamea ..., "$data_path/$newpid/"); + print "Moving ids...
\n"; + print "Recalculating thread sizes...
\n"; + } + elsif ($input->{verb} eq "rm") + { + if (!$input->{ok}) + { + print qq!

Are you sure you want to delete these files?

\n!; + print qq!

!; + print qq{\n}; + print qq{\n}; + print qq{\n} if ($DEBUG); + print qq{\n}; + print qq{\n}; + + my $i = 0; + my $fid = shift(@flagged); + foreach my $fh (sort_by_id(@$files)) + { + next if ($fid != $$fh{id}); + $i++; + print qq{\n}; + print $$fh{filename}."
\n"; + $fid = shift(@flagged); + } + + print qq{
}; + } + else + { + my $i = 0; + my $fid = shift(@flagged); + foreach my $fh (sort_by_id(@$files)) + { + next if ($fid != $$fh{id}); + $i++; + delete_file_record($fid); + system("rm", "-f", qq!$data_path/$id/$$fh{filename}!); + print qq!deleted $$fh{filename}
\n!; + $fid = shift(@flagged); + } + + print "Recalculating thread size...
\n"; + update_thread_size($id); + $files = get_files($id); + } + } + } + adminster_form(); + } + else + { + adminster_form(); + } + footer(); + } + +sub sort_by_username { sort { lc($a->{username}) cmp lc($b->{username}) } @_; } +sub sort_by_id { sort { $a->{id} <=> $b->{id} } @_; } + +sub adminster_form + { + print qq{
\n\n}; + +# my $reqs = get_user_requests(); +# if ($reqs != -1) +# { +# my $s = (@$reqs != 1) ? "s" : ""; +# alert_box("$BUCKY/approve", @$reqs." account request$s pending!"); +# } + + print < +password reset form +
+end + password_reset_form(); + print ""; + +# "flush" zips button +# recalculcate thread sizes +# links to approval etc (alert!) + print qq{
\n\n}; + } + +sub password_reset_form + { + my $users = get_all_users(); + + print qq!
!; + print qq{\n}; + print qq{\n} if ($DEBUG); + print qq!!; + print qq! + + +
user:!; + print qq!\n!; + print <
+password?
+		 +
+
+again! + +
+ +
+pws + print qq!
\n!; + } + +sub do_password_reset + { + if (exists($input->{pw1}) && exists($input->{pw2}) && $input->{pw1} && $input->{pw2}) + { + if ($input->{pw1} eq $input->{pw2}) + { + update_password($input->{user}, crypt($input->{pw1},lc($input->{user}))); + print qq(password changed for $input->{user}
\n); + } + else + { + print "passwords don't match!
\n"; + } + } + } + diff --git a/cgi-bin/bless b/cgi-bin/bless new file mode 100755 index 0000000..0773fe7 --- /dev/null +++ b/cgi-bin/bless @@ -0,0 +1,23 @@ +#!/usr/bin/perl +######################################### +# bless +######################################### + +use localbucky; + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); +logout() unless ($USER != -1); + +our $blessy = $input->{username}; +if (get_uid($blessy) == -1) + { error("no such user $blessy"); } +elsif ($blessy eq $USER->{username}) + { error("you fucking egomaniac"); } +commit_blessing($blessy); +new_message("$blessy.inbox", {sender => "$USER->{username}", recipient => "$blessy", unread => 1, subject => "You look radiant.", body => "You feel a slight prickling along your nape."}); +redirect("$BUCKY/index"); + +$dbh->disconnect (); + diff --git a/cgi-bin/category b/cgi-bin/category new file mode 100755 index 0000000..94ee934 --- /dev/null +++ b/cgi-bin/category @@ -0,0 +1,290 @@ +#!/usr/bin/perl +######################################### +# index +# - do all index stuff, also deal with keyword admin +######################################### + +use localbucky; + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); + +my $k; +my $tag; + +# check name of the calling script: index, tag, keyword +$input->{script} ||= $input->{script_from_uri} if defined($input->{script_from_uri}); + +# load the tag or keyword into the input params, if they don't exit already +if ( $input->{script} eq $BUCKY_LEXICON_TAG ) + { + $input->{tag} ||= $input->{object_from_uri} if defined($input->{object_from_uri}); + } +elsif ( $input->{script} eq $BUCKY_LEXICON_KEYWORD ) + { + $input->{keyword} ||= $input->{object_from_uri} if defined($input->{object_from_uri}); + } + +# Get keyword +if (exists($input->{keyword}) && $input->{keyword} ne "new" && $input->{keyword} ne "unsorted") + { + $k = get_keyword($input->{keyword}); + } + + +# Create New Keyword? FORM +if (exists($input->{keyword}) && $input->{keyword} eq "new") + { + my $t; + header("add new category"); + if (exists($input->{thread})) + { + $t = get_thread($input->{thread}); + } + menu(); + print "

"; + my %faek = + ( + keyword => $input->{keyword}, + thread => $input->{thread} + ); + keyword_form($input->{keyword}, \%faek, $t); + footer(); + } + +# Edit settings for keyword +elsif ($input->{c} eq "edit" && (check_op($k) || $USER->{ulevel} == 3)) + { + header( + { + title => "settings for category '$input->{keyword}'", + sticky => $input->{keyword} + } ); + # 20070903 - marc - new menu args calling style + my $menu_args; + $menu_args->{keywords} = $k if $k; + menu( $menu_args ); +# menu($k); + print "

"; + + keyword_form($k->{keyword}, $k); + + print qq!
!; + my $threads = get_threads_by_keyword($k->{keyword}); + thread_box({ threads => $threads, kw => $k }); + + print qq!
!; + footer(); + } + +# Create new keyword? Process form results +elsif ($input->{c} eq "create") + { + if (!defined($input->{keyword})) + { error("no keyword specified!"); } + if (get_keyword($input->{keyword}) != -1) + { error("keyword already exists!"); } + my %nk = + ( + keyword => $input->{keyword}, + threads => " $input->{thread} ", + owner => $USER->{username}, + public => $input->{public}, + agglutinate => $input->{agglutinate}, + color => $input->{color}, + ops => (make_whitelist()) + ); + if ($DEBUG) + { + header("Creating keyword $input->{keyword}"); + menu(); + foreach my $ky (keys %nk) + { print "$ky => $nk{$ky}
\n"; } + } + add_keyword(\%nk); + update_thread_keyword($input->{thread}, $input->{keyword}); + redirect("$BUCKY/$BUCKY_LEXICON_KEYWORD/$input->{keyword}"); + } + +# Edit settings for keyword? Process form results +elsif ($input->{c} eq "update") + { + if (!defined($input->{keyword})) + { error("no keyword specified!"); } + my %nk = + ( + threads => " $input->{thread} ", + public => (exists($input->{public}) ? 1 : 0), + agglutinate => (exists($input->{agglutinate})) ? $input->{agglutinate} : 0, + color => $input->{color} + ); + if (!exists($input->{public})) + { + $nk{ops} = make_whitelist(); + } + if ($DEBUG) + { + header("Updating keyword $input->{keyword}"); + menu(); + foreach my $ky (keys %nk) + { print "$ky => $nk{$ky}
\n"; } + } + update_keyword($input->{keyword}, \%nk); + redirect("$BUCKY/$BUCKY_LEXICON_KEYWORD/$input->{keyword}"); + } + +# Assign keyword processing form action +elsif ($input->{c} eq "assign") + { + keyword_assign_mechanism($input->{keyword}, $input->{thread}, $k); + redirect("$BUCKY/maintain/$input->{thread}"); + # redirect("$BUCKY/index?keyword=$input->{keyword}"); + } + +# Detach keyword action +elsif ($input->{c} eq "detach") + { + my $t; + + if (!defined($input->{thread})) + { error("no post specified!"); } + $t = get_thread($input->{thread}); + $k = get_keyword($t->{keyword}); + + my %nk = ( threads => delete_key($k->{threads}, $input->{thread}) ); + + if ($DEBUG) + { + header("Detaching post from $t->{keyword}"); + menu(); + foreach my $ky (keys %nk) + { print "$ky => $nk{$ky}
\n"; } + print "keyword ==> $t->{keyword}
\n"; + print "detaching $t->{title} from $t->{keyword}
\n"; + } + update_keyword($t->{keyword}, \%nk); + update_thread_keyword($t->{id}, "NULL"); + redirect("$BUCKY/maintain/$t->{id}"); + } + +# Display main index page +else + { + my $tag = exists($input->{tag}) ? $input->{tag} : undef; + my $keyword = exists($input->{keyword}) ? $input->{keyword} : "all"; + my $limit = exists($input->{limit}) ? int($input->{limit}) : 40; + my $date = exists($input->{start}) ? int($input->{start}) : "now"; + + header({ title => get_random_line("titles"), sticky => $input->{keyword} }); + my $keywords = get_keywords(); + my $tags = get_tags(); + + my $menu_args; + $menu_args->{keywords} = $keywords->{$keyword} if $keywords->{$keyword}; + menu( $menu_args ); + + print qq(); + print qq(); +############################# +# KEYWORD LIST + print qq(\n); + + print qq(\n); + print qq(); + + print qq(
\n); + print qq(
); + my $p = ''; my $l = ''; + my $with_letter = 0; + my $s = ''; +my $pre = ''; + my $start = ''; + foreach my $k (sort { lc($a) cmp lc($b) } keys %$keywords) + { + my $style; + $l = substr($k,0,1); + $start ||= $l; + if ($p && lc($l) ne lc($p)) + { + if ($with_letter > 3) + { + print qq($start - $pre
); + print $s; + print qq(
); + print qq(
); + $s = ''; + $with_letter = 1; + $p=''; + $start = $l; + } + } + $with_letter += 1; + $p||=$l; + $pre=$l; + $s .= qq($k
); + } +if ($s) + { + print qq($start - $pre
); + print $s; + print qq(
); + print qq(
); + } + print qq(
); + print qq(
); + print qq(.: unsorted :.
); + print qq(
\n); + + alerts(); + if ($USER == -1) + { + bPod_box(); + } + else + { + welcome_box(); # if (check_key($USER->{boxes}, "welcome")); + search_box(); + bPod_box() if (check_key($USER->{boxes}, "bPod")); + radio_box() if (check_key($USER->{boxes}, "radio")); + upload_form($keyword) if (check_key($USER->{boxes}, "postform")); + hoot_box() if (check_key($USER->{boxes}, "hootbox")); + } + print qq(\n); + + if (check_key($USER->{boxes}, "photostream") || ($USER == -1) ) + { + if ( $keyword ne "all" ) + { photostream({ keyword => $keyword, vertical => 0, count => 4 }); } + elsif ( $tag ) + { photostream({ tag => $tag, vertical => 0, count => 4 }); } + else + { photostream({ user => 1, vertical => 0, count => 4 }); } + } + + print qq(
); + + if ($keyword ne "all") + { + my $threads = throttle_threads({ keyword => $keyword, newest => $date }); + thread_box({ threads => $threads, kw => $keywords->{$keyword} }); + } + elsif ($tag) + { + my $threads = throttle_threads({ tag => $tag, newest => $date }); + thread_box({ threads => $threads, tag => $tags->{$tag}, sort_by => "name" }); + } + else + { + alpha_index($keywords, $limit, $date); + } + + print qq(
); + print qq(
\n\n); + + footer(); + } + +$dbh->disconnect (); + +print "Index: " . &report_time() . "\n" if $timer; diff --git a/cgi-bin/comment b/cgi-bin/comment new file mode 100755 index 0000000..01a763b --- /dev/null +++ b/cgi-bin/comment @@ -0,0 +1,186 @@ +#!/usr/bin/perl +######################################### +# comment +# redundant w/ post: add a comment/files to a thread +######################################### + +use localbucky; + +my $pid; + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); +logout() unless ($USER != -1); + +$input->{id} ||= $input->{object_from_uri} if defined($input->{object_from_uri}); +$input->{id} =~ s/\D*//g; +if ($input->{c} eq "edit") + { + my $header_args; + my $comment = get_comment($input->{id}); + error("No such comment!") if ($comment == -1); + my $thread = get_thread($comment->{thread}); + my $keyword = get_keyword($thread->{keyword}); + error("Cannot edit comment!") unless ($USER->{username} eq $BUCKY_ADMINISTRATOR || $USER->{username} eq $comment->{username} || (check_key($thread->{display}, "editable") && check_privacy($thread, $keyword))); + + $header_args->{title} = qq(editing comment . . .); + $header_args->{subtitle} = qq(back to post · $thread->{title}), + $header_args->{color} = "ivory"; + + header ($header_args); + menu(); + print < +
+duh + curt_post_form($comment); + print qq!\n!; + footer(); + } +elsif ($input->{c} eq "delete") + { + my $header_args; + my $comment = get_comment($input->{id}); + error("No such comment!") if ($comment == -1); + my $thread = get_thread($comment->{thread}); + my $keyword = get_keyword($thread->{keyword}); + error("Cannot delete comment!") unless ($USER->{username} eq $BUCKY_ADMINISTRATOR || $USER->{username} eq $comment->{username} || (check_key($thread->{display}, "editable") && check_privacy($thread, $keyword))); + + if ($input->{ok} eq "yes") + { + delete_comment($comment->{id}); + redirect("$BUCKY/".details_link($thread)."/$comment->{thread}".get_revision($thread)); + } + else + { + $header_args->{title} = qq(delete comment?); + $header_args->{subtitle} = qq(back to post ($thread->{title})); + $header_args->{color} = "ivory"; + + header ($header_args); + menu(); + print qq!

Are you sure you want to !; + print qq!delete this comment?

\n!; + my $subcomment = substr($comment->{comment}, 0, 64); + $subcomment =~ s//>/g; + $subcomment =~ s/"/"/g; + print "

".$subcomment."

"; + print qq!
!; + print qq(\n); + print qq(\n); + print qq(\n) if ($DEBUG); + print qq(\n); + + print qq(
); + print qq(\n); + footer(); + } + } +elsif ($input->{c} eq "reply") + { + my $header_args; + my $comment = -1; + my $thread = -1; + my $keyword = -1; + if (exists($input->{id})) + { + $comment = get_comment($input->{id}); + error("No such comment!") if ($comment == -1); + $thread = get_thread($comment->{thread}); + } + elsif (exists($input->{thread})) + { + $thread = get_thread($input->{thread}); + } + my $keyword = get_keyword($thread->{keyword}); + error("Cannot see comment!") unless (check_privacy($thread) || check_op($keyword)); + + $header_args->{title} = qq(reply to comment . . .); + $header_args->{subtitle} = qq(back to post · $thread->{title}); + $header_args->{color} = "ivory"; + + header ($header_args); + menu(); + print < +
+duh + curt_reply_form($comment, $thread, $keyword); + print qq!\n!; + footer(); + } +elsif ($input->{c} eq "update") + { + my $comment = get_comment($input->{id}); + error("No such comment!") if ($comment == -1); + my $thread = get_thread($comment->{thread}); + my $keyword = get_keyword($thread->{keyword}); + error("Cannot edit comment!") unless ($USER->{username} eq $BUCKY_ADMINISTRATOR || $USER->{username} eq $comment->{username} || (check_key($thread->{display}, "editable") && check_privacy($thread, $keyword))); + update_comment($input->{id}, $input->{comment}) if ($input->{comment}); + touch_thread($thread); + + if ($comment->{thread} == 1) + { + redirect("$BUCKY/index"); + } + else + { + redirect("$BUCKY/".details_link($thread)."/$comment->{thread}".get_revision($thread)); + } + } +elsif ($input->{id} == 1) + { + add_comment($input->{id}, -1, $USER->{username}, $input->{comment}) if ($input->{comment}); + redirect("$BUCKY/index"); + } +else + { + my $pid; + my $t; + my $keyword; + if ($DEBUG) + { + header ("adding message to $input->{id}"); + print "adding message to $input->{id}:

"; + } + + $t = get_thread($input->{id}); + if ($t == -1) + { + flush_files(); + redirect("$BUCKY/".details_link($t)."/$comment->{thread}".get_revision($t)); + } + $keyword = get_keyword($thread->{keyword}); +# error("No such thread!") unless ($t != -1 && check_privacy($t, $keyword)); + + if (exists($input->{parent_id})) + { + my $headc = get_comment($input->{parent_id}); + error("No such comment!") if ($headc == -1); + if ($headc->{parent_id} != -1) + { $pid = $headc->{parent_id}; } + else + { $pid = $headc->{id}; } + } + else + { + $pid = -1; + } + + add_comment($t->{id}, $pid, $USER->{username}, $input->{comment}) if ($input->{comment}); + situate_files($t->{id}, $USER->{username}); + touch_thread($t); + redirect("$BUCKY/".details_link($t)."/$t->{id}".get_revision($t)); + switch_file_privacy($t->{id}, $t->{private}); + } + +if ($DEBUG) + { + footer (); + } + +$dbh->disconnect (); + +print "Comment: " . &report_time() . "\n" if $timer; diff --git a/cgi-bin/details b/cgi-bin/details new file mode 100755 index 0000000..35b34c7 --- /dev/null +++ b/cgi-bin/details @@ -0,0 +1,275 @@ +#!/usr/bin/perl +######################################## +# details +######################################### + +use localbucky; + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); +our $loggedin = ($USER != -1); + +our ($t, $kw, $files, $comments) = details_init(); +details_run($t, $kw, $files, $comments); + +sub details_init + { + $input->{id} ||= $input->{object_from_uri} if defined($input->{object_from_uri}); + my $id = exists($input->{id}) ? $input->{id} : error("No such thread!"); + + my $t = get_thread($id); + error("No such post.") if ($t == -1); + my $kw = get_keyword($t->{keyword}); + + my $files = get_files($t->{id}); + my $comments = get_comments ($t->{id}); + + if ( ! check_privacy($t, $kw) ) # || check_participation($files, $comments) ) + #unless ( check_privacy($t, $kw) || check_participation($files, $comments) ) + { error("No such post!"); } + + # Reset NULL viewed + if ( ! $t->{viewed} ) + { $t->{viewed} = 0; } + + # Increment viewed for this thread + $t->{viewed}++; + # Update thread viewed count + update_thread_viewed( $t->{id}, $t->{viewed} ); + + return ($t, $kw, $files, $comments); + } + +sub details_run + { + my ($t, $kw, $files, $comments) = @_; + my $header_args = + { + title => $t->{title}, + sticky => $t->{keyword}, + color => get_color($t, $kw, $comments) +# participation => check_participation($files, $comments) + }; + + my $age = get_age($t->{lastmodified}); + $age .= " ago" unless $age eq "now"; + + $header_args->{subtitle} = + qq!posted by $t->{username} on ! . + verbosedate($t->{createdate}) . " · active " . $age . + qq! · $t->{viewed} view! . courtesy_s($t->{viewed}); + + if ($t->{username} eq $USER->{username} || check_op($kw) || $header_args->{participation} == 2 || $USER->{ulevel} == 3) + { + $header_args->{subtitle} .= qq! · !; + $header_args->{subtitle} .= qq!options!; + } +# else +# { +# $header_args->{subtitle} .= +# qq! · go to index!; +# } + + $header_args->{subtitle} .= qq! · !; + $header_args->{subtitle} .= qq!download\!!; + + my @participants = get_participants($t, $files, $comments); + + $header_args->{sidetitle} = details_participation(@participants) + if (@participants > 0); + $header_args->{sidesubtitle} = "see also: ".details_tags_box($t, $kw)."" + if (@{$t->{tags}}); + + header($header_args); + + # 20070903 - marc - new menu args calling style + my $menu_args; + $menu_args->{keywords} = $kw if $kw; + $menu_args->{ftp} = 1 if ($t->{files}+$t->{comments} + 1); + menu( $menu_args ); + + details_view($t, $kw, $comments, $files); + footer(); + } + + +############################## + +sub details_view + { + my ($t, $kw, $comments, $files) = @_; + my ($many_jpgs, $flagged) = find_jpeg_v2($files, $t->{flagged}); + if ($many_jpgs > 6) + { + print qq(

); + } + else + { + print qq(
); + } + + print qq("; + + print qq(
); + print qq(); + + if ($flagged != -1 && $many_jpgs > 1) + { + print qq(); + } + + sideshow_comments({ thread => $t, keyword => $kw, comments => $comments }); + print qq(); + print qq(
); + print_flagged_jpeg($flagged); + print qq(
); + reply_form($t->{id}, $t); + print qq(
); + + if ($flagged != -1 && $many_jpgs == 1) + { + print qq(		); + print_flagged_jpeg($flagged); + } + elsif ($many_jpgs > 1 || @$files > $many_jpgs) + { + print qq(); + } + else + { + print qq(); + } + if ($many_jpgs > 1) + { + if ($many_jpgs < 6) # && @$files == $many_jpgs) + { image_column($files, $flagged, $many_jpgs); } + else + { image_gallery($files, $flagged, $many_jpgs); } + } + if (@$files > $many_jpgs) + { + if (find_mp3($files)) + { + my $z_playlist = "/cgi-bin/bucky/playlist/$t->{id}"; + my $z_autoplay = "false"; + if (check_key($USER->{boxes}, "autoplay")) + { $z_autoplay = "true"; } + print <<__PLAYLIST__; +
LOADING MP3 PLAYER ...
+ + + +__PLAYLIST__ + } + if (check_key($t->{display}, "nfl")) # no file list + { ; } + elsif (check_key($t->{display}, "ffl")) # full file list + { + file_list($files, 0, 1, 0); + } + else # "terse" file list + { + file_list($files, 0, 1, $many_jpgs); + } + } + if ($ZIP_BUTTON_ENABLED && @$files > 4) + { + zip_this_button($t); + } + + details_keywords_box($t, $kw); + print "
); + } + +sub find_mp3 + { + my ($q) = @_; + foreach my $f (@$q) + { return 1 if $f->{filename} =~ /mp3$/i; } + return 0; + } + +sub details_tags_box + { + my ($t, $kw) = @_; +# my $tags = $t->{tags}; + return tags_stringify_links ( $t ); +# return join(", ", @$tags); + } + +sub details_participation + { + my (@participants) = @_; + my $pcount = 0; + my $out; + + foreach my $p (@participants) + { + $pcount++; + next if ($pcount > 6); + my $image = get_profile_image($p, $AVATAR_MED_PREFIX); + if ($image != -1) + { + $out .= qq( ); + $out .= qq(); + $out .= qq(); + $out .= qq(); + } + } + if ($pcount > 6) + { + $out .= " + ".($pcount - 4); + $out .= " $BUCKY_DUDER_NOUN"; + $out .= courtesy_s($pcount - 4); + $out .= ""; + } + return $out; + } + +# get list of unique users posting in thread +sub get_participants + { + my ($t, $files, $comments) = @_; + my %participant; + $participant{$t->{username}} = 1000; + + foreach my $f (@$files) + { $participant{$f->{username}}++; } + foreach my $c (keys %$comments) + { $participant{$comments->{$c}->{username}}++; } + + return (sort { $participant{$b} <=> $participant{$a} } (keys(%participant))); + } + +sub details_keywords_box + { + my ($t, $kw) = @_; + if (defined($t->{keyword}) && !check_key($t->{display}, "kws")) + { + my $t = get_threads_by_keyword($t->{keyword}); + if ($t != -1) + { + print qq(); + thread_box({ threads => $t, kw => $kw }); + print qq(
); + } + } + } + +############################## + +print "Details: " . &report_time() . "\n" if $timer; diff --git a/cgi-bin/import b/cgi-bin/import new file mode 100755 index 0000000..fc7add5 --- /dev/null +++ b/cgi-bin/import @@ -0,0 +1,286 @@ +#!/usr/bin/perl +######################################### +# import +# escorts ftp'd files into the database +######################################### + +use localbucky; + +my $pid; + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); +logout() unless ($USER != -1); + +if ($input->{c} eq "n") + { + my $valid = 0; + my $thread_id = 0; + if ($DEBUG) + { + header("importing files..."); + foreach $k (sort keys %$input) { print "$k => ".$input->{$k}."
"; } + } + foreach my $k (keys %$input) + { + if ($k =~ /^import/) + { $valid = 1; last; } + } + if ($valid) + { + if ($input->{id} && $input->{id} ne "new") + { + $thread = get_thread($input->{id}); + $keyword = get_keyword($thread->{keyword}); + if ($thread != -1 && check_privacy($thread, $keyword)) + { + $thread_id = $thread->{id}; + touch_thread($thread); + } + else + { + error("cannot import into specified thread"); + } + } + else + { + if ($input->{title} eq undef || $input->{title} =~ /^\s+$/) + { + error ("No thread title!"); + } + else + { + $thread_id = add_thread($input->{title}, $USER->{username}, 0); + } + } + print "thread_id => $thread_id
" if ($DEBUG); + add_comment($thread_id,-1,$USER->{username},$input->{comment}) if ($input->{comment} ne undef); + situate_imports($thread_id, $USER->{username}); + if (exists($input->{keyword})) + { + my $k = get_keyword($input->{keyword}); + if ($k->{public} || check_op($k)) + { + keyword_assign_mechanism($input->{keyword}, $thread_id, $k); + } + } + } + else + { error("No imports specified!"); } + if ($DEBUG) + { + print qq{this way to your new thread: link!}; + footer(); + } + redirect("$BUCKY/details/$thread_id"); + } + +else + { + my ($title, $size, $inc); + + my $thread = -1; + my $keyword = -1; + if ($input->{id}) + { + # id title username createdate lastmodified size private allowed flagged + $thread = get_thread($input->{id}); + $keyword = get_keyword($thread->{keyword}); + } + if ($input->{keyword}) + { + $keyword = get_keyword($input->{keyword}); + } + elsif ($thread->{keyword}) + { + $keyword = get_keyword($thread->{keyword}); + } + + header("ftp import"); + menu(); + if ($USER->{'username'} eq "asdfasdfadsfadsf") + { + print <<__SORRY__; +
+
+
+
SORRY! +
+You have maxed out your upload quota!

+Delete some things you've uploaded, then try again. +


+__SORRY__ + exit; + } + print < +
+
+ +UPLOAD FILES TO BUCKY WITH CONVENIENCE USING SFTP +
+ +You must generate a cryptographic key to use this service. Don't worry it's easy!
+
+
+
+ +ON A MAC / UNIX
+
+recc'd sftp client: Cyberd*ck
+to generate the key, from Terminal run:
+ssh-keygen -t rsa
+send me the public key +
+(private key is handled automatically) +
+
+
+
+ +ON WINDOWS ...
+
+recc'd sftp client: WINSCP (PC)
+generate the key with the program puttygen +
+send me the public key +
+(the private key goes in the program when you set up the session.) + +
+
+
+
+ +log in here: +
+
+ +$BUCKY_FTP_HOST
+username: $BUCKY_FTP_USER + +
+
+
+
+ +Once you're in, upload your files and they should show up below. Check off only the files that are yours, +or click the toggle button to select them all. +impHEAD + + if ($thread == -1) + { + print qq(To attach FTP'd files to a pre-existing thread, go to the thread and click ftp here.); + } + print qq!
\n\n!; + + print qq!
\n!; + print qq!
\n!; + ($title, $inc, $size) = list_imports(); + + print < + + + + + + + +
+widget + + if ($inc) + { + print "
INCOMPLETE FILES ARE SHOWN IN ITALICS -- PLEASE WAIT FOR YOUR UPLOAD TO FINISH

\n\n"; + } + + if ($DEBUG) { print qq!\n!; } + print qq!\n!; + + print qq!

!; + print qq!!; + if ($thread != -1 && check_privacy($thread, $keyword)) + { + print qq!!; + } + else + { + print qq!\n\n!; + print qq!!; + print qq!!; + } + print qq!!; + + print qq! + +
!; + print qq! !; + print qq!!; + print qq!These files will be added to:

$thread->{title}
\n!; + print qq!posted by $thread->{username} on !.verbosedate($thread->{createdate}).qq!

\n\n!; + print qq!\n!; + print qq!

!; + print qq!title: !; + print qq!!; + print qq!
\n!; + print qq!
!; + print "keyword: "; + print qq!!; + if (exists($input->{keyword})) + { + my $k = get_keyword($input->{keyword}); + if ($k->{public} || check_op($k)) + { + keyword_pulldown($k->{keyword}); + $checked = $k->{public} ? "" : " checked"; + } + else + { keyword_pulldown("NONE"); } + } + else + { keyword_pulldown("NONE"); } + print qq!
!; + print " "; + print qq!
!; + print qq!comment: !; + print qq!!; + print < + +

+ +

+
+
+ + + +impFOOT + footer(); + } + +$dbh->disconnect (); + diff --git a/cgi-bin/inbox b/cgi-bin/inbox new file mode 100755 index 0000000..9760a54 --- /dev/null +++ b/cgi-bin/inbox @@ -0,0 +1,125 @@ +#!/usr/bin/perl +######################################### +# inbox +# deal with inboxing, message display +######################################### + +use localbucky; + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); +logout() unless ($USER != -1); + +if ( defined($input->{object_from_uri}) ) + { + if ( $input->{object_from_uri} =~ /^[0-9]+$/ ) + { + $input->{id} ||= $input->{object_from_uri}; + } + else + { + $input->{box} ||= $input->{object_from_uri}; + } + + } +#$input->{id} ||= $input->{object_from_uri} if defined($input->{object_from_uri}) && ($input->{object_from_uri} =~ /^[0-9]+$/); +#$input->{box} ||= $input->{object_from_uri} if defined($input->{object_from_uri}) && ( +if (exists($input->{id})) + { + # display message + + my $message = get_message($input->{id}); + my $bn = $b->{mbox}; + $bn =~ s/^$USER->{username}\.//; + if ($message == -1) + { error("No such message!"); } + if ($USER->{username} ne $message->{recipient} && $USER->{username} ne $message->{sender}) + { error("You are not the recipient of this message."); } + unflag_message($input->{id}); + my $header_args= {}; + $header_args->{'title'} = $message->{'subject'}; + if ($message->{'body'} =~ /body bgcolor="?([#0-9a-fA-F]+)/) + { + $header_args->{'color'} = $1; + } + + header($header_args); + menu(); + print "

"; + display_message($message); + footer(); + } + +elsif ($input->{c} eq "f") + { + # folder_management_form(); + } + +else + { + my $box = exists($input->{box}) ? $input->{box} : "inbox"; + my $limit = exists($input->{limit}) ? int($input->{limit}) : 50; + my $date = exists($input->{start}) ? int($input->{start}) : "now"; + + header("your $box"); + menu(); + + my $messages = get_messages("$USER->{username}.$box", $limit, $date); + my $boxes = get_boxes($USER->{username}); + + print qq!
!; + + print < +message center +
+
+ + +userbox + + foreach my $b (@$boxes) + { + my $count = $b->{mcount} || 0; + my $bn = $b->{mbox}; + $bn =~ s/^$USER->{username}\.//; + print qq!! . + qq!!; + } + + print < + +
+ +Compose New Mail + +
+ +need to find someone?
+check the userlist + + +userbox + + print qq!
Foldersmsgs
$bn!.hushnull($count, undef, 1).qq!
!; + + message_list($messages, $box); + + if (@$messages == $limit) + { + print qq!

!; + $oldest = $messages->[-1]->{date}; + print qq(next $limit messages >>); + print qq!
\n!; + } + + print qq!
!; + + footer(); + } + +$dbh->disconnect (); + +print "Inbox: " . &report_time() . "\n" if $timer; diff --git a/cgi-bin/index b/cgi-bin/index new file mode 100755 index 0000000..8ddacb4 --- /dev/null +++ b/cgi-bin/index @@ -0,0 +1,293 @@ +#!/usr/bin/perl +######################################### +# index +# - do all index stuff, also deal with keyword admin +######################################### + +use localbucky; + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); + +my $k; +my $tag; + +# check name of the calling script: index, tag, keyword +$input->{script} ||= $input->{script_from_uri} if defined($input->{script_from_uri}); + +# load the tag or keyword into the input params, if they don't exit already +if ( $input->{script} eq $BUCKY_LEXICON_TAG ) + { + $input->{tag} ||= $input->{object_from_uri} if defined($input->{object_from_uri}); + } +elsif ( $input->{script} eq $BUCKY_LEXICON_KEYWORD ) + { + $input->{keyword} ||= $input->{object_from_uri} if defined($input->{object_from_uri}); + } + +# Get keyword +if (exists($input->{keyword}) && $input->{keyword} ne "new" && $input->{keyword} ne "unsorted") + { + $k = get_keyword($input->{keyword}); + } + + +# Create New Keyword? FORM +if (exists($input->{keyword}) && $input->{keyword} eq "new") + { + my $t; + header("add new category"); + if (exists($input->{thread})) + { + $t = get_thread($input->{thread}); + } + menu(); + print "

"; + my %faek = + ( + keyword => $input->{keyword}, + thread => $input->{thread} + ); + keyword_form($input->{keyword}, \%faek, $t); + footer(); + } + +# Edit settings for keyword +elsif ($input->{c} eq "edit" && (check_op($k) || $USER->{ulevel} == 3)) + { + header( + { + title => "settings for category '$input->{keyword}'", + sticky => $input->{keyword} + } ); + # 20070903 - marc - new menu args calling style + my $menu_args; + $menu_args->{keywords} = $k if $k; + menu( $menu_args ); +# menu($k); + print "

"; + + keyword_form($k->{keyword}, $k); + + print qq!
!; + my $threads = get_threads_by_keyword($k->{keyword}); + thread_box({ threads => $threads, kw => $k }); + + print qq!
!; + footer(); + } + +# Create new keyword? Process form results +elsif ($input->{c} eq "create") + { + if (!defined($input->{keyword})) + { error("no keyword specified!"); } + if (get_keyword($input->{keyword}) != -1) + { error("keyword already exists!"); } + my %nk = + ( + keyword => $input->{keyword}, + threads => " $input->{thread} ", + owner => $USER->{username}, + public => $input->{public}, + agglutinate => $input->{agglutinate}, + color => $input->{color}, + ops => (make_whitelist()) + ); + if ($DEBUG) + { + header("Creating keyword $input->{keyword}"); + menu(); + foreach my $ky (keys %nk) + { print "$ky => $nk{$ky}
\n"; } + } + add_keyword(\%nk); + update_thread_keyword($input->{thread}, $input->{keyword}); + redirect("$BUCKY/$BUCKY_LEXICON_KEYWORD/$input->{keyword}"); + } + +# Edit settings for keyword? Process form results +elsif ($input->{c} eq "update") + { + if (!defined($input->{keyword})) + { error("no keyword specified!"); } + my %nk = + ( + threads => " $input->{thread} ", + public => (exists($input->{public}) ? 1 : 0), + agglutinate => (exists($input->{agglutinate})) ? $input->{agglutinate} : 0, + color => $input->{color} + ); + if (!exists($input->{public})) + { + $nk{ops} = make_whitelist(); + } + if ($DEBUG) + { + header("Updating keyword $input->{keyword}"); + menu(); + foreach my $ky (keys %nk) + { print "$ky => $nk{$ky}
\n"; } + } + update_keyword($input->{keyword}, \%nk); + redirect("$BUCKY/$BUCKY_LEXICON_KEYWORD/$input->{keyword}"); + } + +# Assign keyword processing form action +elsif ($input->{c} eq "assign") + { + keyword_assign_mechanism($input->{keyword}, $input->{thread}, $k); + redirect("$BUCKY/maintain/$input->{thread}"); + # redirect("$BUCKY/index?keyword=$input->{keyword}"); + } + +# Detach keyword action +elsif ($input->{c} eq "detach") + { + my $t; + + if (!defined($input->{thread})) + { error("no post specified!"); } + $t = get_thread($input->{thread}); + $k = get_keyword($t->{keyword}); + + my %nk = ( threads => delete_key($k->{threads}, $input->{thread}) ); + + if ($DEBUG) + { + header("Detaching post from $t->{keyword}"); + menu(); + foreach my $ky (keys %nk) + { print "$ky => $nk{$ky}
\n"; } + print "keyword ==> $t->{keyword}
\n"; + print "detaching $t->{title} from $t->{keyword}
\n"; + } + update_keyword($t->{keyword}, \%nk); + update_thread_keyword($t->{id}, "NULL"); + redirect("$BUCKY/maintain/$t->{id}"); + } + +# Display main index page +else + { + my $tag = exists($input->{tag}) ? $input->{tag} : undef; + my $keyword = exists($input->{keyword}) ? $input->{keyword} : "all"; + my $limit = exists($input->{limit}) ? int($input->{limit}) : $BUCKY_INDEX_LIMIT; + my $date = exists($input->{start}) ? int($input->{start}) : "now"; + + header({ title => get_random_line("titles"), sticky => $input->{keyword}, color => get_color_from_time() }); + my $keywords = get_keywords(); + my $tags = get_tags(); + + my $menu_args; + $menu_args->{keywords} = $keywords->{$keyword} if $keywords->{$keyword}; + menu( $menu_args ); + + print qq(); + print qq(); + +############################# +# KEYWORD LIST + print qq(\n); + +############################# +# PRINT MAIN PANE + print qq(\n); + +############################# +# PRINT SIDEBAR + print qq(); + +############################### + + print qq(); + print qq(
\n); + print qq(
); + my $p = ''; my $l = ''; + my $with_letter = 0; + my $s = ''; +my $pre = ''; + my $start = ''; + foreach my $k (sort { lc($a) cmp lc($b) } keys %$keywords) + { + my $style; + $l = substr($k,0,1); + $start ||= $l; + if ($p && lc($l) ne lc($p)) + { + if ($with_letter > 3) + { + print qq($start - $pre
); + print $s; + print qq(
); + print qq(
); + $s = ''; + $with_letter = 1; + $p=''; + $start = $l; + } + } + $with_letter += 1; + $p||=$l; + $pre=$l; + $s .= qq($k
); + } +if ($s) + { + print qq($start - $pre
); + print $s; + print qq(
); + print qq(
); + } + print qq(
); + print qq(
); + print qq(.: unsorted :.
); + print qq(
\n); + +# index_photostream($keyword,$tag); + +# print qq(); +# print qq(
); + print qq(
); + + if ($keyword ne "all") + { + my $threads = throttle_threads({ keyword => $keyword, newest => $date }); + thread_box({ threads => $threads, kw => $keywords->{$keyword} }); + } + elsif ($tag) + { + my $threads = throttle_threads({ tag => $tag, newest => $date }); + thread_box({ threads => $threads, tag => $tags->{$tag} }); + } + else + { + alpha_index($keywords, $limit, $date); + } + + print qq(
); + print qq(		\n); + alerts(); + if ($USER == -1) + { + bPod_box(); + } + else + { + welcome_box(); # if (check_key($USER->{boxes}, "welcome")); + search_box(); +# radio_box() ; # if (check_key($USER->{boxes}, "radio")); +# bPod_box() if (check_key($USER->{boxes}, "bPod")); + hoot_box() if (check_key($USER->{boxes}, "hootbox")); +# svn_box();# if $USER->{'ulevel'} == 3; +# upload_form($keyword) if (check_key($USER->{boxes}, "postform")); + } + print qq(
\n\n); + + footer(); + } + +$dbh->disconnect (); + +print "Index: " . &report_time() . "\n" if $timer; diff --git a/cgi-bin/invite b/cgi-bin/invite new file mode 100755 index 0000000..cf29b1b --- /dev/null +++ b/cgi-bin/invite @@ -0,0 +1,123 @@ +#!/usr/bin/perl +######################################### +# invite +######################################### +# id hash state attest created expired username password realname email grass keywords + +use localbucky; + +use invite; +use Digest::MD5 qw (md5_hex); + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); +our $loggedin = ($USER != -1); + +our ($command, $hash, $id) = invite_init(); +invite_run($command, $hash, $id); + +sub invite_init + { + my $command = exists($input->{c}) ? scrub($input->{c}) : -1; + my $hash = -1; + if (defined($input->{object_from_uri})) + { $hash = scrub($input->{object_from_uri}); } + elsif (exists($input->{hash})) + { $hash = scrub($input->{hash}); } + elsif (exists($input->{invite})) + { $hash = scrub($input->{invite}); } + elsif (exists($input->{i})) + { $hash = scrub($input->{i}); } + my $id = exists($input->{id}) ? scrub($input->{id}) : -1; + return ($command, $hash, $id); + } + +sub invite_run + { + my ($command, $hash, $id) = @_; + + if ($loggedin) + { invite_process_user($command, $hash, $id); } + else + { invite_process_outsider($command, $hash); } + } + +sub invite_process_outsider + { + my ($command, $hash) = @_; + + # validate invite + if ($command eq "validate") + { + validate_invite($hash); + } + # add request + elsif ($command eq "request") + { + request_invite(); + } + # redeem invite + elsif ($hash != -1) + { + my $invite = get_invite_from_hash($hash); + unless (invite_is_active($invite)) + { error("Bad invite key!"); } + registration_form($invite); + } + # registration form + else + { + registration_form(); + } + } + +sub invite_process_user + { + my ($command, $hash, $id) = @_; + my $result = -1; + my $invite = -1; + if ($hash != -1) + { $invite = get_invite_from_hash($hash); } + elsif ($id) + { $invite = get_invite_from_id($id); } + + # new invite + if ($command eq "new") + { + $hash = generate_invite(); + $result = ($hash != -1) ? 1 : 0; + } + # approve/delete/extend invites + elsif ($command eq "approve" && $USER->{ulevel} == 3) + { $result = validate_approve($invite); } + elsif ($command eq "reject" && $USER->{ulevel} == 3) + { $result = set_invite_state($invite, $BUCKY_INVITE_REJECTED); } + elsif ($command eq "cancel" && $invite->{attest} eq $USER->{username}) + { $result = set_invite_state($invite, $BUCKY_INVITE_EXPIRED); } + elsif ($command eq "renew" && $invite->{attest} eq $USER->{username}) + { $result = set_invite_expired($invite, ($invite->{expired} + 86400*7)); } + + header("invite manager"); + menu(); + + print qq(); + print qq(\n
\n); + + display_personal_invites($user_invites); + print "

"; + display_approve_list() if ($USER->{ulevel} == 3); + + print qq(

\n); + + invite_result_box($command, $hash, $result) if ($command != -1); + invite_create_box(); + + print qq(
\n\n); + + footer(); + } + +$dbh->disconnect (); + + diff --git a/cgi-bin/localbucky.pm b/cgi-bin/localbucky.pm new file mode 100644 index 0000000..32d6e33 --- /dev/null +++ b/cgi-bin/localbucky.pm @@ -0,0 +1,70 @@ +#!/usr/bin/perl + +# Change this to point to Bucky library directory, where packages are installed +use lib "/var/www/vhosts/carbonpictures.com/bucky/lib"; + +# Change this to point to the directory of random texts +our $BUCKY_FORTUNES = "/var/www/vhosts/carbonpictures.com/bucky/fortune"; + +# Change this to point to the URL preamble for Bucky's script directory, where cgi-bin scripts are installed +BEGIN + { + our $BUCKY = "/cgi-bin/bucky"; + our $BUCKY_DB = "bucky"; + our $BUCKY_DB_CNF = "/var/www/vhosts/carbonpictures.com/.bucky.cnf"; + } + +#our $BUCKY = ""; + +our $BUCKY_NAME = 'bucky'; +our $BUCKY_SHORT_NAME = 'bucky'; +our $BUCKY_COOKIE_DOMAIN = 'carbonpictures.com'; +our $BUCKY_HOST = 'www.carbonpictures.com'; # url domain + +our $BUCKY_ADMINISTRATOR = 'jules'; +our $BUCKY_DEFAULT_BOXES = " welcome bPod radio postform hootbox photostream "; +our $BUCKY_DEFAULT_KEYWORD = 'NONE'; # default should be 'NONE' +our $BUCKY_TIMEZONE_OFFSET = 5; # correct your server's offset from GMT +our $BUCKY_DUDER_NOUN = 'duder'; # singular noun accepting courtesy 's' + +our $BUCKY_LOGIN_WELCOME = "welcome to bucky"; # welcome on login screen + +# bucky non-css colors +our $BUCKY_COLOR_HR = "#201010"; + +# /index +# presumed max number of threads to show +our $BUCKY_INDEX_LIMIT = 50; +# how many days to display under "the latest" +our $BUCKY_INDEX_LATEST = 1.78; + +our $LASTLOG_ONLY_FIRST_DAY = 0; + +our $INDEX_GALLERY_IMAGE_COUNT = 4; + +# bPod: URLs, colors +our $BPOD_URL_SERVICES_KEYWORDS = $BUCKY_HOST . "$BUCKY/services_k"; +our $BPOD_URL_SERVICES_THREADS = $BUCKY_HOST . "$BUCKY/services_th?k="; +our $BPOD_URL_SERVICES_FILES = $BUCKY_HOST . "$BUCKY/services_f?pid="; +our $BPOD_URL_PREAMBLE_FILES = $BUCKY_HOST . "/bucky/data/"; +our $BPOD_URL_DETAILS = $BUCKY_HOST . "$BUCKY/details/"; +our $BPOD_COLOR_UI_GRADIENT_1 = "0xE6F0F0"; +our $BPOD_COLOR_UI_GRADIENT_2 = "0xD8E0EC"; +our $BPOD_COLOR_UI_STROKE = "0x201010"; + +# thread url format: /details (== 0) or individually by /keyword (== 1) +our $BUCKY_KEYWORD_IN_DETAILS_URL = 0; + +our $ZIP_BUTTON_ENABLED = 1; + +# (shoutcast) radio status +our $RADIO_STATUS_ENABLED = 1; +our $RADIO_STATUS_URL = "http://radiofreehanoi.com/status"; +our $RADIO_INFO_URL = "http://radiofreehanoi.com/info"; + + +# Load bucky packages +use Bucky1; + +1; + diff --git a/cgi-bin/localbucky.pm.tmpl b/cgi-bin/localbucky.pm.tmpl new file mode 100644 index 0000000..143c192 --- /dev/null +++ b/cgi-bin/localbucky.pm.tmpl @@ -0,0 +1,54 @@ +#!/usr/bin/perl + +use Time::Stopwatch; + +# Comment out this timer to suppress page loadtime messages +tie our $timer, 'Time::Stopwatch'; + +our $BUCKY_NAME = 'king of sf'; +our $BUCKY_SHORT_NAME = 'kingofsf'; +our $BUCKY_COOKIE_DOMAIN = 'kingofsf.com'; + +our $BUCKY_ADMINISTRATOR = 'marc'; +our $BUCKY_DEFAULT_BOXES = " welcome bPod radio postform hootbox photostream "; +our $BUCKY_DEFAULT_KEYWORD = 'NONE'; # default should be 'NONE' +our $BUCKY_TIMEZONE_OFFSET = 8; # correct your server's offset from GMT + +# Change this to point to Bucky library directory, where packages are installed +use lib "/bucky/lib"; + +# Change this to point to the URL preamble for Bucky's script directory, where cgi-bin scripts are installed +our $BUCKY = "/cgi-bin/bucky"; + +# Change this to be a welcome messasge for your login screen +our $BUCKY_LOGIN_WELCOME = "welcome to kitchen hacklab, pricks"; + +# Change this to your bucky host! +our $BUCKY_HOST = "www.carbonpictures.com"; + +# bucky non-css colors +our $BUCKY_COLOR_HR = "#201010"; + +# bPod: URLs, colors +our $BPOD_URL_SERVICES_KEYWORDS = $BUCKY_HOST . "$BUCKY/services_k"; +our $BPOD_URL_SERVICES_THREADS = $BUCKY_HOST . "$BUCKY/services_th?k="; +our $BPOD_URL_SERVICES_FILES = $BUCKY_HOST . "$BUCKY/services_f?pid="; +our $BPOD_URL_PREAMBLE_FILES = $BUCKY_HOST . "/bucky/data/"; +our $BPOD_URL_DETAILS = $BUCKY_HOST . "$BUCKY/details?id="; +our $BPOD_COLOR_UI_GRADIENT_1 = "0xF8F8D7"; +our $BPOD_COLOR_UI_GRADIENT_2 = "0xF0F0E6"; +our $BPOD_COLOR_UI_STROKE = "0x201010"; + +# thread url format: /details (== 0) or individually by /keyword/ (== 1) +our $BUCKY_KEYWORD_IN_DETAILS_URL = 0; + +# Load bucky packages +use Bucky; + +# Report nicely formatted time +sub report_time + { + return sprintf("%2.2f", $timer * 1000) . "ms"; + } +1; + diff --git a/cgi-bin/login b/cgi-bin/login new file mode 100755 index 0000000..0335549 --- /dev/null +++ b/cgi-bin/login @@ -0,0 +1,86 @@ +#!/usr/bin/perl +######################################### +# login +# no input: print form +# input: set cookie, send along to index +######################################### + +if (-e "/var/www/vhosts/carbonpictures.com/bucky/lock") + { + print "Content-type: text/html\nPragma: no-cache\n\n"; + print "

" . $BUCKY_CONFIG->{BUCKY_NAME} . " is down for maintenance!

please check back in a bit.

"; + exit(0); + } + +if (! exists $ENV{'HTTPS'} || $ENV{'HTTPS'} ne "on") + { + print "Location: https://www.carbonpictures.com/cgi-bin/bucky/index\n\n"; + exit; + } +use localbucky; + +$dbh = DBI->connect ($dsn); + +# Check to see if user has supplied a username for login +if (exists($input->{username})) + { + if ($DEBUG) + { header("login"); } + + # Look up user, based on username and password + my ($USER) = auth( $input->{username}, crypt($input->{password}, lc($input->{username}) ) ); + + # No such user, or password failed, so redirect to logout + if ($USER == -1) + { print "password failed
\n" if $DEBUG; logout(); } + + # User successfully logged in! Update the last login time + update_lastsession( $USER->{username} ); + $USER->{lastsession} = $USER->{lastseen}; + + if ($DEBUG) + { + print "
\n"; + print "uid: $USER->{id}\n

username: $USER->{username}\n

\n"; + print "

\n"; + footer(); + } + + nice_redirect(); + } + +# Else, if there's an i=1 query string, redirect to adduser program +elsif (exists($input->{i}) && $input->{i} == 1) + { redirect("$BUCKY/adduser?i=1"); } + +# Else, no username, so just display the login page +else + { + header("login"); + print qq{



}; + + # Display any login errors + if ($input->{error} == 1) + { print "bad username/password!
"; } + elsif ($input->{error} == 2) + { print "illegal traversal!
"; } + + print "$BUCKY_LOGIN_WELCOME"; + print qq{
\n
\n\n}; + + login_form(); + + print qq(

\n\n); +# print qq(tour the hacklab); +# print qq(

want an account?
request one
); + print qq(

\n\n); + + footer(); + } + +$dbh->disconnect (); +print "Login: " . &report_time() . "\n" if $timer; + + +######################################### + diff --git a/cgi-bin/logout b/cgi-bin/logout new file mode 100755 index 0000000..ac3888a --- /dev/null +++ b/cgi-bin/logout @@ -0,0 +1,12 @@ +#!/usr/bin/perl + +######################################### +# logout +# i love logging out +######################################### + +use localbucky; + +logout(); +print "Logout: " . &report_time() . "\n" if $timer; + diff --git a/cgi-bin/maintain b/cgi-bin/maintain new file mode 100755 index 0000000..007e1e3 --- /dev/null +++ b/cgi-bin/maintain @@ -0,0 +1,289 @@ +#!/usr/bin/perl +######################################### +# maintain +# - thread administration +######################################### + +use localbucky; + +our $id; +our $files; + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); +logout() unless ($USER != -1); + +$input->{id} ||= $input->{object_from_uri} if defined($input->{object_from_uri}); +if (exists($input->{id}) && $input->{id} > 0) + { $id = $input->{id}; } +elsif (exists($input->{keyword}) ) + { $keyword = $input->{keyword}; } +else + { error("No post specified."); } + +my $t = get_thread($id); +my $k = get_keyword($t->{keyword}); + +if ($t == -1) + { error("No such post."); } + +$files = get_files($t->{id}); +$comments = get_comments($t->{id}); + +#my ($participation) = check_participation($files, $comments); +my ($participation) = 0; + +if (exists($input->{c}) && $input->{c} eq "zip") + { + if ($t->{zipped} == 0) + { + my $cleantitle = generate_zip_filename($t); + update_thread_zipped($t->{id}, -1); + $t->{zipped} = -1; + system(qq!$NOHUP_PATH $ZIP_PATH -jr "$data_path/$t->{id}/$cleantitle" $data_path/$t->{id}/* >$temp_path/.zip.out -x "$cleantitle" 2>&1 &!); + redirect("$BUCKY/".details_link($t)."/$t->{id}"); + } + elsif ($t->{zipped} == 1) + { + my $cleantitle = generate_zip_filename($t); + update_thread_zipped($t->{id}, -1); + $t->{zipped} = -1; + system(qq!$NOHUP_PATH $ZIP_PATH -jr "$data_path/$t->{id}/$cleantitle" $data_path/$t->{id}/* >$temp_path/.zip.out -x "$cleantitle" 2>&1 &!); + redirect("$BUCKY/".details_link($t)."/$t->{id}"); + } + } +elsif ($t->{username} eq $USER->{username} || check_op($k) || $participation == 2 || (check_key($t->{display}, "opset") && check_privacy($t, $k)) || $USER->{ulevel} == 3) + { + header( { + title => "settings for \"$t->{title}\"", + subtitle => qq!posted by $t->{username} on ! . + (verbosedate($t->{createdate})) . + qq! · view post!, + color => get_color($t, $k) + } ); + menu(); + if (exists($input->{c})) + { + if ($input->{c} eq "display") + { + if ($t->{title} ne $input->{title}) + { + update_thread_title($t->{id}, $input->{title}); + $t->{title} = $input->{title}; + print "Changed title to: $t->{title}
\n"; + } + + if (($t->{color} ne $input->{color}) && is_color($input->{color})) + { + update_thread_color($t->{id}, $input->{color}); + $t->{color} = $input->{color}; + print "Set color to: $t->{color}
\n"; + print qq(); + } + + my (@display) = qw[hoot ren "no-upload" shorturl editable opset "no-zip-button" hidekws]; + my $newdisplay = ' '; + foreach my $key (@display) + { + if (exists($input->{$key}) && $input->{$key} == 1) + { $newdisplay = add_key($newdisplay, $key); } + } + if ($input->{filelist} == 2) + { $newdisplay = add_key($newdisplay, "ffl"); } + if ($input->{filelist} == 0) + { $newdisplay = add_key($newdisplay, "nfl"); } + + if ($t->{display} ne $newdisplay) + { + update_thread_display($t->{id}, $newdisplay); + $t->{display} = $newdisplay; + print "New display settings: $t->{display}
\n"; + } + + # touch_thread($t); + admin_form($t->{id}, $t, $files, $k); + } + elsif ($input->{c} eq "p") + { + if ($input->{private} == 2) + { + print "Thread is now " . $BUCKY_CONFIG->{PRIVACY_OWNER} . ".
"; + switch_thread_privacy($t->{id}, 2); + $t->{allowed} = update_whitelist(); + $t->{private} = 2; + } + elsif ($input->{private} == 1) + { + print "Thread is now viewable by " . $BUCKY_CONFIG->{PRIVACY_BBS} || "other users" . ".
"; + switch_thread_privacy($t->{id}, 1); + $t->{allowed} = update_whitelist(); + $t->{private} = 1; + } + else + { + print "Thread is now viewable by " . $BUCKY_CONFIG->{PRIVACY_WORLD} . ".
"; + switch_thread_privacy($t->{id}, 0); + $t->{private} = 0; + } + admin_form($t->{id}, $t, $files, $k); + } + # change tags + elsif ($input->{c} eq "t") + { + my $new_tags = 0; + if ($input->{tags} ne $input->{tags_saved}) + { + print "Changed Tag to " . $input->{tags} . "
" if ($DEBUG); + # First: add new tags + my $tags = get_tags_from_string( $input->{tags} ); + foreach my $tag (@$tags) + { + print "Assigning tag $tag
\n" if ($DEBUG); + print tag_assign_mechanism( $tag, $t ) || ""; + $new_tags++; + } + + # Second: remove deleted tags + my $old_tags = get_tags_from_string( $input->{tags_saved} ); + foreach my $old_tag (@$old_tags) + { + # If the new tags list does not contain this old tag, remove it + if ( ! grep ( /^$old_tag$/, @$tags ) ) + { + print tag_remove_mechanism( $old_tag, $t ) || ""; + $new_tags++; + } + } + } + # touch_thread($t); + $t = get_thread( $t->{id} ) if $new_tags; + admin_form($t->{id}, $t, $files, $k); + } + elsif ($input->{c} eq "f") + { + my @flagged = corral($input, "file"); + if ($DEBUG) + { + print "
\nfiles flagged: "; + foreach (@flagged) + { print; print " "; } + print "
\n"; + } + if ($input->{verb} eq "flag") + { + print "Flagged file $flagged[0]
"; + update_flagged($t->{id}, $flagged[0]); + $t->{flagged} = $flagged[0]; + touch_thread($t); + admin_form($t->{id}, $t, $files, $k); + } + elsif ($input->{verb} eq "move") + { + print "When this works it will be like this:!
\n"; + print "Where do you want to move these files here
\n"; + print "Moving files...
\n"; + # system("mv", $data_path/$oldpid/$filenamea ..., "$data_path/$newpid/"); + print "Moving ids...
\n"; + print "Recalculating post sizes...
\n"; + } + elsif ($input->{verb} eq "rm") + { + if (!$input->{ok}) + { + print qq(

Are you sure you want to delete these files?

\n); + print qq(

); + print qq(\n); + print qq(\n); + print qq(\n) if ($DEBUG); + print qq(\n); + print qq(\n); + + my $i = 0; + my $fid = shift(@flagged); + foreach my $fh (sort_by_id(@$files)) + { + next if ($fid != $fh->{id}); + $i++; + + print qq{\n}; + print $fh->{id}.": " if ($DEBUG); + print $fh->{filename}."
\n"; + + $fid = shift(@flagged); + } + + print qq{
}; + } + else + { + my $i = 0; + my $fid = shift(@flagged); + foreach my $fh (sort_by_id(@$files)) + { + next if ($fid != $fh->{id}); + $i++; + + next if -d qq!$data_path/$t->{id}/$$fh{filename}!; + delete_file_record($fid); + system($RM_PATH, "-f", qq!$data_path/$t->{id}/$$fh{filename}!); + system($RM_PATH, "-f", qq!$data_path/$t->{id}/.thumb/s.$$fh{filename}!); + system($RM_PATH, "-f", qq!$data_path/$t->{id}/.thumb/t.$$fh{filename}!); + system($RM_PATH, "-f", qq!$data_path/$t->{id}/.thumb/b.$$fh{filename}!); + print qq!deleted $$fh{filename}
\n!; + + $fid = shift(@flagged); + } + + print "Recalculating post size...
\n"; + update_thread_size($t->{id}); + $files = get_files($t->{id}); + touch_thread($t); + admin_form($t->{id}, $t, $files, $k); + } + } + } + elsif ($input->{c} eq "clobber") + { + if ($input->{okay}) + { + delete_thread($t->{id}); + print qq!

POST DELETED\!
\n!; + } + else + { + my $fs = $t->{files} != 1 ? "s" : ""; + my $cs = $t->{comments} != 1 ? "s" : ""; + my $par = get_participation($t->{id}); + my $ps = $par != 1 ? "s" : ""; + print qq(

); + print qq(Are you sure you want to delete:
$t->{title}

); + print qq(Doing so will delete $t->{files} file$fs and $t->{comments} comment$cs,
); + print qq(destroying the hard work of $par duder$ps\!
); + print qq(
); + print qq(
\n); + print qq(\n) if ($DEBUG); + print qq(\n); + print qq(\n); + print qq(\n); + print qq(
); + + print qq!
!; + } + } + } + else + { + admin_form($t->{id}, $t, $files, $k); + } + footer(); + } +else + { + error("Unable to access $id!"); + } + +sub sort_by_username { sort { lc($a->{username}) cmp lc($b->{username}) } @_; } +sub sort_by_id { sort { $a->{id} <=> $b->{id} } @_; } + +print "Maintain: " . &report_time() . "\n" if $timer; diff --git a/cgi-bin/message b/cgi-bin/message new file mode 100755 index 0000000..08c0968 --- /dev/null +++ b/cgi-bin/message @@ -0,0 +1,149 @@ +#!/usr/bin/perl +######################################### +# message +# - deal with message reading/sending +######################################### + +use localbucky; + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); +logout() unless ($USER != -1); + +$input->{username} ||= $input->{object_from_uri} if defined($input->{object_from_uri}); +if ($$input{c} eq "s") + { + my $subject; + my $recip = lc($$input{recipient}); + my $box; + my $out; + + # send message: take input, check on it, add to db + if (!exists($$input{recipient}) || !exists($$input{body})) + { error("Missing one or more fields!"); } + if ($recip eq "system") + { $recip = "marc"; } + if (get_uid($recip) == -1) + { error("No such user $recip!"); } + if (length($input->{subject}) == 0) + { + # no subject so obviously we have to supply something retarded + @subjects = ("sup duder", "WHAUT UP DWIZLINKA", "HAPPY BIG CHAVYO WILVERFAO?", "NO DUM bB SUXCER Ylo TWIENF", "fararyY*F**YFARRRRADAYY+++", "i doINT BELIEVE YOYU!&U#*&!", "fuckN TEHAS D", "YO WHAT UP DOGGIE", "SENdiN BUcKY MeZSaGeZ", "SALWE"); + $subject = $subjects[(int rand @subjects)] + } + else + { $subject = $$input{subject}; } + + my %newmsg = (sender => $USER->{username}, recipient => $recip, unread => 1, subject => $subject, body => $$input{body}); + + if (exists($input->{later})) + { + header("saving draft"); + menu(); + $box = "drafts"; + $newmsg{unread} = 0; + if (exists($input->{oldid})) + { + update_message($input->{oldid}, \%newmsg); + } + else + { + new_message("$USER->{username}.$box", \%newmsg); + } + + $out = "SAVED AS DRAFT"; + } + else + { + header("sending message"); + menu(); + new_message("$recip.inbox", \%newmsg); + + $box = "outbox"; + $newmsg{unread} = 0; + new_message("$USER->{username}.$box", \%newmsg); + $out = "MESSAGE SENT"; + + if (exists($$input{oldid})) + { + delete_message($$input{oldid}); + recount_mailbox("$USER->{username}.drafts"); + } + } + + print qq!


$out

return to $box

!; + footer(); + } + +elsif ($$input{c} eq "r") # reply to message + { + $message = get_message($$input{id}); + if ($message == -1) + { error("No such message."); } + elsif ($$message{recipient} ne $USER->{username} && $$message{sender} ne $USER->{username}) + { error("You do not own this message."); } + if ($$message{mbox} =~ /drafts/) + { + header("edit message"); + menu(); + message_form($$message{recipient}, $message); + } + else + { + header("reply to message"); + menu(); + message_form($$message{sender}, $message); + } + footer(); + } + +elsif ($$input{c} eq "d") # delete message + { + if ($DEBUG) + { + header("deleting message"); + menu(); + print "Deleting message $$input{id}"; + } + my $box = process_delete($$input{id}); + if ($DEBUG) + { footer(); } + else + { + $box =~ s/^$USER->{username}.//; + redirect("$BUCKY/inbox/$box"); + } + } + +else # new message: display form + { + my $recipient; + if (exists($$input{username})) + { $recipient = $$input{username}; } + else + { $recipient = ""; } + header("new message"); + menu(); + message_form($recipient, -1); + footer(); + } + +$dbh->disconnect (); + +sub process_delete + { + my ($mid) = (@_); + my $message; + if (!defined($mid)) + { error("No id specified!"); } + $message = get_message($mid); + if ($message == -1) + { error("No such message."); } + elsif ($$message{recipient} ne $USER->{username}) + { error("You do not own this message."); } + delete_message($mid); + recount_mailbox($$message{mbox}); + return $$message{mbox}; + } +print "Message: " . &report_time() . "\n" if $timer; diff --git a/cgi-bin/murder b/cgi-bin/murder new file mode 100755 index 0000000..356cf5d --- /dev/null +++ b/cgi-bin/murder @@ -0,0 +1,23 @@ +#!/usr/bin/perl +######################################### +# not bless +######################################### + +use localbucky; + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); +logout() unless ($USER != -1); + +my $blessy = $input->{username}; +if (get_uid($blessy) == -1) + { error("no such user"); } +elsif ($blessy eq $USER->{username}) + { error("THE GUN JAMS"); } +commit_murder($blessy); +add_comment(1,-1,"system","BUT WHAT WILL WE DO WITH THE BODY"); +redirect("$BUCKY/index"); + +$dbh->disconnect (); + diff --git a/cgi-bin/playlist b/cgi-bin/playlist new file mode 100755 index 0000000..9b87d6a --- /dev/null +++ b/cgi-bin/playlist @@ -0,0 +1,81 @@ +#!/usr/bin/perl + +use localbucky; +use URI::Escape; + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); +our $loggedin = ($USER != -1); + +our ($t, $kw, $files) = playlist_init(); +playlist_run($t, $kw, $files); + +sub playlist_run + { + my ($t, $kw, $files) = @_; + my $sorty = sub { sort {lc($a->{filename}) cmp lc($b->{filename})} @_ }; + + my $z_title = $t->{title}; + my $z_link = qq($BUCKY/).details_link().qq(/$t->{id}); + $z_link .= get_revision($t) if ($USER != -1); + + my $rss = <<__RSS__; + + +$z_title +$z_link +__RSS__ + + foreach my $file ($sorty->(@$files)) + { + next if (($file->{username} ne $USER->{username}) && $file->{private} && !$whitelist && $USER->{ulevel} != 3); + next unless ($file->{filename} =~ /mp3$/i); + my $z_file = $file->{filename}; + my $z_filepath = uri_escape($file->{filename}); + my $z_content = "https://$BUCKY_HOST$live_path/$file->{thread}/$z_filepath"; + $rss .= <<__RSS__; + +$z_file +$z_content + + + +__RSS__ + } + + $rss .= "\n\n"; + + print "Content-type: text/xml\n\n"; + $rss =~ s/&/&/g; + print $rss; + } + +sub playlist_init + { + $input->{id} ||= $input->{object_from_uri} if defined($input->{object_from_uri}); + my $id = exists($input->{id}) ? $input->{id} : error("No such thread!"); + + my $t = get_thread($id); + error("No such post.") if ($t == -1); + my $kw = get_keyword($t->{keyword}); + + my $files = get_files($t->{id}); +# my $comments = get_comments ($t->{id}); + + if ( ! check_privacy($t, $kw) ) # || check_participation($files, $comments) ) + #unless ( check_privacy($t, $kw) || check_participation($files, $comments) ) + { error("No such post!"); } + + # Reset NULL viewed + if ( ! $t->{viewed} ) + { $t->{viewed} = 0; } + + # Increment viewed for this thread +# $t->{viewed}++; + # Update thread viewed count +# update_thread_viewed( $t->{id}, $t->{viewed} ); + + return ($t, $kw, $files); # $comments); + } + diff --git a/cgi-bin/post b/cgi-bin/post new file mode 100755 index 0000000..fd2de78 --- /dev/null +++ b/cgi-bin/post @@ -0,0 +1,267 @@ +#!/usr/bin/perl +######################################### +# post +# - create a new thread/post from an initial file +# - form: append multiple files +######################################### + +use localbucky; + +my $pid; + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); +logout() unless ($USER != -1); + +if ($input->{c} eq 'new') + { new_post_action(); } +elsif ($input->{c} eq 'reply') + { reply_post_action(); } +else + { long_post_form(); } + +################################# + +sub long_post_form + { + my $t = -1; + my $k = -1; + if ( exists($input->{thread}) ) + { + my $header_args; + + $t = get_thread( $input->{thread} ); + $k = get_keyword( $t->{keyword} ); + + error("No such post!") unless ($t != -1); + error("No such keyword!") unless ($k == -1 || ($k->{public} || check_op($k))); + + $header_args->{title} = qq(reply to $t->{title}); + $header_args->{subtitle} = qq(return to post); + + header ($header_args); + } + elsif ( exists($input->{keyword}) ) + { + my $header_args; + + $k = get_keyword( $input->{keyword} ); + + if ($k != -1 && (($k->{public} || check_op($k)))) + { + $header_args->{title} = qq(new $k->{keyword}); + $header_args->{subtitle} = qq(return to $BUCKY_LEXICON_KEYWORD); + header ($header_args); + } + else + { + header("Creating a new post..."); + } + } + else + { + header("Creating a new post..."); + } + + menu(); + print "

\n\n"; + my $checked = ''; + + print qq(

\n); + print qq!\n\n! if ($DEBUG); + + print < + +
+FORMmid + + if ($t != -1) + { + print qq!!; + print qq!!; + print qq!
replying to:$t->{title}
posted !.verbosedate($t->{createdate}).qq! by $t->{username}
!; + } + else + { + print qq!!; + print qq!!; + print qq!!; + print qq!!; + print qq!!; + print qq!!; + print qq!
!; + print qq!title: !; + print qq!!; + print qq!
\n!; + print qq!
!; + print "category: "; + print qq!!; + if ($k->{public} || check_op($k)) + { + keyword_pulldown($k->{keyword}); + $checked = $k->{public} ? "" : " checked"; + } + else + { keyword_pulldown(); } + print qq!
!; + print qq!tags: !; + print qq!!; + print qq!
\n!; + print qq!
!; + print qq!publicity:!; + print qq!!; + # don't need this + # print qq!! + privacy_select("private", $checked); + print qq!
!; + print qq!(can be changed at any time via post settings)\n!; + print qq!
!; + print qq!
!; + print qq!!; + } + + print qq!
!; + print qq!

\n!; + + if (! check_key($t->{display}, "no-upload")) + { + print <
+
+

+FORMEND + } + print qq( +
); +# if ($t != -1) +# { print qq(remember! you can always use ftp to upload files . . .); } +# else +# { print qq(remember! you can always use ftp to upload files . . .); } + print " "; + print <
+ +

+
+FORMEND + footer(); + } + +sub new_post_action + { + my $files; + my $title = ''; + my $private = 0; + my $k; + + $k = get_keyword($input->{keyword}) if (exists($input->{keyword}) && ($input->{keyword} ne "NONE")); + + if ($input->{title}) + { + $title = $input->{title}; + $title =~ s/^\s+//; + $title =~ s/\s+/ /g; + $title =~ s/_/ /g; + } + else + { + for (my $i = 1; $i < 10; $i++) + { + if ($input->{"file".$i} ne "temp_") + { + $title = $input->{"file".$i}; + $i = 11; + } + } + if ($title) + { + $title =~ s/^temp_//i; + $title =~ s/\.....?$//; + $title =~ s/^\s+//; + $title =~ s/\s+/ /g; + $title =~ s/_/ /g; + } + elsif ($$input{"comment"}) + { + $title = "dER buCKYiSt ***cHaTTEN**** AUF ZZem *AwL**"; + } + else + { + error ("No title specified!"); + } + } + + if ($DEBUG) + { + header("new post"); + print "attempting to make a new post: $title

"; + } + + $private = $input->{private} if ($input->{private}); + + $thread_id = add_thread($title, $USER->{username}, $private); + print "id: $thread_id

" if ($DEBUG); + add_comment($thread_id,-1,$USER->{username},$$input{comment}); + situate_files($thread_id, $USER->{username}); + switch_thread_privacy($thread_id, $private); + if ($k->{public} || check_op($k)) + { + keyword_assign_mechanism($k->{keyword}, $thread_id, $k); + } + + # Check for any supplied tags + if (exists($input->{tags}) && (length(trim($input->{tags}) ) > 0) ) + { + # Unpack tags from the form text field (remove delimiters, retrieve already existing tags, + # create new tags + my $tags = get_tags_from_string( $input->{tags} ); + + # Loop through each tag + foreach my $tag (@$tags) + { + # should we even get this?? +# next unless ($tag->{public} || check_op($tag)); + + # Associate this tag with this thread + tag_assign_mechanism( $tag, $thread_id ); + } + } + + if ($DEBUG) + { + print qq{this way to your new post: link!}; + footer(); + } + + if ($k != -1) + { + redirect("$BUCKY/".details_link($k)."/$thread_id"); + } + else + { + redirect("$BUCKY/$BUCKY_LEXICON_DETAILS/$thread_id"); + } + } + +sub reply_post_action + { + if ($DEBUG) + { + header("posting to $input->{thread}"); + } + my $thread = (exists($input->{thread})) ? get_thread($input->{thread}) : error("No such thread!"); + my $keyword = ($thread->{keyword}) ? get_keyword($thread->{keyword}) : -1; + error("Cannot see comment!") unless (check_privacy($thread) || check_op($keyword)); + + print "id: $thread->{id}

" if ($DEBUG); + add_comment($thread->{id}, -1, $USER->{username}, $input->{comment}) if ($input->{comment} ne undef); + situate_files($thread->{id}, $USER->{username}); + switch_thread_privacy($thread->{id}, $thread->{private}); + redirect("$BUCKY/".details_link($thread)."/$thread->{id}"); + } + +$dbh->disconnect (); + +print "Post: " . &report_time() . "\n" if $timer; diff --git a/cgi-bin/profile b/cgi-bin/profile new file mode 100755 index 0000000..93dc089 --- /dev/null +++ b/cgi-bin/profile @@ -0,0 +1,167 @@ +#!/usr/bin/perl +######################################### +# profile +# maintain a user's profile +# or print a form +######################################### + +use localbucky; + +my $pid; + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); +our $loggedin = ($USER != -1); + +sub main + { + $input->{username} ||= $input->{object_from_uri} if defined($input->{object_from_uri}); + my ($keywords) = get_keywords(); + + if (exists($input->{c}) && $input->{c} eq "sticky" && defined($input->{keyword})) + { + logout() unless ($loggedin); + my $keyword = $input->{keyword}; + print "Switching keyword $keyword for $USER->{username} ..." if ($DEBUG); + my $stkcy = check_key($keyword, $USER->{stickies}); + my $newk; + if (exists($input->{chexor})) + { $newk = add_key($USER->{stickies}, $keyword); } + else + { $newk = delete_key($USER->{stickies}, $keyword); } + update_user_sticky($USER->{username}, $newk); + redirect("$BUCKY/index"); + } + elsif (exists($input->{username})) + { + if ($USER->{username} eq $input->{username}) + { + header( { + title => "profile for $input->{username}", + subtitle => qq!edit your profile! + } ); + } + elsif ($input->{username} eq "system") + { + $input->{username} = "marc"; + header("profile for $input->{username}"); + } + elsif (get_uid($input->{username}) == -1) + { nice_redirect(); } + else + { header("profile for $input->{username}"); } + menu(); + show_profile($input->{username}); + } + elsif ($input->{c} eq 'form') + { + logout() unless ($loggedin); + header( { + title => "editing $USER->{username}'s profile", + subtitle => qq!view your profile! + } ); + + menu(); + profile_form($USER->{username}); + } + elsif ($input->{c} eq 'update') + { + logout() unless ($loggedin); + my $messages = ''; + if (exists($input->{rmpic}) && $input->{rmpic} == 1) + { + system("rm", "-f", "$data_path/profile/$USER->{username}.jpg"); + system("rm", "-f", "$data_path/profile/.thumb/$AVATAR_PROFILE_PREFIX$USER->{username}.jpg"); + system("rm", "-f", "$data_path/profile/.thumb/$AVATAR_BIG_PREFIX$USER->{username}.jpg"); + system("rm", "-f", "$data_path/profile/.thumb/$AVATAR_MED_PREFIX$USER->{username}.jpg"); + $messages .= "old profile image deleted
\n"; + } + if (exists($input->{pw1}) && exists($input->{pw2}) && $input->{pw1} && $input->{pw2}) + { + if ($input->{pw1} eq $input->{pw2}) + { + update_password($USER->{username}, crypt($input->{pw1},lc($USER->{username}))); + $messages .= qq(password changed -- please log back in
\n); + } + else + { + $messages .= "passwords don't match!
\n"; + } + } + if (exists($input->{stickies})) + { + my $s; + $input->{stickies} =~ s/[^A-Za-z0-9 ]//; + foreach my $k (split / /, $input->{stickies}) + { + next unless ($keywords->{$k}); + $s = add_key($s, lc($k)); + } + $input->{stickies} = $s; + } + if (exists($input->{sink})) + { + my $s; + $input->{sink} =~ s/[^A-Za-z0-9 ]//g; + foreach my $k (split / /, $input->{sink}) + { + next unless ($keywords->{$k}); + $s = add_key($s, lc($k)); + } + $input->{sink} = $s; + } + + my (@boxes) = qw[welcome bPod radio postform hootbox photostream autoplay showhidden nologout]; + my $newboxes = ' '; + foreach my $key (@boxes) + { + if (exists($input->{$key}) && $input->{$key} == 1) + { $newboxes = add_key($newboxes, $key); } + } + if ($USER->{boxes} ne $newboxes) + { + update_user_boxes($USER->{username}, $newboxes); + $USER->{boxes} = $newboxes; + $messages .= "New box settings: $USER->{boxes}
\n" if ($DEBUG); + } + + if ($loggedin && update_profile($USER->{username}, $input)) + { + $USER->{timezone} = $input->{timezone}; + $dateoffset = -1; + $messages .= "profile updated
" + } + if ($loggedin && update_profile_image($USER->{username})) + { + $messages .= "profile image updated
"; + } + + header( { + title => "updating profile...", + subtitle => qq!edit your profile! + } ); + menu(); + print qq(

$messages); + print qq(
); + show_profile($USER->{username}); + } + else + { + logout() unless ($loggedin); + header( { + title => "profile for $USER->{username}", + subtitle => qq!edit your profile! + } ); + menu(); + show_profile($USER->{username}); + } + + footer(); + } + +main(); + +$dbh->disconnect (); + +print "Profile: " . &report_time() . "\n" if $timer; diff --git a/cgi-bin/recipe b/cgi-bin/recipe new file mode 100755 index 0000000..4f134c0 --- /dev/null +++ b/cgi-bin/recipe @@ -0,0 +1,148 @@ +#!/usr/bin/perl + +use localbucky; +use JSON; + +$dbh = DBI->connect ($dsn); + +# our ($USER, $lastlog) = checkin(); +# our $loggedin = ($USER != -1); + +recipe_run(); + +my $VALID_RECIPE_FIELDS = {}; +foreach my $field (qw[ title tags time cost skill servings calories equipment source ]); + { $VALID_RECIPE_FIELDS->{$field} = 1; } + +sub recipe_run + { + our ($t, $kw, $files, $comments) = recipe_init(); + + my $recipe; + my $title = $t->{'title'}; + + FIND_RECIPE: + { + foreach my $comment (@$comments) + { + $recipe = parse_comment_into_recipe($comment, $title); + if (is_valid_recipe_object($recipe) + { + last FIND_RECIPE; + } + } + print "Content-type: text/plain\n\n"; + print "No recipe found!" + exit; + } + + my ($many_jpgs, $flagged) = find_jpeg_v2($files, $t->{flagged}); + if ($flagged != -1) + { + my $uri = "$live_path/"; + $uri .= $flagged->{thread}; + $uri .= "/.thumb/s."; + $uri .= lc($flagged->{filename}) + $recipe->{'img'} = "https://www.carbonpictures.com$uri"; + } + + my $json = new JSON; + print "Content-type: application/json\n\n"; + print $json->pretty->encode($recipe); + } + +sub recipe_init + { + $input->{id} ||= $input->{object_from_uri} if defined($input->{object_from_uri}); + my $id = exists($input->{id}) ? $input->{id} : error("No such thread!"); + + my $t = get_thread($id); + error("No such post.") if ($t == -1); + my $kw = get_keyword($t->{keyword}); + + my $files = get_files($t->{id}); + my $comments = get_comments ($t->{id}); + + if ( ! check_privacy($t, $kw) ) # || check_participation($files, $comments) ) + #unless ( check_privacy($t, $kw) || check_participation($files, $comments) ) + { error("No such post!"); } + + return ($t, $kw, $files, $comments); + } + +sub is_valid_recipe_object + { + my ($recipe) = @_; + if ( exists($recipe->{'ingredients'}) && exists($recipe->{'directions'}) ) + { return 1; } + else + { return 0; } + } +sub parse_comment_into_recipe + { + my ($comment, $title) = @_; + my $recipe = {}; + $recipe->{'chef'} = { name => $comment->{'username'} }; + my @lines = split "\n", $comment->{'comment'}; + my $last_line_was_ingredient = 0; + my $last_line_was_direction = 0; + foreach my $line (@lines) + { + chomp $line; + # key/value instruction + if (! length($line) ) + { + $last_line_was_ingredient = 0; + $last_line_was_direction = 0; + next; + } + elsif ($line =~ /: /) + { + my ($key, $value) = split ": ", $line; + if (exists( $VALID_RECIPE_FIELDS->{$key} ) + { $recipe->{$key} = $value; } + } + # direction + elsif ($line =~ /^(\d+\.|\-+|\*+)\s?/ || $last_line_was_direction) + { + my $bullet = $1; + $line =~ s/^$bullet//; + $last_line_was_direction = 1; + $recipe->{'directions'} ||= []; + push @{ $recipe->{'directions'} }, { display => $line }; + } + # ingredient + elsif ($line =~ /^\d/ || $last_line_was_ingredient) + { + $recipe->{'ingredients'} ||= []; + push @{ $recipe->{'ingredients'} }, { display => $line }; + $last_line_was_ingredient = 1; + } + else + { + if (! exists($recipe->{'name'}) && $line !~ /[^A-Z0-9 -]/) + { + $recipe->{'name'} = capitalize($line); + } + elsif (!exists( $recipe->{'ingredients'} )) + { + $recipe->{'notes'} ||= {}; + $recipe->{'notes'}->{'intro'} .= $line; + } + else + { + $recipe->{'directions'} ||= []; + push @{ $recipe->{'directions'} }, { display => $line }; + } + } + } + $recipe->{'name'} ||= $title; + return $recipe; + } +sub capitalize + { + my ($self, $match) = @_; + $match =~ s/([\w']+)/\u\L$1/g; + return $match; + } + diff --git a/cgi-bin/services_f b/cgi-bin/services_f new file mode 100755 index 0000000..ba51e4d --- /dev/null +++ b/cgi-bin/services_f @@ -0,0 +1,83 @@ +#!/usr/bin/perl +######################################### +# services_f +# feeds bPod the file list for a valid thread +######################################### + +use localbucky; + +$dbh = DBI->connect ($dsn); + +our $KWAREZ = $BUCKY_CONFIG->{BPOD_SERVICES_WAREZ_DIR}; + +our ($USER, $lastlog) = checkin(); + +our $logged_in = ($USER != -1); + +# this start/end shit is all broken anyway +#my $start = $input->{s}; +#my $end = $input->{e}; +my $pid = $input->{pid}; + +print "Content-type: text/html\r\n\r\n"; + +my $thread = get_thread( $pid ); +my $keyword = get_keyword( $thread->{keyword} ); +exit unless check_privacy( $thread, $keyword ); + +my $files = get_files( $pid ); + +my $numItems = @$files; + +my $returnString = " &numItems=" . ($numItems ); + +@$files = sort{ lc($a->{filename}) cmp lc($b->{filename}) } @$files; + +my $fileCount = 0; +foreach my $file_row (@$files) + { + $returnString .= "&filetype$fileCount=" . fileEXT($file_row->{filename}); + $returnString .= "&filename$fileCount=" . lc($file_row->{filename}); + $returnString .= "&username$fileCount=" . $file_row->{username}; + $returnString .= "&date$fileCount=" . $file_row->{date}; + $returnString .= "&url$fileCount=" . $KWAREZ . $file_row->{thread} ."/". spaceReplace($file_row->{filename}); + $returnString .= "&size$fileCount=" . sizeinK($file_row->{size}); + $fileCount++; + } +print $returnString ; + +exit; + +sub fileEXT + { + my $filename = shift; + $filename =~ s/.+\.//; + return uc($filename); + } +sub spaceReplace + { + my $filename = shift; + $filename =~ s/\ /\%20/g; + return $filename; + } +sub sizeinK + { + my $bytes = shift; + my $size = $bytes / 1024; + if ( $size < 1024 ) + { + $size = sprintf "%2.2f", $size; + $size .= "k"; + } + elsif ( $size / 1024 < 1024 ) + { + $size = sprintf "%2.2f", $size / 1024; + $size .= "mb"; + } + elsif ( $size / 1024 / 1024 < 1024 ) + { + $size = sprintf "%2.2f", $size / 1024 / 1024; + $size .= " GB"; + } + return $size; + } diff --git a/cgi-bin/services_k b/cgi-bin/services_k new file mode 100755 index 0000000..3ce9940 --- /dev/null +++ b/cgi-bin/services_k @@ -0,0 +1,62 @@ +#!/usr/bin/perl +######################################### +# services_k +# feeds bPod the keyword list for logged in user +######################################### + +use localbucky; + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); + +our $logged_in = ($USER != -1); + +our $TAGS = [ 'Docks', 'Dings', 'Mexico', 'France', 'Breakfast', 'Baked', 'Sandwich' ]; + +# this start/end shit is all broken anyway +#my $start = $input->{s}; +#my $end = $input->{e}; + +my $keywords_hashref = get_keywords(); +my $keywords_arrayref = []; + +print "Content-type: text/html\r\n\r\n"; +foreach my $keyword (keys(%$keywords_hashref)) + { + my $k = $keywords_hashref->{$keyword}; + push ( @$keywords_arrayref, $keyword ) if (check_keyword($k)); + } + +my $numItems = @$keywords_arrayref; + +my $returnString = " &numItems=" . ($numItems ); +#$returnString = "duhhh"; + +@$keywords_arrayref = sort{ lc($a) cmp lc($b) } @$keywords_arrayref; + +my $keywordCount = 0; +foreach my $keyword (@$keywords_arrayref) + { + $returnString .= "&keyword$keywordCount=$keyword"; + my $color = $keywords_hashref->{$keyword}->{color} || "plain"; + $returnString .= "&color$keywordCount=$color"; + $keywordCount++; + } + +#@$tags_arrayref = sort{ $a cmp $b } @$TAGS; +my $tags_arrayref = get_tag_names(); +@$tags_arrayref = sort{ lc($a) cmp lc($b) } @$tags_arrayref; +my $numTags = @$tags_arrayref; + +$returnString .= "&numTags=" . $numTags; + +my $tagCount = 0; +foreach my $tag (@$tags_arrayref) + { + $returnString .= "&tag$tagCount=$tag"; + $tagCount++; + } + +print $returnString ; +exit(0); diff --git a/cgi-bin/services_th b/cgi-bin/services_th new file mode 100755 index 0000000..6e2bb67 --- /dev/null +++ b/cgi-bin/services_th @@ -0,0 +1,54 @@ +#!/usr/bin/perl +######################################### +# services_th +# feeds bPod the keyword list for logged in user +######################################### + +use localbucky; + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); + +our $logged_in = ($USER != -1); + +print "Content-type: text/html\r\n\r\n"; + +my $threads; + +my $kws = {}; +my $keyword = $input->{k}; +if ($keyword =~ /^tag_/) + { + $keyword =~ s/^tag_//; + $threads = get_threads_by_tag( $keyword ); + $kws = get_keywords(); + } +else + { + $kws->{$keyword} = get_keyword($keyword); + $threads = get_threads_by_keyword( $keyword ); + } + +my $threads_allowed = []; +foreach my $thread (@$threads) + { + push ( @$threads_allowed, $thread ) if (check_privacy( $thread, $kws->{$thread->{keyword}} ) > 0); + } + +my $numItems = @$threads_allowed; + +my $returnString = " &numItems=" . ($numItems ); + +@$threads_allowed = sort{ lc($b->{title}) cmp lc($a->{title}) } @$threads_allowed; + +my $threadCount = $numItems - 1; +foreach my $thread (@$threads_allowed) + { + $returnString .= "&title$threadCount=" . $thread->{title}; + $returnString .= "&user$threadCount=" . $thread->{username}; + $returnString .= "&id$threadCount=" . $thread->{id}; + $threadCount--; + } +print $returnString ; +exit; diff --git a/cgi-bin/settings b/cgi-bin/settings new file mode 100644 index 0000000..e2b3b1f --- /dev/null +++ b/cgi-bin/settings @@ -0,0 +1,24 @@ +#!/usr/bin/perl + +use localbucky; + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); +our $loggedin = ($USER != -1); + +#nice_redirect() if ($USER->{ulevel} != 3); + +header("bucky spritz tester", qq(roll back adminzz) ); +menu(); +my $id = exists($input->{id}) ? $input->{id} : 165; +my $thread = get_thread($id); +my $keyword = get_keyword($thread->{keyword}); +my $files = get_files($id); +print qq(
); +find_jpeg($files, $thread->{flagged}); +sideshow_comments($thread, $keyword); +reply_form($thread->{id}, $thread); +print qq(
); +footer(); + diff --git a/cgi-bin/tag b/cgi-bin/tag new file mode 100755 index 0000000..6af4520 --- /dev/null +++ b/cgi-bin/tag @@ -0,0 +1,290 @@ +#!/usr/bin/perl +######################################### +# index +# - do all index stuff, also deal with keyword admin +######################################### + +use localbucky; + +$dbh = DBI->connect ($dsn); + +our ($USER, $lastlog) = checkin(); + +my $k; +my $tag; + +# check name of the calling script: index, tag, keyword +$input->{script} ||= $input->{script_from_uri} if defined($input->{script_from_uri}); + +# load the tag or keyword into the input params, if they don't exit already +if ( $input->{script} eq $BUCKY_LEXICON_TAG ) + { + $input->{tag} ||= $input->{object_from_uri} if defined($input->{object_from_uri}); + } +elsif ( $input->{script} eq $BUCKY_LEXICON_KEYWORD ) + { + $input->{keyword} ||= $input->{object_from_uri} if defined($input->{object_from_uri}); + } + +# Get keyword +if (exists($input->{keyword}) && $input->{keyword} ne "new" && $input->{keyword} ne "unsorted") + { + $k = get_keyword($input->{keyword}); + } + + +# Create New Keyword? FORM +if (exists($input->{keyword}) && $input->{keyword} eq "new") + { + my $t; + header("add new category"); + if (exists($input->{thread})) + { + $t = get_thread($input->{thread}); + } + menu(); + print "

"; + my %faek = + ( + keyword => $input->{keyword}, + thread => $input->{thread} + ); + keyword_form($input->{keyword}, \%faek, $t); + footer(); + } + +# Edit settings for keyword +elsif ($input->{c} eq "edit" && (check_op($k) || $USER->{ulevel} == 3)) + { + header( + { + title => "settings for category '$input->{keyword}'", + sticky => $input->{keyword} + } ); + # 20070903 - marc - new menu args calling style + my $menu_args; + $menu_args->{keywords} = $k if $k; + menu( $menu_args ); +# menu($k); + print "

"; + + keyword_form($k->{keyword}, $k); + + print qq!
!; + my $threads = get_threads_by_keyword($k->{keyword}); + thread_box({ threads => $threads, kw => $k }); + + print qq!
!; + footer(); + } + +# Create new keyword? Process form results +elsif ($input->{c} eq "create") + { + if (!defined($input->{keyword})) + { error("no keyword specified!"); } + if (get_keyword($input->{keyword}) != -1) + { error("keyword already exists!"); } + my %nk = + ( + keyword => $input->{keyword}, + threads => " $input->{thread} ", + owner => $USER->{username}, + public => $input->{public}, + agglutinate => $input->{agglutinate}, + color => $input->{color}, + ops => (make_whitelist()) + ); + if ($DEBUG) + { + header("Creating keyword $input->{keyword}"); + menu(); + foreach my $ky (keys %nk) + { print "$ky => $nk{$ky}
\n"; } + } + add_keyword(\%nk); + update_thread_keyword($input->{thread}, $input->{keyword}); + redirect("$BUCKY/$BUCKY_LEXICON_KEYWORD/$input->{keyword}"); + } + +# Edit settings for keyword? Process form results +elsif ($input->{c} eq "update") + { + if (!defined($input->{keyword})) + { error("no keyword specified!"); } + my %nk = + ( + threads => " $input->{thread} ", + public => (exists($input->{public}) ? 1 : 0), + agglutinate => (exists($input->{agglutinate})) ? $input->{agglutinate} : 0, + color => $input->{color} + ); + if (!exists($input->{public})) + { + $nk{ops} = make_whitelist(); + } + if ($DEBUG) + { + header("Updating keyword $input->{keyword}"); + menu(); + foreach my $ky (keys %nk) + { print "$ky => $nk{$ky}
\n"; } + } + update_keyword($input->{keyword}, \%nk); + redirect("$BUCKY/$BUCKY_LEXICON_KEYWORD/$input->{keyword}"); + } + +# Assign keyword processing form action +elsif ($input->{c} eq "assign") + { + keyword_assign_mechanism($input->{keyword}, $input->{thread}, $k); + redirect("$BUCKY/maintain/$input->{thread}"); + # redirect("$BUCKY/index?keyword=$input->{keyword}"); + } + +# Detach keyword action +elsif ($input->{c} eq "detach") + { + my $t; + + if (!defined($input->{thread})) + { error("no post specified!"); } + $t = get_thread($input->{thread}); + $k = get_keyword($t->{keyword}); + + my %nk = ( threads => delete_key($k->{threads}, $input->{thread}) ); + + if ($DEBUG) + { + header("Detaching post from $t->{keyword}"); + menu(); + foreach my $ky (keys %nk) + { print "$ky => $nk{$ky}
\n"; } + print "keyword ==> $t->{keyword}
\n"; + print "detaching $t->{title} from $t->{keyword}
\n"; + } + update_keyword($t->{keyword}, \%nk); + update_thread_keyword($t->{id}, "NULL"); + redirect("$BUCKY/maintain/$t->{id}"); + } + +# Display main index page +else + { + my $tag = exists($input->{tag}) ? $input->{tag} : undef; + my $keyword = exists($input->{keyword}) ? $input->{keyword} : "all"; + my $limit = exists($input->{limit}) ? int($input->{limit}) : 40; + my $date = exists($input->{start}) ? int($input->{start}) : "now"; + + header({ title => get_random_line("titles"), sticky => $input->{keyword} }); + my $keywords = get_keywords(); + my $tags = get_tags(); + + my $menu_args; + $menu_args->{keywords} = $keywords->{$keyword} if $keywords->{$keyword}; + menu( $menu_args ); + + print qq(); + print qq(); +############################# +# KEYWORD LIST + print qq(\n); + + print qq(); + } + else + { + welcome_box() if (check_key($USER->{boxes}, "welcome")); + bPod_box() if (check_key($USER->{boxes}, "bPod")); + radio_box() if (check_key($USER->{boxes}, "radio")); + upload_form($keyword) if (check_key($USER->{boxes}, "postform")); + hoot_box() if (check_key($USER->{boxes}, "hootbox")); + } + + print qq(\n); + print qq(); + print qq(
\n); + print qq(
); + my $p = ''; my $l = ''; + my $with_letter = 0; + my $s = ''; +my $pre = ''; + my $start = ''; + foreach my $k (sort { lc($a) cmp lc($b) } keys %$keywords) + { + my $style; + $l = substr($k,0,1); + $start ||= $l; + if ($p && lc($l) ne lc($p)) + { + if ($with_letter > 3) + { + print qq($start - $pre
); + print $s; + print qq(
); + print qq(
); + $s = ''; + $with_letter = 1; + $p=''; + $start = $l; + } + } + $with_letter += 1; + $p||=$l; + $pre=$l; + $s .= qq($k
); + } +if ($s) + { + print qq($start - $pre
); + print $s; + print qq(
); + print qq(
); + } + print qq(
); + print qq(
); + print qq(.: unsorted :.
); + print qq(
\n); + + alerts(); + if ($USER == -1) + { + bPod_box(); + print qq(
\n); + + if (check_key($USER->{boxes}, "photostream") || ($USER == -1) ) + { + if ( $keyword ne "all" ) + { photostream({ keyword => $keyword, vertical => 0, count => 4 }); } + elsif ( $tag ) + { photostream({ tag => $tag, vertical => 0, count => 4 }); } + else + { photostream({ user => 1, vertical => 0, count => 4 }); } + } + + print qq(
); + + if ($keyword ne "all") + { + my $threads = throttle_threads({ keyword => $keyword, newest => $date }); + thread_box({ threads => $threads, kw => $keywords->{$keyword} }); + } + elsif ($tag) + { + my $threads = throttle_threads({ tag => $tag, newest => $date }); + thread_box({ threads => $threads, tag => $tags->{$tag} }); + } + else + { + alpha_index($keywords, $limit, $date); + } + + print qq(
); + print qq(
\n\n); + + footer(); + } + +$dbh->disconnect (); + +print "Index: " . &report_time() . "\n" if $timer; diff --git a/cgi-bin/users b/cgi-bin/users new file mode 100755 index 0000000..b82a823 --- /dev/null +++ b/cgi-bin/users @@ -0,0 +1,228 @@ +#!/usr/bin/perl +######################################### +# display userlist +######################################### + +use localbucky; +use invite; + +$dbh = DBI->connect ($dsn); + +($USER, $lastlog) = checkin(); +logout() if ($USER == -1); + + my $users = get_all_users(); + my $keywords = get_keywords(); + + header( $BUCKY_CONFIG->{USERLIST_TITLE} ); + menu(); + + our $command = -1; + + print qq(); + print qq(\n
\n); + + display_user_list($users); + + print qq(\n); + + invite_result_box($command, $hash, $result) if ($command != -1); + invite_create_box() if ($USER->{'ulevel'} > 1); + grass_box($users); + + print qq(
\n\n); + + footer(); + +sub grass_box + { + my ($users) = @_; + print qq(
); + print qq(newest users\n); + my $i = 0; + print ""; + foreach my $duder (sort_by_firstseen(@$users)) + { + next if ($duder->{ulevel} < 1); + next if ($duder->{firstseen} == 0); + my $z_date = verbosedate($duder->{firstseen}); + my $z_user = $duder->{username}; + my $z_grass = $duder->{grass}; + print qq(); + print qq(); + print qq(); + print qq(); + print qq(); + if (length($z_grass)) + { + print qq(); + print qq(); + print qq(); + } + last if (++$i == 20); + } + print qq(
\n
$z_user$z_date
); + print "$z_grass"; + print qq(
\n); + print qq(
\n); + } + +sub display_user_list + { + my ($users) = @_; + print qq[]; + print qq[\n]; + print qq(\n); +print <  + + + + +userrows + # print qq(\n) if ($USER->{ulevel} == 3); + print "\n"; + + my $r = 0; + my $i = 0; + my $today = 0; + my $neg = 0; + my $show_all = (exists($input->{showall})) ? 1 : 0; + + foreach my $duder (sort_by_username(@$users)) + { + next if ($duder->{ulevel} < 1); + my $vanished = + ( + $duder->{ccount} < 1 + && $duder->{fcount} < 1 + && (time - $duder->{lastseen}) > 14*24*3600 + ); + if ($vanished && !$show_all) + { + $neg++; + next; + } + print qq[]; + print_blank_cell(qq(profile · send message ·), "right", "blank"); + + my $image = get_profile_image($duder->{username}, $AVATAR_MED_PREFIX); + if ($image != -1) + { + my $av .= + qq(). + qq(). + qq(); + print_user_cell($av); + } + else + { + print_user_cell(qq()); + } + + if ($duder->{ulevel} > 1 && $USER->{ulevel} == 3 && $show_all) + { + print_user_cell("· ".$duder->{username}); + } + elsif ($vanished) + { + print_user_cell("".$duder->{username}.""); + } + else + { + $duder->{username} =~ s/\n/
/g; + print_user_cell($duder->{username}); + } + + $duder->{realname} =~ s/\s/ /g; + if ($vanished) + { print_user_cell("".$duder->{realname}.""); } + else + { print_user_cell($duder->{realname}); } + + my $col = carbondate($duder->{lastseen}, 0); + $today++ if ($col eq "new"); + if ($vanished) + { + print_user_cell(qq!!.(get_age($duder->{lastseen})).qq! ago!, "right"); + } + else + { + print_user_cell(qq!!.(get_age($duder->{lastseen})).qq!!, "right"); + } + + if ($USER->{ulevel} == 3) + { + if ($duder->{ccount} == 0) + { print_user_cell(" "); } + else + { print_user_cell(" ".hushnull($duder->{ccount}, "c", 1)."", "right"); } + + if ($duder->{fcount} == 0) + { print_user_cell(" "); } + else + { print_user_cell(" ".hushnull($duder->{fcount}, "f", 1)." ", "right"); } + } + + my $cell = ''; + foreach my $sticky (split_keys($duder->{stickies})) + { + my $key = $keywords->{$sticky}; + if ($key->{owner} eq $USER->{username} || check_op($key) || $USER->{ulevel} == 3) + { + $cell .= qq($sticky, ); + } + } + $cell =~ s/, $//; + print_user_cell($cell); + + print qq[]; + $r = $r ? 0 : 1; + $i++; + } + + print qq(\n); + print < +approvefoot + } + +sub print_user_cell + { + my ($v, $align) = @_; + my ($lpx, $rpx) = ("4px", "2px"); + ($lpx, $rpx) = ("2px", "4px") if ($align eq "right"); + $align = "left" unless ($align); + print qq[]; + } + +sub print_blank_cell + { + my ($v) = @_; + print qq[]; + } + +sub print_sinks + { + $cell = ' '; + foreach my $sticky (split_keys($duder->{sink})) + { + my $key = $keywords->{$sticky}; + if ($key->{owner} eq $USER->{username} || check_op($key) || $USER->{ulevel} == 3) + { + $cell .= qq($sticky, ); + } + } + $cell =~ s/, $//; + print_user_cell($cell); + } + +sub sort_by_username { sort { uc($a->{username}) cmp uc($b->{username}) } @_; } +sub sort_by_firstseen { sort { uc($b->{firstseen}) <=> uc($a->{firstseen}) } @_; } + +$dbh->disconnect (); +print "Users: " . &report_time() . "\n" if $timer; + diff --git a/lib/Bucky1.pm b/lib/Bucky1.pm new file mode 100644 index 0000000..9ab2719 --- /dev/null +++ b/lib/Bucky1.pm @@ -0,0 +1,53 @@ +#!/usr/bin/perl +#use localbucky; + +# always used, for the most part +use db; +use getargs; +use cookies; +use lastlog; +use session; +use rand; +use privacy; +use keywords; +use headers; +use images; +use format; +use constants; + +# more general and can probably be added selectively somehow +use boxes; +use color; +use comments; +use files; +use forms; +use import; +use message; +use profile; +use radio; +use tags; +use threads; + +use RGB; + +our @BUCKY_INPUT_DELIMITERS = qw(\, \= \_ \+ \| \.); +sub scrub + { + my $string = shift; + $string =~ s/\0//g; + $string =~ s/\n//g; + $string =~ s/\r//g; + $string =~ s/\%//g; + $string =~ s/\*//g; + return trim($string); + } +sub trim + { + my $string = shift; + $string =~ s/^\s+//; + $string =~ s/\s+$//; + return $string; + } + +1; + diff --git a/lib/RGB.pm b/lib/RGB.pm new file mode 100644 index 0000000..70bb10f --- /dev/null +++ b/lib/RGB.pm @@ -0,0 +1,151 @@ +package RGB; +use strict; + +sub new + { + my ($class, $input) = @_; + my $self = {}; + $self->{RGB} = []; + bless($self); + $self->init($input); + return $self; + } + +sub init + { + my ($self, $input) = @_; + if ($input =~ /^\#/) + { $self->hex($input); } + else + { $self->rgb($input); } + } + +sub hex + { + my ($self, $hex) = @_; + if ($hex) + { + $self->{RGB} = hex_to_rgb($hex); + } + return rgb_to_hex($self->{RGB}); + } + +sub rgb + { + my ($self, $rgb) = @_; + if (ref($rgb) eq "ARRAY") + { + $self->{RGB} = $rgb; + } + return $self->{RGB}; + } + +sub hex_to_rgb + { + my ($hex) = @_; + $hex =~ s/^\#//; + my ($r, $g, $b); + + if (length($hex) == 6) + { + $r = hex(substr($hex, 0, 2)); + $g = hex(substr($hex, 2, 2)); + $b = hex(substr($hex, 4, 2)); + } + elsif (length($hex) == 3) + { + $r = hex(substr($hex, 0, 1) x 2); + $g = hex(substr($hex, 1, 1) x 2); + $b = hex(substr($hex, 2, 1) x 2); + } + return [$r, $g, $b]; + } + +sub rgb_to_hex + { + my ($rgb) = @_; + for (my $i = 0; $i < 3; $i++) + { + $rgb->[$i] = 255 if $rgb->[$i] > 255; + $rgb->[$i] = 0 if $rgb->[$i] < 0; + } + return sprintf ("#%02X%02X%02X", @{$rgb}); + } + +sub display_rgb + { + my ($self) = @_; + my $out = join ", ", map {int $_} @{ $self->{RGB} }; + $out = "rgb(".$out.")"; + return $out; + } + +sub display_hex + { + my ($self) = @_; + return $self->hex(); + } + +sub add + { + my ($self, $fuzz) = @_; + $fuzz = parse_fuzz($fuzz); + for (my $i = 0; $i < 3; $i++) + { $self->{RGB}->[$i] += $fuzz->[$i]; } + } + +sub mollify + { + my ($self, $fuzz) = @_; + $fuzz = parse_fuzz($fuzz); + for (my $i = 0; $i < 3; $i++) + { + my $offset = int( rand($fuzz->[$i] + 1) ); + $self->{RGB}->[$i] += $offset; + } + } + +sub perturb + { + my ($self, $fuzz) = @_; + $fuzz = parse_fuzz($fuzz); + for (my $i = 0; $i < 3; $i++) + { + my $offset = int( rand($fuzz->[$i] + 1) - ( $fuzz->[$i] / 2 ) ); + $self->{RGB}->[$i] += $offset; + } + } + +sub parse_fuzz + { + my ($fuzz) = @_; + if (ref($fuzz) eq "RGB") + { $fuzz = $fuzz->rgb(); } + elsif (ref($fuzz) eq "ARRAY") + { } + else + { $fuzz = [$fuzz, $fuzz, $fuzz]; } + return $fuzz; + } + +sub clip + { + my ($self) = @_; + for (my $i = 0; $i < 3; $i++) + { + $self->{RGB}->[$i] = 255 if $self->{RGB}->[$i] > 255; + $self->{RGB}->[$i] = 0 if $self->{RGB}->[$i] < 0; + } + } + +sub rgb_map + { + my ($self, $func, $a, $b) = @_; + my ($ra) = $a->rgb(); + my ($rb) = $b->rgb(); + my (@rgb) = map { &{$func}($ra->[$_], $rb->[$_]) } 0,1,2; + return RGB->new(\@rgb); + } + +1; + diff --git a/lib/boxes.pm b/lib/boxes.pm new file mode 100644 index 0000000..8c29644 --- /dev/null +++ b/lib/boxes.pm @@ -0,0 +1,165 @@ +# infoboxes!!!!!!!!!!!! + +our $BPOD_COLOR_UI_GRADIENT_1 = "0xF8F8D7"; +our $BPOD_COLOR_UI_GRADIENT_2 = "0xF0F0E6"; +our $BPOD_COLOR_UI_STROKE = "0x000000"; + +my $DEBUG_FORM_STRING = $DEBUG ? qq() : ''; + +use RGB; + +sub alerts + { + my $newmsg = count_new_messages($USER->{username}); + if ($newmsg > 0) + { + my $s = courtesy_s($newmsg); + alert_box("$BUCKY/inbox", "You have $newmsg new message$s!"); + } + } + +sub alert_box + { + my ($url, $msg) = @_; + print qq(
\n); + print qq(
); + print $msg; + print qq(

); + print qq(
\n); + } + +sub welcome_box + { + my ($files, $size) = count_user_files($USER->{username}); + print qq(
\n); + print qq($BUCKY_LOGIN_WELCOME
\n); + print qq(you are using ),hushsize($size,2),qq( in $files files); + print qq(
\n); + } +sub search_box + { + print <<__SEARCH__; +
+
 usernamerealnameidle  
) . + qq(total: $i users \($today seen today); + print qq(, $neg vanished) if (!$show_all && $USER->{ulevel} > 2); + print qq(\) 
$v$v
+ +$DEBUG_FORM_STRING +
+ + +
+ + + +
+
+ + +__SEARCH__ + } +sub bPod_box + { + my ($color) = @_; + $color = get_color_from_time() || "plain"; + $color = $COLORS{$color} if exists $COLORS{$color}; + my $rgb = RGB->new($color); + $rgb->perturb([4,4,8]); + my $gradient1 = $rgb->hex(); + $rgb->add(nighttime_quotient()); + my $background = $rgb->hex(); + $gradient1 =~ s/^\#/0x/; + $BPOD_COLOR_UI_GRADIENT_1 = $gradient1; # "0xF8F8D7"; + print < +
+ + + +bPod + } + +sub radio_box + { + my $radio = get_radio_info(); + + if ($radio == -1) + { + #return; + print qq!
\n!; + print qq[RADIO: GOING DARK
\n]; + print qq!click here for broadcast instructions\n!; + print qq!
\n!; + } + else + { + print qq!
\n!; + print qq!$radio->{station}
\n!; + print qq!$radio->{nowplaying}
\n!; + print qq!$radio->{tunein}\n!; + print qq!
\n!; + } + } + +sub hoot_box + { + my $hoot = uc( get_random_line("hoots") ); +print qq(
\n); + print qq(
); + print qq(\n) if ($DEBUG); +print qq(); + print < + +END + #
+ my $comments = get_comments(1, 15); + sideshow_comments({ comments => $comments, thread => -1, keyword => -1, noreply => 1, hootbox => 1, order => "asc", shorturl => 1 }); +print "
+ + + + + +
+ + + +
+ +
"; +print <<__DUH__; +
~>{ GLIMPSE THE PAST }<~ +__DUH__ + print qq!
!; + } +sub svn_box + { + use lib "../../bucky2/lib"; + use Bucky::SVN; + my $svn = new Bucky::SVN; + print $svn->query_list; + } + +1; + diff --git a/lib/color.pm b/lib/color.pm new file mode 100644 index 0000000..2947481 --- /dev/null +++ b/lib/color.pm @@ -0,0 +1,117 @@ + +# COLOR SETTINGS + +use RGB; + +sub is_color + { + my ($plaid) = @_; + return exists($COLORS{$plaid}); + } + +sub color_dropdown + { + my ($selected, $quick) = @_; + $selected = 'plain' if (!defined($selected)); + $quick = '0' if (!defined($quick)); + print qq!\n!; + } + +sub get_color + { + my ($t, $k, $row) = @_; + print qq! $t->{id}(color) = $t->{color}, $k->{color}
! if ($DEBUG); + + if (ref($row) eq "HASH") + { + my $comments = $row; + my $color = find_comments_color($row); + return $color if $color; + } + elsif (defined($row) && $row > 0) + { + if ($t->{color} && $t->{color} ne "plain") + { return $t->{color}; } + elsif ($k->{color} && $k->{color} ne "plain") + { return $k->{color}; } + elsif (!length($t->{keyword})) + { return $BUCKY_UNSORTED_COLOR; } + else + { return $BUCKY_DEFAULT_COLOR; } + } + if ($t != -1 && $t->{color}) + { return $t->{color} if ($t->{color} ne "plain"); } + if ($k != -1 && $k->{color}) + { return $k->{color}; } + return "plain"; + } + +sub find_comments_color + { + my ($comments) = @_; + foreach my $comment (values %$comments) + { + # if ($message->{'body'} =~ /body bgcolor="?([#0-9a-fA-F]+)/) + if ($comment->{'comment'} =~ /(body bgcolor="|background-color: )#?([0-9a-fA-F]+)/) + { + print "1" if $DEBUG; + my $color = $2; + return "#" . $color; + } + } + return undef; + } +sub nighttime_quotient + { + my $nighttime_quotient = -30; + my $date = time + get_tz_offset(); # if ($dateoffset == -1); + my $x; + my ($m,$h,$d,$n,$y) = (localtime $date)[1..5]; + if ($h < 5 || $h > 23) + { return $nighttime_quotient; } + if ($h >= 5 && $h <= 7) + { $x = 60*60*3 - 60 * ($h - 5) + $m; } + if ($h >= 21 && $h <= 23) + { $x = 60 * ($h - 21) + $m; } + $x /= 60*60*3; + return $nighttime_quotient * $x; + } + +sub get_color_from_time + { + my ($date) = @_; + $date = time; + my $offset = get_tz_offset(); # if ($dateoffset == -1); + $date += $offset; + my ($m,$h,$d,$n,$y) = (localtime $date)[1..5]; + if (($h == 4 || $h == 16) && $m == 20) + { $c = "green"; } + elsif ($h < 5) + { $c = "purple"; } + elsif ($h >= 5 && $h < 6) + { $c = "red"; } + elsif ($h >= 6 && $h < 9) + { $c = "orange"; } + elsif ($h >= 9 && $h < 12) + { $c = "yellow"; } + elsif ($h >= 12 && $h < 18) + { $c = "plain"; } + elsif ($h >= 18 && $h < 21) + { $c = "blue"; } + elsif ($h >= 21) + { $c = "purple"; } + else + { $c = "plain"; } + return $c; + } + +1; diff --git a/lib/comments.pm b/lib/comments.pm new file mode 100644 index 0000000..1ccd469 --- /dev/null +++ b/lib/comments.pm @@ -0,0 +1,287 @@ + +sub sideshow_comments + { +# my ($thread, $keyword, $comments, $order) = @_; + my ($hash) = @_; +# print "YO COMMENTS WILL BE WORKING IN A SEC DUDES
"; + $thread = $hash->{'thread'}; + $keyword = $hash->{'keyword'}; + $comments = $hash->{'comments'}; + $order = $hash->{'order'}; + + return unless $comments; + + $shorturl = 0 unless (defined($shorturl)); + $color = get_color($thread, $keyword); + my %c; + my $shorturl = check_key($thread->{display}, "shorturl"); + my $r = 0; + + my @sorted; + if ($order && $order eq "asc") + { + @sorted = sort { $b <=> $a } (keys %$comments); + } + else + { + @sorted = sort { $a <=> $b } (keys %$comments); + } + my @basis = (); + my $firstpost = 1; + my $lastpost = undef; + my %tree; + +print qq(); + print qq();# unless ($hash->{'hootbox'}); + $lastpost = undef; + foreach my $id (@sorted) + { + my $comment = $comments->{$id}; + # hide hidden comments from non-oper + if ($comment->{parent_id} != -1) + { push @{$tree{$comment->{parent_id}}}, $id; } + else + { push @basis, $comment; $lastpost = $comment->{id}; } + } + + my $args = $hash || {}; + $args->{thread} ||= $thread; + $args->{keyword} ||= $keyword; + $args->{shorturl} ||= $shorturl; + $args->{noreply} ||= 0; + + $args->{comment} = undef; + $args->{firstpost} = $firstpost; + $args->{lastpost} = 0; + $args->{r} = $sorted[0]->{id} % 2 ? "0" : "1"; + + foreach my $id (@sorted) + { + my $c = $comments->{$id}; + next if ($c->{parent_id} != -1); + next if hiding_hidden_posts($c); + + $args->{r} = $args->{r} ? "0" : "1"; + $args->{comment} = $c; + $args->{noreply} = exists($tree{$id}); + $args->{firstpost} = $firstpost; + if (display_comment($args)) + { $firstpost = 0; } + + if (exists($tree{$id})) + { + $firstpost = 1; + my $tail = $tree{$id}; + my $tailend = $tail->[-1]; + print qq(); + print qq(\n); + print qq(\n); + foreach my $subcomment_id ( @$tail ) + { + my $c = $comments->{$subcomment_id}; + next if hiding_hidden_posts($c); + $r = $r ? "0" : "1"; + $args->{r} = $args->{r} ? "0" : "1"; + $args->{comment} = $c; + $args->{noreply} = $subcomment_id != $tailend; + $args->{lastpost} = $subcomment_id == $tailend && $lastpost != $id; + display_subcomment($args); + } + print qq(
\n\n\n); + } + } + } + +sub hiding_hidden_posts + { + my ($c) = @_; + if ($c->{'hidden'} != 1) + { return 0; } + if ( $USER->{'ulevel'} == 3 && check_key($USER->{boxes}, "showhidden") ) + { return 0; } + return 1; + } + +sub display_comment + { + my ($args) = @_; + + my ($t) = $args->{thread} || -1; + my ($c) = $args->{comment} || -1; + + return 0 if ($c->{comment} eq undef); + + my $z_r = exists($args->{r}) ? $args->{r} : undef; + my $z_id = $c->{id}; + my $z_date = verbosedate($c->{date}); + my $z_age = get_age($c->{date}); +# $z_age .= " ago" unless $age eq "now"; + my $z_user = $c->{username}; + my $z_profile = qq($BUCKY/profile/$z_user); + my $z_comment = linebr($c->{comment}, $args->{shorturl}); + my $z_br = $z_comment =~ /
/ ? undef : "

"; + my $z_options = ($USER != -1) ? display_comment_options($args) : " "; + $z_options .= " ($z_id)" if $DEBUG; + + if ($args->{'hootbox'}) + { + my $z_width = $AVATAR_MED_WIDTH; + my $z_image = get_profile_image($c->{username}, $AVATAR_MED_PREFIX); + print qq(); + +print qq(); + if ($z_image != -1) + { +print qq(); + } +print qq(); + + print qq(); + print qq(">); + print qq(); + print qq(); +# print qq(); + print qq(); + print qq(); + print qq(
$z_comment
$z_age 
$z_comment
); + print qq(); + +# print qq(); +# print qq($z_user
$z_age); +## print qq($z_user); +# print qq(); +## print qq(); +## print qq($z_age); +## print qq(); +# print qq(); + } + else + { + my $z_width = $AVATAR_BIG_WIDTH; + my $z_image = get_profile_image($c->{username}, $AVATAR_BIG_PREFIX); + print qq(); + print qq(); + if ($z_image != -1) + { print qq(); } + print qq($z_user); + print qq(); + print qq(); + print qq(); + print qq(); + print qq(); + print qq(); + print qq(); + print qq(); + print qq(); + print qq(); + print qq(
$z_comment$z_br
$z_options$z_date
); + print qq(); + } + + return 1; + } + +sub display_subcomment + { + my ($args) = @_; + + my ($t) = $args->{thread} || -1; + my ($c) = $args->{comment} || -1; + + return 0 if ($c->{comment} eq undef); + + my $z_r = exists($args->{r}) ? $args->{r} : undef; + my $z_date = verbosedate($c->{date}); + my $z_age = get_age($c->{date}); + $z_age .= " ago" unless $age eq "now"; + my $z_user = $c->{username}; + my $z_profile = qq($BUCKY/profile/$z_user); + my $z_comment = linebr($c->{comment}, $args->{shorturl}); + my $z_width = $AVATAR_MED_WIDTH; + my $z_image = get_profile_image($c->{username}, $AVATAR_MED_PREFIX); + my $z_options = ($USER != -1) ? display_comment_options($args) : " "; + $z_options .= " ($z_id)" if $DEBUG; + + print qq(); + + if ($z_image != -1) + { + print qq(); + print qq(
); + print qq($z_user); + print qq(); + } + else + { + print qq( ); + print qq($z_user); + print qq(); + } + + print qq(); + print qq(); + print qq(); + print qq(); + print qq(); + print qq(); + print qq(); + print qq(); + print qq(); + print qq(
$z_comment
$z_options$z_date
); + print qq(); + + return 1; + } + +sub display_comment_options + { + my ($args) = @_; + + my ($thread) = $args->{thread} || -1; + my ($keyword) = $args->{keyword} || -1; + my ($c) = $args->{comment} || -1; + + my $out = ""; + my $age = time - $c->{date}; + my $z_id = $c->{id}; + my $z_link = qq($BUCKY/comment/$z_id); + + if ($c->{username} eq $USER->{username} || $USER->{ulevel} == 3 || + (check_key($thread->{display}, "editable") && check_privacy($thread, $keyword))) + { + $out .= qq(); + $out .= $age < 86400 ? + qq(edit) + : qq(edit); + $out .= middot(); + $out .= qq(remove); + $out .= middot(); + $out .= qq(reply); + $out .= qq(); + } + else + { + $out .= qq(reply); + } + } + +1; diff --git a/lib/constants.pm b/lib/constants.pm new file mode 100644 index 0000000..129a9fa --- /dev/null +++ b/lib/constants.pm @@ -0,0 +1,82 @@ +#our $BUCKY_CONFIG_FTP_ENABLED = 1; +our $BUCKY_CONFIG = + { + 'FTP_ENABLED' => 1, + 'PRIVACY_WORLD' => 'bucky only', + 'PRIVACY_BBS' => undef, + 'PRIVACY_KEYWORD' => undef, + 'PRIVACY_OWNER' => 'private', + 'BASE_PATH' => '/var/www/vhosts/carbonpictures.com/bucky/', + 'BPOD_SERVICES_WAREZ_DIR' => 'https://www.carbonpictures.com/bucky/data/', + 'USERLIST_TITLE' => 'the carbon consortium', + 'BUCKY_NAME' => 'bucky', + 'UNSORTED_POSITION' => 'top', + 'SNOWBALL_MACHINE' => 'off', +# version author link age datetime date time comments sizeinfiles size files views tags + 'THREAD_ROW_INDEX' => 'author link age comments size files', + 'THREAD_ROW_TAG' => 'author link age comments files', + 'THREAD_ROW_CATEGORY' => 'author link age comments files', + 'THREAD_ROW_DETAILS' => 'author link age comments files' + }; + +our $BUCKY_LEXICON_TAG = 'tag'; +our $BUCKY_LEXICON_KEYWORD = 'category'; +our $BUCKY_LEXICON_DETAILS = 'details'; + +our $BUCKY_DEFAULT_COLOR = 'blue'; +our $BUCKY_UNSORTED_COLOR = 'ivory'; + +our %COLORS = + ( + plain => "#E6F0f0", + ivory => "#F0F0EB", + pink => "#F0DFEB", + red => "#F0E0DF", + orange => "#F0E8DF", + yellow => "#F0F0E7", + green => "#E9F0E7", + blue => "#E0E2F0", + purple => "#EBE7F0", + black => "#202025", + ); + + +our $THUMB_FLAGGED_PREFIX = 's.'; +our $THUMB_LIBRARY_PREFIX = 't.'; +our $THUMB_BPOD_PREFIX = 'b.'; + +our $AVATAR_PROFILE_WIDTH = 270; +our $AVATAR_PROFILE_HEIGHT = 340; +our $AVATAR_BIG_WIDTH = 50; +our $AVATAR_MED_WIDTH = 30; + +our $AVATAR_PROFILE_PREFIX = "pro."; +our $AVATAR_BIG_PREFIX = "al."; +our $AVATAR_MED_PREFIX = "am."; + +# ftp import paths +our $BUCKY_FTP_HOST = "carbonpictures.com"; +our $BUCKY_FTP_USER = "bucky"; +our $BUCKY_FTP_PASS = "m0refreediskspace"; + +# (shoutcast) radio data +our $RADIO_STATUS_PATH = $BUCKY_CONFIG->{BASE_PATH}."radio/radio-status"; +our $RADIO_INFO_PATH = $BUCKY_CONFIG->{BASE_PATH}."radio/radio-info"; + +our $CONVERT_PATH = "/usr/bin/convert"; +our $WGET_STRING = "/usr/bin/wget -nd -N -O"; +our $MV_PATH = "/bin/mv"; +our $RM_PATH = "/bin/rm"; +our $MKDIR_PATH = "/bin/mkdir"; +our $CHMOD_PATH = "/bin/chmod"; +our $NOHUP_PATH = "nohup"; +our $ZIP_PATH = "/usr/bin/zip"; + +our $BUCKY_WELCOME_SUBJECT = "WELCOME TO BUCKY"; +our $BUCKY_WELCOME_BODY = <bucky is a bulletin board where you can post comments and upload files (music, video, pics, software, etc). you can share these links with your friends. to start your own post, you can use the "post" link at the top of the screen, or the quickstart form on the home page. you can ftp files too if you have to send something large. + +hope you find this board useful!! + +WORDUP + diff --git a/lib/cookies.pm b/lib/cookies.pm new file mode 100644 index 0000000..559e80a --- /dev/null +++ b/lib/cookies.pm @@ -0,0 +1,55 @@ +# &setCookie("fuckface", "j1zzm0p"); + +our $cookie_reset = "Friday, 31-Dec-1999 11:59:59 GMT"; +our $cookie_forever = "Friday, 21-Dec-2069 12:28:49 GMT"; + +# our $cookies = getCookies() if ($ENV{'HTTP_COOKIE'}); +# store cookies in %$cookies + +sub setCookie + { + # end a set-cookie header with the word secure and the cookie will + # only be sent through secure connections + + my ($args) = @_; + my $name = $args->{name} || undef; + my $value = $args->{value} || undef; + my $path = $args->{path} || undef; + my $domain = $args->{domain} || undef; + +# my ($name, $value, $path, $domain) = @_; + my $date; + + if (!$value) + { $date = $cookie_reset; } + elsif (exists($args->{nologout}) && $args->{nologout} == 1) + { $date = $cookie_forever; } + else + { $date = 0; } + + print "Set-Cookie: "; + print $name, "=", $value, "; "; + if ($date) { print "expires=$date; "; } +# print "path=", $path, "; domain=", $domain, "; secure\n"; + print "path=", $path, "; domain=", $domain, "\n"; + } + + +# cookies are seperated by a semicolon and a space, this will split +# them and return a hash of cookies + +sub getCookies + { + my (@rawCookies) = split (/; /,$ENV{'HTTP_COOKIE'}); + my %cookies; + + foreach(@rawCookies) + { + my ($key, $val) = split (/=/,$_); + $cookies{$key} = $val; + } + + return \%cookies; + } + +1; diff --git a/lib/db.pm b/lib/db.pm new file mode 100644 index 0000000..90aaf08 --- /dev/null +++ b/lib/db.pm @@ -0,0 +1,2400 @@ + +our @FILE_KEYS = qw(id username thread filename title date size private ); +our @FILE_KEYS_KEYWORD = qw(id username thread filename title date size private keyword); +our $BUCKY_DB_TABLE_USERS = 'users'; +our $BUCKY_DB_TABLE_KEYWORDS = 'keywords'; +our $BUCKY_DB_TABLE_THREADS = 'threads'; +our $BUCKY_DB_TABLE_COMMENTS = 'comments'; +our $BUCKY_DB_TABLE_FILES = 'files'; +our $BUCKY_DB_TABLE_THREADSTAGS = 'threadstags'; +our $BUCKY_DB_TABLE_TAGS = 'tags'; +our $BUCKY_DB_TABLE_INVITES = 'invites'; + +our @BUCKY_DB_COLUMNS_USERS = + qw(id username password realname email aim grass ulevel firstseen lastseen lastsession timezone stickies sink display boxes); +our @BUCKY_DB_COLUMNS_THREADSTAGS = + qw(threadid tagid username createdate); +our @BUCKY_DB_COLUMNS_TAGS = + qw(id tag createdate owner ops public display); +our @BUCKY_DB_COLUMNS_THREADS = + qw(title username keyword createdate lastmodified size private allowed color display viewed revision); + +our @BUCKY_DB_COLUMNS_INVITES = + qw(id hash state attest created expired username password realname email grass keywords); +our @BUCKY_INVITE_STATES = + qw(approved active request expired rejected redeemed); +our $BUCKY_INVITE_REQUEST = 2; +our $BUCKY_INVITE_ACTIVE = 1; +our $BUCKY_INVITE_APPROVED = 0; +our $BUCKY_INVITE_REDEEMED = -1; +our $BUCKY_INVITE_REJECTED = -2; +our $BUCKY_INVITE_EXPIRED = -3; + +our $BUCKY_DB_ERROR_INSERT_USERS = 'failed to add user!'; +our $BUCKY_DB_ERROR_INSERT_INVITES = 'failed to add invite!'; +our $BUCKY_DB_ERROR_INSERT_TAGS = 'failed to add tag!'; +our $BUCKY_DB_ERROR_INSERT_THREADS = 'failed to add post!'; +our $BUCKY_DB_ERROR_INSERT_THREADSTAGS = 'failed to add tag to post!'; + +sub new_user + { + my ($new_user) = @_; + my $data; + $data->{row}->{username} = $new_user->{username}; + $data->{row}->{password} = $new_user->{password}; # should already be encrypted + $data->{row}->{email} = $new_user->{email}; + $data->{row}->{grass} = $new_user->{grass}; + $data->{row}->{realname} = $new_user->{realname}; +# $data->{row}->{boxes} = $dbh->quote($BUCKY_DEFAULT_BOXES); + $data->{row}->{boxes} = $BUCKY_DEFAULT_BOXES; + $data->{row}->{ulevel} = 1; + $data->{row}->{firstseen} = time; + $data->{row}->{lastseen} = time; + $data->{row}->{lastsession} = time; + $data->{row}->{timezone} = -8; + $data->{table} = $BUCKY_DB_TABLE_USERS; + $data->{columns} = \@BUCKY_DB_COLUMNS_USERS; + $data->{error} = $BUCKY_DB_ERROR_INSERT_USERS; + return add_row_by_hash( $data ); + } + +sub get_user + { + my ($uname) = @_; + my @fields = qw(id username password ulevel lastseen lastsession timezone stickies sink display boxes); + my @row; + my %temphash; + + $uname = $dbh->quote($uname); + + $query = "SELECT "; + foreach my $k (@fields) + { + $query .= $k; + if (++$i != @fields) + { $query .= ","; } + } + $query .= " FROM users WHERE username=$uname"; + + $sth = $dbh->prepare($query); + $sth->execute(); + @row = $sth->fetchrow_array(); + $sth->finish (); + + if (@row == 0) + { return -1; } + + for (my $i = 0; $i < @row; $i++) + { + $temphash{$fields[$i]} = $row[$i]; + } + + return \%temphash; + } + +sub get_uid + { + my ($name) = @_; + my $user_id; + my $rows = 0; + $name = $dbh->quote($name); + my $query = "SELECT id FROM users WHERE username = $name"; + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + $user_id = $row[0]; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No such user!\n" if ($DEBUG); + return -1; + } + return $user_id; + } + +sub get_all_users + { + my ($limit) = @_; + my @rows; + my $rows = 0; + my @keys = @BUCKY_DB_COLUMNS_USERS; + my $keylist = join ",", @keys; + my $query = "SELECT $keylist FROM users WHERE ulevel > -1"; + $query .= " AND lastseen > $limit" if (defined($limit)); + print $query."
" if ($DEBUG); + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + print $row[0]." " if ($DEBUG); + for (my $i = 0; $i < @row; $i++) + { + $temphash{$keys[$i]} = $row[$i]; + } + $rows[$rows] = \%temphash; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No users!\n" if ($DEBUG); + return -1; + } + + my $ccount = count_comments_by_user(); + my $fcount = count_files_by_user(); + + foreach my $user (@rows) + { + my $this_user = $user->{username}; + $user->{ccount} = exists($ccount->{$this_user}) ? $ccount->{$this_user} : 0; + $user->{fcount} = exists($fcount->{$this_user}) ? $fcount->{$this_user} : 0; + } + return \@rows; + } + +sub count_files_by_user + { + my %temphash; + my $query = "SELECT username,COUNT(*) FROM files GROUP BY username"; + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + $temphash{"$row[0]"} = $row[1]; + } + $sth->finish(); + return \%temphash; + } + +sub count_comments_by_user + { + my %temphash; + my $query = "SELECT username,COUNT(*) FROM comments GROUP BY username"; + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + $temphash{"$row[0]"} = $row[1]; + } + $sth->finish(); + return \%temphash; + } + +sub get_username + { + my ($id) = @_; + my $username; + $id = $dbh->quote($id); + my $query = "SELECT username FROM users WHERE id = $id"; + $sth = $dbh->prepare($query); + $sth->execute(); + ($username) = $sth->fetchrow_array(); + $sth->finish (); + return $username; + } + +sub get_user_profile + { + my ($uname) = @_; + my @fields = qw[username realname email aim phone location timezone lastseen display boxes stickies sink]; + my @row; + my %temphash; + $uname = $dbh->quote($uname); + my $query = "SELECT username,realname,email,aim,phone,location,timezone,lastseen,display,boxes,stickies,sink FROM users WHERE username=$uname"; + $sth = $dbh->prepare($query); + $sth->execute(); + @row = $sth->fetchrow_array(); + $sth->finish (); + for (my $i = 0; $i < @row; $i++) + { + $temphash{$fields[$i]} = $row[$i]; + } + return \%temphash; + } + +sub update_profile + { + my ($uname, $prof) = @_; + my %q; + my $i = 0; + my $query; + my @fields = qw[realname email aim phone location timezone display stickies sink]; + + $q{date} = $dbh->quote(time); + $uname = $dbh->quote($uname); + + foreach my $key (@fields) + { + $q{$key} = $dbh->quote($$prof{$key}); + } + + $query = "UPDATE users SET "; + foreach my $k (@fields) + { + $query .= $k."=".$q{$k}; + if (++$i != @fields) + { $query .= ","; } + } + $query .= " WHERE username=$uname"; + + my $rows = $dbh->do($query); + + if ($rows == 0) + { print "failed to update profile !"; return 0; } + + return 1; + } + +sub update_user_boxes + { + my ($uname, $boxes) = @_; + $uname = $dbh->quote($uname); + $boxes = $dbh->quote($boxes); + $query = "UPDATE users SET boxes=$boxes WHERE username=$uname"; + $dbh->do($query); + } + +sub update_lastsession + { + my ($uname) = @_; + $uname = $dbh->quote($uname); + $query = "UPDATE users SET lastsession=lastseen WHERE username=$uname"; + $dbh->do($query); + } + +sub update_password + { + my ($uname, $newpass) = @_; + $uname = $dbh->quote($uname); + $newpass = $dbh->quote($newpass); + $query = "UPDATE users SET password=$newpass WHERE username=$uname"; + $dbh->do($query); + } + +sub touch_user + { + my ($uname) = @_; + my $t = time; + + $t = $dbh->quote($t); + $uname = $dbh->quote($uname); + my $query = "UPDATE users SET lastseen=$t WHERE id=$uname"; + my $rows = $dbh->do($query); + + if ($rows == undef) + { error("failed to touch user $uname !"); } + + return 1; + } + +sub update_user_sticky + { + my ($uname, $stick) = @_; + + $uname = $dbh->quote($uname); + $stick = $dbh->quote($stick); + my $query = "UPDATE users SET stickies=$stick WHERE username=$uname"; + print $query if ($DEBUG); + my $rows = $dbh->do($query); + } + +sub update_user_sink + { + my ($uname, $sink) = @_; + + $uname = $dbh->quote($uname); + $sink = $dbh->quote($sink); + my $query = "UPDATE users SET sink=$sink WHERE username=$uname"; + print $query if ($DEBUG); + my $rows = $dbh->do($query); + } + +sub get_lastlog + { + my @rows; + my $rows = 0; + my @keys = qw[username lastseen]; + my $query = "SELECT username,lastseen FROM users WHERE ulevel > 0 ORDER BY lastseen DESC LIMIT 6"; + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + for (my $i = 0; $i < @row; $i++) + { + $temphash{$keys[$i]} = $row[$i]; + } + $rows[$rows] = \%temphash; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No users!\n" if ($DEBUG); + return -1; + } + + return \@rows; + } + +######################################### +# INVITES +######################################### + +sub new_invite + { + my ($invitehash) = @_; + my $data; + $data->{row} = $invitehash; + $data->{row}->{created} = time; + $data->{row}->{expired} = time + 86400*7; + return add_invite_by_hash( $data ); + } + +sub add_invite_by_hash + { + my ($data) = @_; + $data->{table} = $BUCKY_DB_TABLE_INVITES; + $data->{columns} = \@BUCKY_DB_COLUMNS_INVITES; + $data->{error} = $BUCKY_DB_ERROR_INSERT_INVITES; + return add_row_by_hash( $data ); + } + +sub set_invite_state + { + my ($invite, $state) = @_; + + if (! ref($invite)) + { return -1; } + + $invite->{state} = $state; + + $id = $dbh->quote($invite->{id}); + $state = $dbh->quote($state); + $query = "UPDATE $BUCKY_DB_TABLE_INVITES SET state=$state WHERE id=$id"; + print $query."
" if $DEBUG; + $dbh->do($query); + } + +sub set_invite_expired + { + my ($invite, $expired) = @_; + + if (! ref($invite)) + { return -1; } + + $invite->{expired} = $expired; + + $id = $dbh->quote($invite->{id}); + $expired = $dbh->quote($expired); + $query = "UPDATE $BUCKY_DB_TABLE_INVITES SET expired=$expired WHERE id=$id"; + print $query."
" if $DEBUG; + $dbh->do($query); + } + +sub set_invite_username + { + my ($invite, $username) = @_; + + if (! ref($invite)) + { return -1; } + + $invite->{username} = $username; + + $id = $dbh->quote($invite->{id}); + $username = $dbh->quote($username); + $query = "UPDATE $BUCKY_DB_TABLE_INVITES SET username=$username WHERE id=$id"; + print $query."
" if $DEBUG; + $dbh->do($query); + } + +sub get_invite_from_id + { + my ($id) = @_; + my @rows; + my $query; + my @columns = @BUCKY_DB_COLUMNS_INVITES; + my $joined_keys = join ",", @columns; + my $rows = 0; + my %finalhash; + + $id = $dbh->quote($id); + $query = "SELECT $joined_keys FROM $BUCKY_DB_TABLE_INVITES WHERE id=$id"; + + print $query."
" if ($DEBUG); + $sth = $dbh->prepare($query); + $sth->execute(); + if ((@row) = $sth->fetchrow_array()) + { + for (my $i = 0; $i < @row; $i++) + { + $finalhash{$columns[$i]} = $row[$i]; + } + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No such invite!\n" if ($DEBUG); + return -1; + } + + return \%finalhash; + } + +sub get_invite_from_hash + { + my ($hash) = @_; + my @rows; + my $query; + my @columns = @BUCKY_DB_COLUMNS_INVITES; + my $joined_keys = join ",", @columns; + my $rows = 0; + my %finalhash; + + $hash = $dbh->quote($hash); + $query = "SELECT $joined_keys FROM $BUCKY_DB_TABLE_INVITES WHERE hash=$hash"; + + print $query."
" if ($DEBUG); + $sth = $dbh->prepare($query); + $sth->execute(); + if ((@row) = $sth->fetchrow_array()) + { + for (my $i = 0; $i < @row; $i++) + { + $finalhash{$columns[$i]} = $row[$i]; + } + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No such invite!\n" if ($DEBUG); + return -1; + } + + return \%finalhash; + } + +sub get_active_invites + { + my $query; + my @columns = @BUCKY_DB_COLUMNS_INVITES; + my $joined_keys = join ",", @columns; + my $rows = 0; + my @finalarray; + my $now = $dbh->quote(time); + + $query = "SELECT $joined_keys FROM $BUCKY_DB_TABLE_INVITES WHERE expired > $now"; + + print $query."
" if ($DEBUG); + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + for (my $i = 0; $i < @row; $i++) + { + $temphash{$columns[$i]} = $row[$i]; + } + push @finalarray, \%temphash; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No invites!\n" if ($DEBUG); + return -1; + } + + return \@finalarray; + } + +sub get_invites_by_user + { + my ($username) = @_; + + my $query; + my @columns = @BUCKY_DB_COLUMNS_INVITES; + my $joined_keys = join ",", @columns; + my $rows = 0; + my @finalarray; + my $username = $dbh->quote($username); + + $query = "SELECT $joined_keys FROM $BUCKY_DB_TABLE_INVITES WHERE attest=$username"; + + print $query."
" if ($DEBUG); + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + for (my $i = 0; $i < @row; $i++) + { + $temphash{$columns[$i]} = $row[$i]; + } + push @finalarray, \%temphash; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No invites!\n" if ($DEBUG); + return -1; + } + + return \@finalarray; + } + +sub count_active_user_invites + { + my ($username) = @_; + my $count = 0; + $username = $dbh->quote($username); + my $query = "SELECT COUNT(*) FROM $BUCKY_DB_TABLE_INVITES WHERE attest=$username AND state > 0"; + $sth = $dbh->prepare($query); + $sth->execute(); + ($count) = $sth->fetchrow_array(); + $sth->finish (); + return $count; + } + +######################################### +# BOXES +######################################### + +sub get_boxes + { + my ($uname) = @_; + my @rows; + my $query; + my @keys = qw(id mbox owner mcount editable); + my $rows = 0; + + $uname = $dbh->quote($uname); + $query = "SELECT id,mbox,owner,mcount,editable FROM boxes WHERE owner=$uname"; + + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + for (my $i = 0; $i < @row; $i++) + { + $temphash{$keys[$i]} = $row[$i]; + } + $rows[$rows] = \%temphash; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No messages!\n" if ($DEBUG); + return -1; + } + + return \@rows; + } + +sub recount_mailbox + { + my ($box) = @_; + + my $count = count_messages($box); + + $box = $dbh->quote($box); + $count = $dbh->quote($count); + my $query = "UPDATE boxes SET mcount=$count WHERE mbox=$box"; + my $rows = $dbh->do($query); + + if ($rows == 0) + { error("failed to tweez mcount of $box!"); } + + return 1; + } + +sub count_messages + { + my ($box) = @_; + my $count = 0; + $box = $dbh->quote($box); + my $query = "SELECT COUNT(*) FROM messages WHERE mbox=$box"; + $sth = $dbh->prepare($query); + $sth->execute(); + ($count) = $sth->fetchrow_array(); + $sth->finish (); + return $count; + } + +sub get_messages + { + my ($mbox, $limit, $startdate) = @_; + my @rows; + my $query; + my @keys = qw(id mbox unread sender recipient date subject size); + my $rows = 0; + + $mbox = $dbh->quote($mbox); + $query = "SELECT id,mbox,unread,sender,recipient,date,subject,length(body) FROM messages WHERE mbox=$mbox"; + + if ($startdate && $startdate ne "now") + { + $query .= " AND (date < $startdate)"; + } + $query .= " ORDER BY date DESC"; + if ($limit) + { + $query .= " LIMIT $limit"; + } + + print "$query
" if ($DEBUG); + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + for (my $i = 0; $i < @row; $i++) + { + $temphash{$keys[$i]} = $row[$i]; + } + $rows[$rows] = \%temphash; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No messages!\n" if ($DEBUG); + return -1; + } + + return \@rows; + } + +sub add_mailbox + { + my ($box, $name, $editable) = @_; + $box = $dbh->quote($box); + $name = $dbh->quote($name); + $editable = $dbh->quote($editable); + my $query = "INSERT boxes (mbox,owner,editable) VALUES($box,$name,$editable)"; + my $rows = $dbh->do($query); + return $rows; + } + +######################################### +# MESSAGES +######################################### + +sub unflag_message + { + my ($id) = @_; + + $id = $dbh->quote($id); + my $query = "UPDATE messages SET unread=0 WHERE id=$id"; + my $rows = $dbh->do($query); + + if ($rows == undef) + { error("failed to unread $id !"); } + + return 1; + } + +sub get_message + { + my ($id) = @_; + my @row; + my @keys = qw(id mbox unread sender recipient date subject body); + my $rows = 0; + my %temphash; + $id = $dbh->quote($id); + my $query = "SELECT id,mbox,unread,sender,recipient,date,subject,body FROM messages WHERE id=$id"; + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + for (my $i = 0; $i < @row; $i++) + { + $temphash{$keys[$i]} = $row[$i]; + } + $rows++; + } + $sth->finish (); + if ($rows == 0) + { + print "No such message!\n" if ($DEBUG); + return -1; + } + return \%temphash; + } + +sub count_new_messages + { + my ($uname) = @_; + my $count = 0; + $uname = $dbh->quote($uname); + $ur = $dbh->quote("1"); + my $query = "SELECT COUNT(*) FROM messages WHERE recipient=$uname AND unread=$ur"; + $sth = $dbh->prepare($query); + $sth->execute(); + ($count) = $sth->fetchrow_array(); + $sth->finish (); + return $count; + } + +sub new_message + { + my ($mbox, $m) = @_; + my %q; + + $q{date} = $dbh->quote(time); + + $qmbox = $dbh->quote($mbox); + foreach my $key (keys %$m) + { + $q{$key} = $dbh->quote($$m{$key}); + } + my $query = "INSERT messages (mbox,unread,sender,recipient,date,subject,body) VALUES($qmbox,$q{unread},$q{sender},$q{recipient},$q{date},$q{subject},$q{body})"; + my $rows = $dbh->do($query); + if ($rows == 0) + { print "failed to send message !"; return 0; } + + recount_mailbox($mbox); + return 1; + } + +sub update_message + { + my ($id, $m) = @_; + my %q; + my $i = 0; + my $query; + my @fields = qw(sender recipient date subject body); + $q{date} = $dbh->quote(time); + + $id = $dbh->quote($id); + + foreach my $key (keys %$m) + { + $q{$key} = $dbh->quote($m->{$key}); + } + + $query = "UPDATE messages SET "; + foreach my $k (@fields) + { + $query .= $k."=".$q{$k}; + if (++$i != 5) + { $query .= ","; } + } + $query .= " WHERE id=$id"; + + my $rows = $dbh->do($query); + + if ($rows == 0) + { print "failed to update message !"; return 0; } + + return 1; + } + + +sub delete_message + { + my ($id) = @_; + $id = $dbh->quote($id); + my $query = "DELETE FROM messages WHERE id=$id"; + my $rows = $dbh->do($query); + } +######################################### +# FILES +######################################### + +sub get_file + { + my ($id) = @_; + my @rows; + my $rows = 0; + my $query; + my %temphash; + + $id = $dbh->quote($id); + my $keys = join ",", @FILE_KEYS; + $query = "SELECT $keys FROM files WHERE id=$id"; + + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + for (my $i = 0; $i < @row; $i++) + { + $temphash{$FILE_KEYS[$i]} = $row[$i]; + } + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No files!\n" if ($DEBUG); + return -1; + } + + return \%temphash; + } + +sub get_file_from_filename + { + my ($filename) = @_; + my @rows; + my $rows = 0; + my $query; + my %temphash; + + $filename = $dbh->quote($filename); + my $keys = join ",", @FILE_KEYS; + $query = "SELECT $keys FROM files WHERE filename=$filename"; + + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + for (my $i = 0; $i < @row; $i++) + { $temphash{$FILE_KEYS[$i]} = $row[$i]; } + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No files!\n" if ($DEBUG); + return -1; + } + + return \%temphash; + } + +sub get_files + { + my ($pid) = @_; + my @rows; + my $rows = 0; + my $query; + + $pid = $dbh->quote($pid); + my $keys = join ",", @FILE_KEYS; + $query = "SELECT $keys FROM files WHERE thread=$pid"; + + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + for (my $i = 0; $i < @row; $i++) + { + $temphash{$FILE_KEYS[$i]} = $row[$i]; + } + $rows[$rows] = \%temphash; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { return -1; } + + return \@rows; + } +sub get_recent_files + { + my @rows; + my $rowcount = 0; + my $query; + + my $keys = join ",", @FILE_KEYS; + $query = "SELECT $keys FROM files ORDER BY date DESC LIMIT 20"; + + + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + for (my $i = 0; $i < @row; $i++) + { + $temphash{$FILE_KEYS[$i]} = $row[$i]; + } + push(@rows, \%temphash ); + $rowcount++; + } + $sth->finish(); + + if ($rowcount == 0) + { return -1; } + + return \@rows; + } + + + +sub get_tag_files + { + my ($tag) = @_; + my @rows; + my @FILE_KEYS_JOIN = qw(files.id files.username thread filename files.title files.date files.size files.private threads.keyword); + my $rows = 0; + $tag= $dbh->quote($tag); + my $keys = join ",", @FILE_KEYS_JOIN; + + my $query = "SELECT $keys FROM files,threads,threadstags,tags " . + "WHERE files.thread=threads.id AND threads.id=threadstags.threadid " . + "AND threadstags.tagid=tags.id AND tags.tag=$tag"; + $sth = $dbh->prepare( $query ); + $sth->execute(); + + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + for (my $i = 0; $i < @row; $i++) + { + $temphash{$FILE_KEYS_KEYWORD[$i]} = $row[$i]; + } + $rows[$rows] = \%temphash; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No files!\n" if ($DEBUG); + return -1; + } + + return \@rows; + } +sub get_keyword_files + { + my ($keyword) = @_; + my @rows; + my @FILE_KEYS_JOIN = qw(files.id files.username thread filename files.title files.date files.size files.private threads.keyword); + my $rows = 0; + $keyword = $dbh->quote($keyword); + my $keys = join ",", @FILE_KEYS_JOIN; + + my $query = "SELECT $keys FROM files,threads WHERE files.thread=threads.id AND threads.keyword=$keyword"; + $sth = $dbh->prepare( $query ); + $sth->execute(); + + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + for (my $i = 0; $i < @row; $i++) + { + $temphash{$FILE_KEYS_KEYWORD[$i]} = $row[$i]; + } + $rows[$rows] = \%temphash; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No files!\n" if ($DEBUG); + return -1; + } + + return \@rows; + } +sub get_user_files + { + my ($uname) = @_; + my @rows; + my $rows = 0; + my $query; + + $uname = $dbh->quote($uname); + my @FILE_KEYS_JOIN = qw(files.id files.username files.thread files.filename files.title files.date files.size files.private threads.keyword); + my $keys = join ",", @FILE_KEYS_JOIN; + $query = "SELECT $keys FROM files,threads WHERE files.username=$uname AND files.thread=threads.id"; + + $sth = $dbh->prepare($query); + $sth->execute(); + print $query."
" if ($DEBUG); + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + for (my $i = 0; $i < @row; $i++) + { + $temphash{$FILE_KEYS_KEYWORD[$i]} = $row[$i]; + } + $rows[$rows] = \%temphash; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No files!\n" if ($DEBUG); + return -1; + } + + return \@rows; + } + +sub get_largest_files + { + my @rows; + my $rows = 0; + my $query; + my @keys = qw(id username thread filename date size private); + + $pid = $dbh->quote($pid); + my $keys = join ",", @FILE_KEYS; + $query = "SELECT $keys FROM files WHERE size > 100000000"; + + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + for (my $i = 0; $i < @row; $i++) + { + $temphash{$FILE_KEYS[$i]} = $row[$i]; + } + $rows[$rows] = \%temphash; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { return -1; } + + return \@rows; + } + + +sub add_file + { + my ($pid, $uname, $filename, $size, $date) = @_; + my $f_id; + + $pid = $dbh->quote($pid); + $uname = $dbh->quote($uname); + $filename = $dbh->quote($filename); + $date = $dbh->quote($date); + $size = $dbh->quote($size); + my $query = "INSERT files (thread,username,date,filename,size) VALUES($pid,$uname,$date,$filename,$size)"; + my $rows = $dbh->do($query); + if ($rows == 0) + { error("failed to add file !"); } + + $query = "SELECT id FROM files WHERE username=$uname AND date=$date"; + $sth = $dbh->prepare($query); + $sth->execute(); + ($f_id) = $sth->fetchrow_array(); + $sth->finish (); + + return $f_id; + } + +sub delete_file_record + { + my ($id) = @_; + $id = $dbh->quote($id); + my $query = "DELETE FROM files WHERE id=$id"; + my $rows = $dbh->do($query); + } + +sub count_user_files + { + my ($uname) = @_; + my @row; + $uname = $dbh->quote($uname); + my $query = "SELECT COUNT(*), SUM(size) FROM files WHERE username=$uname"; + $sth = $dbh->prepare($query); + $sth->execute(); + (@row) = $sth->fetchrow_array(); + $sth->finish (); + return @row; + } + +sub count_files + { + my ($thread) = @_; + my $count; + $thread = $dbh->quote($thread); + my $query = "SELECT COUNT(*) FROM files WHERE thread=$thread"; + $sth = $dbh->prepare($query); + $sth->execute(); + ($count) = $sth->fetchrow_array(); + $sth->finish (); + return $count; + } + +######################################### +# COMMENTS +######################################### + +sub get_comment + { + my ($comment_id) = @_; + + #$comment_id = $dbh->quote($comment_id); + + $query = "SELECT * FROM comments WHERE id=$comment_id"; + + print "$query
" if ($DEBUG); + $sth = $dbh->prepare($query); + $sth->execute(); + my $comment = $sth->fetchrow_hashref(); + $sth->finish (); + + return $comment || -1; + } + +sub get_comments + { + my ($thread, $count) = @_; + my %rows_by_id; + my $query; + my $rows = 0; + + return -1 if (!defined($thread)); + $query = "SELECT * FROM comments WHERE thread=$thread"; + if ($count) + { $query .= " ORDER BY id DESC LIMIT $count"; } +print $query."
" if $DEBUG; + $sth = $dbh->prepare($query); + $sth->execute(); + while (my $row = $sth->fetchrow_hashref) + { + my $id = $row->{'id'}; + $rows_by_id{$id} = $row; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { return -1; } + + return \%rows_by_id; + } + +sub count_comments + { + my ($thread) = @_; + my $count; + $thread = $dbh->quote($thread); + my $query = "SELECT COUNT(*) FROM comments WHERE thread = $thread"; + $sth = $dbh->prepare($query); + $sth->execute(); + ($count) = $sth->fetchrow_array(); + $sth->finish (); + return $count; + } + +sub add_comment + { + my ($thread, $pid, $uname, $comment, $time) = @_; + my ($t) = $time || time; + my $qpid; + my $c_id; + + $thread = $dbh->quote($thread); + $pid = $dbh->quote($pid); + $uname = $dbh->quote($uname); + $comment = $dbh->quote($comment); + $t = $dbh->quote($t); + my $query = "INSERT comments (thread,parent_id,username,date,comment) VALUES($thread,$pid,$uname,$t,$comment)"; + my $rows = $dbh->do($query); + if ($rows == undef) + { error("failed to add comment !"); } + + $query = "SELECT id FROM comments WHERE username=$uname AND date=$t"; + $sth = $dbh->prepare($query); + $sth->execute(); + ($c_id) = $sth->fetchrow_array(); + $sth->finish (); + + return $c_id; + } + +sub update_comment + { + my ($id, $comment) = @_; + my ($t) = time; + + $id = $dbh->quote($id); + $comment = $dbh->quote($comment); + $t = $dbh->quote($t); + my $query = "UPDATE comments SET date=$t,comment=$comment where id=$id"; + my $rows = $dbh->do($query); + if ($rows == undef) + { error("failed to edit comment !"); } + + return 1; + } + +sub delete_comment + { + my ($id) = @_; + $id = $dbh->quote($id); + my $query = "DELETE FROM comments WHERE id=$id"; + my $rows = $dbh->do($query); + } + +######################################### +# TAGS +######################################### + +sub get_tag + { + my ($tag_name) = @_; + $tag_name = $dbh->quote( $tag_name ); + my @columns = qw(id tag createdate owner ops public display); + my $query = "SELECT id,tag,createdate,owner,ops,public,display FROM tags WHERE tag =$tag_name"; + print "$query
" if ($DEBUG); + my $sth = $dbh->prepare( $query ); + $sth->execute(); + my $rows = 0; + my %temphash; + if ((@row) = $sth->fetchrow_array()) + { + for (my $i = 0; $i < @row; $i++) + { + $temphash{$columns[$i]} = $row[$i]; + } + $rows++; + } + if ($rows == 0) + { + print "No such tag!\n" if ($DEBUG); + return -1; + } + return \%temphash; + } +sub get_tag_count + { + my ($tag) = @_; + my $count = 0; + $tag = $dbh->quote( $tag ); + my $query = "SELECT COUNT(*) FROM tags WHERE tag=$tag"; + my $sth = $dbh->prepare( $query ); + $sth->execute; + ($count) = $sth->fetchrow_array(); + $sth->finish(); + return $count; + } +sub get_tag_names + { + my @tags; + my $query = "SELECT DISTINCT tag from tags,threadstags,threads " . + "WHERE threadstags.tagid=tags.id AND threadstags.threadid=threads.id " . + "AND ((threads.private = 0)"; + if ( $USER == -1 ) + { $query .= ")"; } + else + { $query .= " OR (threads.allowed LIKE \"% " . $USER->{id} . " %\"))"; } + print "$query
" if ($DEBUG); + $sth = $dbh->prepare( $query ); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + push ( @tags, $row[0] ); + } + $sth->finish(); + if (@tags == 0) + { +# print "No tags!\n" if ($DEBUG); + return -1; + } + return \@tags; + } +sub get_tags_for_thread + { + my ($id) = @_; + my @keys = qw(tag createdate owner ops public display); + my @rows; + my %temphash; + $id = $dbh->quote($id) unless ($id =~ /'/); + my $query = "SELECT tags.tag FROM threadstags,tags WHERE threadstags.threadid=$id AND threadstags.tagid=tags.id"; + print "$query
" if ($DEBUG); + $sth = $dbh->prepare( $query ); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + push( @rows, $row[0] ); + } + $sth->finish (); + if (@rows == 0) + { +# print "No tags for post!\n" if ($DEBUG); + return -1; + } + return \@rows; + } + +sub delete_tag_for_thread + { + my ($tag_id, $thread_id) = @_; + + if (ref($tag_id)) + { $tag_id = $tag_id->{id}; } + if (ref($thread_id)) + { $thread_id = $thread_id->{id}; } + + # Escape id numbers for SQL + $tag_id = $dbh->quote($tag_id); + $thread_id = $dbh->quote($thread_id); + + my $query = "DELETE FROM threadstags WHERE threadid=$thread_id AND tagid=$tag_id"; + my $rows = $dbh->do($query); + } + +sub increment_tag_for_thread_by_hash + { + } +sub new_tag + { + my ($tag) = @_; + my $data; + $data->{row}->{tag} = $tag; + $data->{row}->{owner} = $USER->{username}; + $data->{row}->{createdate} = time; + $data->{row}->{public} = 0; + return add_tag_by_hash( $data ); + } + +sub add_tag_by_hash + { + my ($data) = @_; + $data->{table} = $BUCKY_DB_TABLE_TAGS; + $data->{columns} = \@BUCKY_DB_COLUMNS_TAGS; + $data->{error} = $BUCKY_DB_ERROR_INSERT_TAGS; + return add_row_by_hash( $data ); + } + +sub add_row_by_hash + { + # Data hash + my ($data) = @_; + + # Return row id, retrieved identifier, or -1 if failure + my $id = -1; + + # Columns for this table/row, required + my $columns = $data->{columns} || return $returnVal; + + # SQL statement handle + my $sth; + + # Initialize query with SQL INSERT + my $query = "INSERT " . $data->{table} . " SET "; + + # Flag for prepending comma after first column + my $first_column = 0; + +# print "tag: " . $data->{row}->{tag} . "
\n"; +# print $data->{row}->{owner} . "
\n"; +# print "columns : " .$columns . "
\n"; + # Loop through row's columns to build SQL statement + my $first_set = 0; + foreach my $column (@$columns) + { +# print $data->{row}->{$column} . "
\n"; + # skip if this column is not provided for this row + next unless exists( $data->{row}->{$column} ); + + # Prepend comma for every column after the first + $query .= ", " unless ($first_set++ == 0); + + # SQL quote each column, append column name and value to insert statement + $query .= $column . "=" . $dbh->quote( $data->{row}->{$column} ); + } + + # Debug output the SQL query + print $query . "
" if ($DEBUG); + + # Execute SQL query + my $rows = $dbh->do( $query ); + + # Return any query error + if ($rows == undef) + { error( $data->{error} ); } + + # If there is a special identifying value to return for this inserted row + if ( ref($data->{retrieve}) ) + { + # Construct query for the requested column + $query = "SELECT " . $data->{retrieve}->{column} . " FROM " . $data->{table}; + + # Specify qualifiers with key and value + $query .= " WHERE " . $data->{retrieve}->{key} . "=" . $data->{retrieve}->{value}; + + # Prepare and execute SQL query + $sth = $dbh->prepare( $query ); + $sth->execute(); + + # Return identifying value (the first one, hopefully no multiple matches + ($id) = $sth->fetchrow_array(); + # Close SQL statement handle + $sth->finish(); + } + elsif ( $data->{retrieve} ) + { + $id = 0; + } + else + { + # Retrieve last auto-incremented value as a result of the last SQL INSERT- this is the ID + $id = $dbh->{'mysql_insertid'}; + } + + + # Return ID column or identifying value + return $id; + } + +sub add_tag_for_thread_by_hash + { + my ($newt) = @_; + my $thread_id = -1; + @keys = qw(title username keyword createdate lastmodified size private allowed color display viewed); + my @qkeys; + my %q; + my $i = 0; + my $sth; + + foreach my $key (@keys) + { + if (exists $newt->{$key}) + { + $q{$key} = $dbh->quote($newt->{$key}); + } + } + + @qkeys = keys %q; + + $query = "INSERT threads SET "; + foreach my $k (@qkeys) + { + $query .= $k."=".$q{$k}; + if (++$i != @qkeys) + { $query .= ","; } + } + + print $query."
" if ($DEBUG); + my $rows = $dbh->do($query); + if ($rows == undef) + { error("failed to add post!"); } + + $query = "SELECT id FROM threads WHERE title=$q{title}"; + $sth = $dbh->prepare($query); + $sth->execute(); + ($thread_id) = $sth->fetchrow_array(); + $sth->finish (); + + return $thread_id; + } +sub update_tag_for_thread + { + my ($tag_id, $thread_id) = @_; + + if (ref($tag_id)) + { $tag_id = $tag_id->{id}; } + if (ref($thread_id)) + { $thread_id = $thread_id->{id}; } + + $data->{table} = $BUCKY_DB_TABLE_THREADSTAGS; + $data->{columns} = \@BUCKY_DB_COLUMNS_THREADSTAGS; + $data->{error} = $BUCKY_DB_ERROR_INSERT_THREADSTAGS; + $data->{row}->{'threadid'} = $thread_id; + $data->{row}->{'tagid'} = $tag_id; + $data->{row}->{'username'} = $USER->{username}; + $data->{row}->{'createdate'} = time; + + add_row_by_hash( $data ); + return 1; + } +######################################### +# THREADS +######################################### +sub get_thread + { + my ($id) = @_; + my @row; + my @keys = qw(id title username keyword createdate lastmodified size private allowed flagged display color zipped viewed revision); + my $rows = 0; + my %temphash; + $id = $dbh->quote($id); + my $query = "SELECT id,title,username,keyword,createdate,lastmodified,size,private,allowed,flagged,display,color,zipped,viewed,revision FROM threads WHERE id=$id"; + print "$query
" if ($DEBUG); + $sth = $dbh->prepare($query); + $sth->execute(); + if ((@row) = $sth->fetchrow_array()) + { + for (my $i = 0; $i < @row; $i++) + { + $temphash{$keys[$i]} = $row[$i]; + } + $rows++; + } + $sth->finish (); + if ($rows == 0) + { + print "No such post!\n" if ($DEBUG); + return -1; + } + $temphash{comments} = count_comments($temphash{id}); + $temphash{files} = count_files($temphash{id}); + $temphash{tags} = get_tags_for_thread( $id ); + return \%temphash; + } + +sub add_tag_by_hash_v2 + { + } +sub add_tag_for_thread_by_hash_v2 + { + } +sub add_thread_by_hash_v2 + { + my ($data) = @_; + $data->{table} = $BUCKY_DB_TABLE_THREADS; + $data->{columns} = \@BUCKY_DB_COLUMNS_THREADS; + $data->{error} = $BUCKY_DB_ERROR_INSERT_THREADS; + return add_row_by_hash( $data ); + } + +sub add_thread_by_hash + { + my ($newt) = @_; + my $thread_id = -1; + @keys = qw(title username keyword createdate lastmodified size private allowed color display viewed); + my @qkeys; + my %q; + my $i = 0; + my $sth; + + foreach my $key (@keys) + { + if (exists $newt->{$key}) + { + $q{$key} = $dbh->quote($newt->{$key}); + } + } + + @qkeys = keys %q; + + $query = "INSERT threads SET "; + foreach my $k (@qkeys) + { + $query .= $k."=".$q{$k}; + if (++$i != @qkeys) + { $query .= ","; } + } + + print $query."
" if ($DEBUG); + my $rows = $dbh->do($query); + if ($rows == undef) + { error("failed to add post!"); } + + $query = "SELECT id FROM threads WHERE title=$q{title}"; + $sth = $dbh->prepare($query); + $sth->execute(); + ($thread_id) = $sth->fetchrow_array(); + $sth->finish (); + + return $thread_id; + } + +sub add_thread + { + my ($title, $uname, $private) = @_; + my ($t) = time; + my $thread_id; + + if (!defined($private)) + { $private = 0; } + + $title = $dbh->quote($title); + $uname = $dbh->quote($uname); + $private = $dbh->quote($private); + my $viewed = 0; + $t = $dbh->quote($t); + my $query = "INSERT threads (title,username,createdate,lastmodified,private,viewed) VALUES($title,$uname,$t,$t,$private,$viewed)"; + my $rows = $dbh->do($query); + if ($rows == undef) + { error("failed to add post!"); } + + $query = "SELECT id FROM threads WHERE title=$title"; + $sth = $dbh->prepare($query); + $sth->execute(); + ($thread_id) = $sth->fetchrow_array(); + $sth->finish (); + + return $thread_id; + } + +sub touch_thread + { + my ($thread) = @_; + my $time = time; + + return 0 if ($thread == -1); + + my $id = $dbh->quote($thread->{id}); + my $revision = $dbh->quote($thread->{revision} + 1); + $time = $dbh->quote($time); + + my $query = "UPDATE threads SET lastmodified=$time,revision=$revision WHERE id=$id"; + my $rows = $dbh->do($query); + + if ($rows == undef) + { error("failed to touch post $id !"); } + + return 1; + } + +sub update_thread_size + { + my ($id) = @_; + my @row; + my $rows; + $id = $dbh->quote($id); + my $query = "SELECT SUM(size) FROM files WHERE thread=$id"; + $sth = $dbh->prepare($query); + $sth->execute(); + (@row) = $sth->fetchrow_array(); + $size = $row[0]; + $sth->finish (); + + $size = $dbh->quote($size); + $query = "UPDATE threads SET size=$size WHERE id=$id"; + $rows = $dbh->do($query); + } + +sub update_thread_display + { + my ($id, $disp) = @_; + $id = $dbh->quote($id); + $disp = $dbh->quote($disp); + $query = "UPDATE threads SET display=$disp WHERE id=$id"; + $dbh->do($query); + } + +sub update_thread_color + { + my ($id, $disp) = @_; + $id = $dbh->quote($id); + $disp = $dbh->quote($disp); + $query = "UPDATE threads SET color=$disp WHERE id=$id"; + $dbh->do($query); + } + +sub update_thread_zipped + { + my ($id, $val) = @_; + $id = $dbh->quote($id); + $val = $dbh->quote($val); + $query = "UPDATE threads SET zipped=$val WHERE id=$id"; + $dbh->do($query); + } + +sub update_thread_viewed + { + my ($id, $val) = @_; + $id = $dbh->quote($id); + $val = $dbh->quote($val); + $query = "UPDATE threads SET viewed=$val WHERE id=$id"; + $dbh->do($query); + } + +sub get_threads + { + my @rows; + my $query; + my @keys = qw(id title username keyword date size private allowed flagged color viewed revision); + my $rows = 0; + + $query = "SELECT id,title,username,keyword,lastmodified,size,private,allowed,flagged,color,viewed,revision FROM threads"; + + print "$query
\n" if ($DEBUG); + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + for (my $i = 0; $i < @row; $i++) + { + $temphash{$keys[$i]} = $row[$i]; + } + $rows[$rows] = \%temphash; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No posts!\n" if ($DEBUG); + return -1; + } + + for (my $i = 0; $i < @rows; $i++) + { + $rows[$i]{comments} = count_comments($rows[$i]{id}); + $rows[$i]{files} = count_files($rows[$i]{id}); + $rows[$i]{tags} = get_tags_for_thread($rows[$i]{id}); + } + + return \@rows; + } + +sub throttle_threads + { + my ($args) = @_; + my $keyword = $args->{keyword} || undef; + my $tag = $args->{tag} || undef; + my $limit = $args->{limit} || undef; + my $newest = $args->{newest} || undef; + my $oldest = $args->{oldest} || undef; +# my ($keyword, $limit, $newest, $oldest) = @_; + my @rows; + my $query; + my $where = "WHERE"; + my @keys = qw(id title username keyword date size private allowed flagged color viewed revision); + my $rows = 0; + + $query = "SELECT threads.id,title,threads.username,keyword,lastmodified,size,private,allowed,flagged,color,viewed,revision FROM threads"; + + if (defined($tag)) + { + $tag = $dbh->quote($tag); + $query .= ",threadstags,tags WHERE threads.id=threadstags.threadid AND threadstags.tagid=tags.id AND tags.tag=$tag"; + + } + elsif (defined($keyword) && $keyword ne "all" && $keyword != -1) + { + if ($keyword eq "unsorted") + { $query .= " WHERE ISNULL(keyword)"; } + else + { + $keyword = $dbh->quote($keyword); + $query .= " WHERE keyword=$keyword"; + } + $where = "AND"; + } + + if (defined($newest) && $newest ne "now") + { + $query .= " $where lastmodified < $newest"; + $where = "AND"; + } + if (defined($oldest)) + { + $query .= " $where lastmodified > $oldest"; + $where = "AND"; + } + $query .= " ORDER BY lastmodified DESC"; + if ($limit) + { $query .= " LIMIT $limit"; } + + print "$query
\n" if ($DEBUG); + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + for (my $i = 0; $i < @row; $i++) + { + $temphash{$keys[$i]} = $row[$i]; + } + $rows[$rows] = \%temphash; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No posts!\n" if ($DEBUG); + return -1; + } + + for (my $i = 0; $i < @rows; $i++) + { + $rows[$i]{comments} = count_comments($rows[$i]{id}); + $rows[$i]{files} = count_files($rows[$i]{id}); + $rows[$i]{tags} = get_tags_for_thread($rows[$i]{id}); + } + + return \@rows; + } + +sub get_threads_by_user + { + my ($uname) = @_; + my @rows; + my $query; + my @keys = qw(id title username keyword date size private allowed flagged color viewed revision); + my $rows = 0; + + $uname = $dbh->quote($uname); + $query = "SELECT id,title,username,keyword,lastmodified,size,private,allowed,flagged,color,viewed,revision FROM threads WHERE username=$uname"; + + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + for (my $i = 0; $i < @row; $i++) + { + $temphash{$keys[$i]} = $row[$i]; + } + $rows[$rows] = \%temphash; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No posts!\n" if ($DEBUG); + return -1; + } + + for (my $i = 0; $i < @rows; $i++) + { + $rows[$i]{comments} = count_comments($rows[$i]{id}); + $rows[$i]{files} = count_files($rows[$i]{id}); + $rows[$i]{tags} = get_tags_for_thread($rows[$i]{id}); + } + + return \@rows; + } + +sub get_threads_by_tag + { + my ($tag) = @_; + my @rows; + my $query; + my @keys = qw(id title username keyword date size private allowed flagged color viewed revision); + my $rows = 0; + + $tag = $dbh->quote($tag); + $query = "SELECT threads.id,title,threads.username,keyword,lastmodified,size,private,allowed,flagged,color,viewed,revision FROM threads,threadstags,tags WHERE threads.id = threadstags.threadid AND threadstags.tagid = tags.id AND tags.tag = $tag"; + print $query."
" if ($DEBUG); + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + for (my $i = 0; $i < @row; $i++) + { + $temphash{$keys[$i]} = $row[$i]; + } + $rows[$rows] = \%temphash; + + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No posts!\n" if ($DEBUG); + return -1; + } + + for (my $i = 0; $i < @rows; $i++) + { + $rows[$i]{comments} = count_comments($rows[$i]{id}); + $rows[$i]{files} = count_files($rows[$i]{id}); + $rows[$i]{tags} = get_tags_for_thread($rows[$i]{id}); + } + + return \@rows; + } + +sub get_threads_by_keyword + { + my ($keyword) = @_; + my @rows; + my $query; + my @keys = qw(id title username keyword date size private allowed flagged color viewed revision); + my $rows = 0; + + $keyword = $dbh->quote($keyword); + $query = "SELECT id,title,username,keyword,lastmodified,size,private,allowed,flagged,color,viewed,revision FROM threads WHERE keyword=$keyword"; + + print $query."
" if ($DEBUG); + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + for (my $i = 0; $i < @row; $i++) + { + $temphash{$keys[$i]} = $row[$i]; + } + $rows[$rows] = \%temphash; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No posts!\n" if ($DEBUG); + return -1; + } + + for (my $i = 0; $i < @rows; $i++) + { + $rows[$i]{comments} = count_comments($rows[$i]{id}); + $rows[$i]{files} = count_files($rows[$i]{id}); + $rows[$i]{tags} = get_tags_for_thread($rows[$i]{id}); + } + + return \@rows; + } + +sub update_flagged + { + my ($id, $state) = @_; + + $id = $dbh->quote($id); + $state = $dbh->quote($state); + my $query = "UPDATE threads SET flagged=$state WHERE id=$id"; + print $query."
" if ($DEBUG); + my $rows = $dbh->do($query); + + if ($rows == 0) + { error("failed to switch post $thread!"); } + + return 1; + } + +sub update_thread_title + { + my ($id, $state) = @_; + + $id = $dbh->quote($id); + $state = $dbh->quote($state); + my $query = "UPDATE threads SET title=$state WHERE id=$id"; + print $query."
" if ($DEBUG); + my $rows = $dbh->do($query); + + if ($rows == 0) + { error("failed to switch post $thread!"); } + + return 1; + } + +sub update_thread_tag + { + my ($id, $state) = @_; + + $id = $dbh->quote($id); + } + +sub update_thread_keyword + { + my ($id, $state) = @_; + + $id = $dbh->quote($id); + if ($state ne "NULL") + { $state = $dbh->quote($state); } + my $query = "UPDATE threads SET keyword=$state WHERE id=$id"; + print $query."
" if ($DEBUG); + my $rows = $dbh->do($query); + + if ($rows == 0) + { error("failed to switch post $thread!"); } + + return 1; + } + + +######################################### +# KEYWORDS +######################################### + +sub get_tags + { + my @rows; + my @keys = qw(id tag createdate owner ops public display); + my %finalhash; + my $query = "SELECT id,tag,createdate,owner,ops,public,display FROM tags"; + print $query."
" if ($DEBUG); + $sth = $dbh->prepare( $query ); + $sth->execute(); + while ( my (@row) = $sth->fetchrow_array() ) + { + my %temphash; + for ( my $i = 0; $i < @row; $i++ ) + { $temphash{$keys[$i]} = $row[$i]; } + $finalhash{$temphash{"tag"}} = \%temphash; + $rows++; + } + $sth->finish(); + if ( $rows == 0 ) + { +# print "No tags!\n" if ($DEBUG); + return -1; + } + return \%finalhash; + } + +sub get_keywords + { + my @rows; + my $query; + my @keys = qw(id keyword threads owner ops public agglutinate color); + my $rows = 0; + my %finalhash; + + $query = "SELECT id,keyword,threads,owner,ops,public,agglutinate,color FROM keywords"; + + print $query."
" if ($DEBUG); + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + for (my $i = 0; $i < @row; $i++) + { + $temphash{$keys[$i]} = $row[$i]; + } + $finalhash{$temphash{"keyword"}} = \%temphash; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No keywords!\n" if ($DEBUG); + return -1; + } + + return \%finalhash; + } + +sub get_keyword + { + my ($keyword) = @_; + my @rows; + my $query; + my @keys = qw(id keyword threads owner ops public agglutinate color); + my $rows = 0; + my %finalhash; + + $keyword = $dbh->quote($keyword); + $query = "SELECT id,keyword,threads,owner,ops,public,agglutinate,color FROM keywords WHERE keyword=$keyword"; + + print $query."
" if ($DEBUG); + $sth = $dbh->prepare($query); + $sth->execute(); + if ((@row) = $sth->fetchrow_array()) + { + for (my $i = 0; $i < @row; $i++) + { + $finalhash{$keys[$i]} = $row[$i]; + } + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No keywords!\n" if ($DEBUG); + return -1; + } + + return \%finalhash; + } + +sub add_keyword + { + my ($newk) = @_; + my @keys = qw(keyword threads owner ops public agglutinate color); + my @qkeys; + my %q; + my $i = 0; + + $q{createdate} = $dbh->quote(time); + + foreach my $key (@keys) + { + if (exists $newk->{$key}) + { + $q{$key} = $dbh->quote($newk->{$key}); + } + } + + @qkeys = keys %q; + + $query = "INSERT keywords SET "; + foreach my $k (@qkeys) + { + $query .= $k."=".$q{$k}; + if (++$i != @qkeys) + { $query .= ","; } + } + + print $query."
" if ($DEBUG); + my $rows = $dbh->do($query); + + if ($rows == 0) + { error("failed to add keyword $newk->{keyword}!"); } + + return 1; + } + +sub update_keyword + { + my ($keyword, $newk) = @_; + my @keys = qw(threads ops public agglutinate color); + my @qkeys; + my %q; + my $i = 0; + + my $keyword = $dbh->quote($keyword); + + foreach my $key (@keys) + { + if (defined($newk->{$key})) + { + $q{$key} = $dbh->quote($newk->{$key}); + } + } + + @qkeys = keys %q; + + $query = "UPDATE keywords SET "; + foreach my $k (@qkeys) + { + $query .= $k."=".$q{$k}; + if (++$i != @qkeys) + { $query .= ","; } + } + $query .= " WHERE keyword=$keyword"; + + print $query."
" if ($DEBUG); + my $rows = $dbh->do($query); + + if ($rows == 0) + { error("failed to update keyword $keyword!"); } + + return 1; + } + +sub update_keyword_color + { + my ($key, $disp) = @_; + $key = $dbh->quote($key); + $disp = $dbh->quote($disp); + $query = "UPDATE keywords SET color=$disp WHERE keyword=$key"; + $dbh->do($query); + } + +######################################### +# PRIVACY WHITELISTING +######################################### + +sub switch_thread_privacy + { + my ($id, $state) = @_; + + $id = $dbh->quote($id); + $state = $dbh->quote($state); + my $query = "UPDATE threads SET private=$state WHERE id=$id"; + my $rows = $dbh->do($query); + + if ($rows == 0) + { error("failed to switch post $thread!"); } + + switch_file_privacy($id, $state, 1); + + return 1; + } + +sub switch_file_privacy + { + my ($id, $state, $q) = @_; + + unless (defined($q)) + { + $id = $dbh->quote($id); + $state = $dbh->quote($state); + } + + my $query = "UPDATE files SET private=$state WHERE thread=$id"; + my $rows = $dbh->do($query); + + return 1; + } + +sub switch_whitelist + { + my ($id, $state) = @_; + + $id = $dbh->quote($id); + $state = $dbh->quote($state); + my $query = "UPDATE threads SET allowed=$state WHERE id=$id"; + my $rows = $dbh->do($query); + + if ($rows == undef) + { error("failed to switch post $thread!"); } + + return 1; + } + + +######################################### +# ET CETERA + +sub commit_murder + { + my ($uname) = @_; + $uname = $dbh->quote($uname); + $dbh->do("UPDATE users SET ulevel=-2 WHERE username=$uname"); + } + +sub commit_blessing + { + my ($uname) = @_; + my $lev; + $uname = $dbh->quote($uname); + $sth = $dbh->prepare("SELECT ulevel FROM users WHERE username=$uname"); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { $lev = $row[0]; } + $sth->finish(); + + $lev++; + $lev = $dbh->quote($lev); + $dbh->do("UPDATE users SET ulevel=$lev WHERE username=$uname"); + } + +sub delete_thread + { + my ($id) = @_; + my $rows; + $id = $dbh->quote($id); + $dbh->do("DELETE FROM files WHERE thread=$id"); + $dbh->do("DELETE FROM comments WHERE thread=$id"); + $dbh->do("DELETE FROM threads WHERE id=$id"); + system("$RM_PATH", "-rf", "$data_path/$id"); + } + +sub get_participation + { + my ($id) = @_; + $id = $dbh->quote($id); + my %temphash; + my $i = 0; + + $sth = $dbh->prepare("SELECT username FROM files WHERE thread=$id"); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { $temphash{$row[0]} = 1; } + $sth->finish(); + + $sth = $dbh->prepare("SELECT username FROM comments WHERE thread=$id"); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { $temphash{$row[0]} = 1; } + $sth->finish(); + + foreach (keys %temphash) + { $i++; } + + return $i; + } + +{ +my $usermax = 0; # cache +my %rands; +sub get_random_user + { + my $selected = -1; + my $randy = 1; + + unless ($usermax) + { + my @keys = qw[$usermax]; + my $query = "SELECT MAX(id) FROM users"; + print $query."
" if ($DEBUG); + $sth = $dbh->prepare($query); + $sth->execute(); + ($usermax) = $sth->fetchrow_array(); + $sth->finish (); + } + + do + { $randy = (int rand $usermax) + 1; } + while ( exists($rands{$randy}) ); + $rands{$randy} += 1; + $selected = get_username($randy); + + print "Random user: $selected
" if ($DEBUG); + + return $selected; + } +} + +sub get_random_flagged_image + { + my @rows; + my $rows = 0; + my $selected = -1; + my @keys = qw[thread filename]; + my $query = "SELECT threads.id,files.filename FROM threads,files WHERE threads.flagged=files.id AND threads.private=0"; + print $query."
" if ($DEBUG); + $sth = $dbh->prepare($query); + $sth->execute(); + while (my (@row) = $sth->fetchrow_array()) + { + my %temphash; + for (my $i = 0; $i < @row; $i++) +{ $temphash{$keys[$i]} = $row[$i]; } + $rows[$rows] = \%temphash; + $rows++; + } + $sth->finish(); + + if ($rows == 0) + { + print "No flagged images!
\n" if ($DEBUG); + return -1; + } + + $selected = $rows[(int rand @rows)]; + print "Random flagged image: $selected->{thread}/$selected->{filename}
" if ($DEBUG); + + return $selected; + } +# + +### given an id: +### my (@fields) = get_row_from_id("threads", $id); +### ("author, startdate, lastmodified, flagged_file_id") + +### my ($ = get_rows_from_pid("files", $pid); +### select %(id, path, filename, author, date, size) +### from files where pid = $pid +### foreach $aref (@$arrayref) { my $id = $aref[0]; %q{$id}=($aref[1..$#$aref]); } + +### get_rows_from_pid("comments", $pid); +### select %(id, author, date, comment) +### from comments where pid = $pid + +1; + diff --git a/lib/files.pm b/lib/files.pm new file mode 100644 index 0000000..71ccafa --- /dev/null +++ b/lib/files.pm @@ -0,0 +1,241 @@ + + +######################################################## +# FILES +######################################################## + +sub zip_this_button + { + my ($t) = @_; + + return if ($USER == -1); + return if (check_key($t->{display}, "no-zip-button")); + return if (check_key($t->{display}, "nfl")); + if ($t->{zipped} == -1) + { + print qq!
!; + my $zip = retrieve_zip_mechanism($t); + if ($zip != -1) + { + print qq!A ZIP OF THESE FILES IS AVAILABLE:
$zip!; + } + else + { + print qq!FOLDER ARCHIVAL IN PROGRESS
!; + print qq!CLICK HERE IN A MOMENT!; + } + print qq!
\n!; + } + elsif ($t->{zipped} == 0 && ($t->{files} > 10 || ($t->{files} > 3 && $t->{size} < 160*1024*1024))) + { + onebutton($t->{id}, "zip", "ZIP THESE FILES"); + } + elsif ($t->{zipped} == 1) + { + my $zipfile = generate_zip_filename($t); + if (! -e qq!$data_path/$t->{id}/$zipfile!) + { + update_thread_zipped($t->{id}, 0); + onebutton($t->{id}, "zip", "ZIP THESE FILES"); + } + else + { + print qq!
!; + print qq!A ZIP OF THESE FILES IS AVAILABLE:
$zipfile!; + print qq!
\n!; + } + } + } + +sub retrieve_zip_mechanism + { + my ($t) = @_; + my $zipfile = generate_zip_filename($t); + if (-e qq!$data_path/$t->{id}/$zipfile!) + { + my @stats = stat(qq!$data_path/$t->{id}/$zipfile!); + my $size = $stats[7]; + my $date = $stats[9]; + add_file($t->{id}, $t->{username}, $zipfile, $size, $date); + update_thread_zipped($t->{id}, 1); + update_thread_size($t->{id}, $t->{size}); + system($CHMOD_PATH, "644", "$data_path/$t->{id}/$zipfile"); + $t->{zipped} = 1; + return $zipfile; + } + return -1; + } + +sub generate_zip_filename + { + my ($t) = @_; + my $cleantitle = $t->{title}; + $cleantitle =~ s/\W//g; + $cleantitle =~ s/^\s+//; + $cleantitle =~ s/\s+$//; + return qq($cleantitle.zip); + } + +sub situate_files + { + my ($pid, $uname) = @_; + my ($filename, $size, $date); + my $newfilename; + my $totalsize = 0; + + foreach my $k (keys %$input) + { + next if ($k !~ /^file/); + next if (! -e $temp_path."/".$$input{$k}); + $filename = $$input{$k}; + + if ($filename =~ /temp_$/) + { system("$RM_PATH", $temp_path."/".$filename); } + else + { + print $filename if ($DEBUG); + if (! -e $data_path."/".$pid) + { + print "creating $data_path/$pid
\n" if $DEBUG; + system("$MKDIR_PATH", $data_path."/".$pid); + system("$MKDIR_PATH", $data_path."/".$pid."/.thumb"); + system("$CHMOD_PATH", "755", $data_path."/".$pid); + system("$CHMOD_PATH", "755", $data_path."/".$pid."/.thumb"); + } + + @stats = stat($temp_path."/".$filename); + $size = $stats[7]; + $date = $stats[9]; + + $newfilename = $filename; + $newfilename =~ s/temp_//; + my $tfile = $newfilename; + my $i = 2; + while (-e $data_path."/".$pid."/".$tfile) + { + $tfile = $newfilename; + $tfile =~ s/(\....)$/-$i$1/; + $i++; + } + $newfilename = $tfile; + system("$MV_PATH", $temp_path."/".$filename, $data_path."/".$pid."/".$newfilename); + + add_file($pid, $uname, $newfilename, $size, $date); + $totalsize += $size; + } + } + update_thread_size($pid); + update_thread_zipped($pid, 0); + } + + +sub flush_files + { + foreach my $k (keys %$input) + { + next if ($k !~ /^file/); + next if (! -e $temp_path."/".$input->{$k}); + $filename = $input->{$k}; + system("$RM_PATH", $temp_path."/".$filename); + } + } + +sub file_list + { + my ($files, $cbox, $whitelist, $skip_images, $sorty) = @_; + my $r = 0; + my $size = 0; + + return if ($files == -1); + if (!defined($cbox)) { $cbox = 0; } + if (!defined($whitelist)) { $whitelist = 0; } + if (!defined($skip_images)) { $skip_images = 0; } + return if (@$files == $skip_images); + + if ($DEBUG) + { + print qq!Printing file list. File ids:!; + for (my $i = 0; $i < @$files; $i++) + { print $files->[$i]{id}." "; } + print qq!

\n\n!; + } + + print < +FILES + +# if ($sorty eq "size") + if ($0 !~ /(details|maintain)/) + { $sorty = sub { sort {$b->{date} <=> $a->{date}} @_ }; } + else + { $sorty = sub { sort {lc($a->{filename}) cmp lc($b->{filename})} @_ }; } + foreach my $file ($sorty->(@$files)) + { + next if (($file->{username} ne $USER->{username}) && $file->{private} && !$whitelist && $USER->{ulevel} != 3); + next if ($skip_images && $file->{filename} =~ /\.(jpe?g|gif|png)/i); + display_file($file, $r, $cbox); + $size += $file->{size}; + $r = $r ? 0 : 1; + } + + print ''; + print ''; + print qq!total size: !.hushsize($size, 1, 1).qq!\n\n!; + } + +sub display_file + { + my ($f, $r, $cbox) = @_; + my $color = carbondate($f->{date}); + my $checked = 0; + my $bright = 0; + $checked = check_key($cbox, $f->{id}); + + if ($DEBUG) + { + print qq!Displaying file $f->{id}!; + print qq! (checked)! if ($checked); + print qq!
\n!; + } + + print qq[]; + if ($cbox) + { + print qq!!; + } + + if ($0 !~ /(details|maintain)/) + { + print qq[go to post >]; + } + + if ((time - $f->{date}) < 150000 || $checked) + { print qq[]; } + else + { print qq[]; } + if (length($f->{filename}) > 50) + { + my $filen = substr $f->{filename}, 0, 47; + my $filext = substr $f->{filename}, -4, 4; + print qq[$filen..$filext]; + } + else + { + print qq[$f->{filename}]; + } + print qq[]; + + my ($date, $time) = verbosedatetime($f->{date}); + +# print qq[]. (get_age($f->{date})), qq[]; + print qq[$date]; + print qq[ $time]; + print qq[], hushsize($f->{size},2), qq[]; + print qq[$f->{username} ]; + print qq[\n]; + } + +1; + diff --git a/lib/format.pm b/lib/format.pm new file mode 100644 index 0000000..d2129ad --- /dev/null +++ b/lib/format.pm @@ -0,0 +1,414 @@ +our @months = qw[Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec]; +our $dateoffset = -1; + +sub get_tz_offset + { + my $tz = $USER->{timezone}; + $tz += $BUCKY_TIMEZONE_OFFSET; + $tz *= 3600; + return $tz; + } + +sub when_is_it + { + my ($now) = @_; + # $now = time unless $now != undef; + my $offset = get_tz_offset(); # if ($dateoffset == -1); + $now += $offset; + return $now; + } + +sub verbosedate + { + my ($date) = @_; + $date = when_is_it($date); + my ($m,$h,$d,$n,$y) = (localtime $date)[1..5]; + my $meridian; + if ($h == 0) + { $h = 12; $meridian = " am"; } + elsif ($h == 12) + { $meridian = " pm"; } + elsif ($h > 12) + { $h -= 12; $meridian = " pm"; } + else + { $meridian = " am"; } + return sprintf("%2d-%s-%d %2d:%02d%s", $d, $months[$n], ($y+1900), $h, $m, $meridian); + } + +sub verbosedatetime + { + my ($date) = @_; + $date = when_is_it($date); + my ($m,$h,$d,$n,$y) = (localtime $date)[1..5]; + my $meridian; + if ($h == 0) + { $h = 12; $meridian = " am"; } + elsif ($h == 12) + { $meridian = " pm"; } + elsif ($h > 12) + { $h -= 12; $meridian = " pm"; } + else + { $meridian = " am"; } + return ((sprintf("%d-%s-%d", $d, $months[$n], ($y+1900))), (sprintf("%2d:%02d%s", $h, $m, $meridian))); + } + +sub plaindate + { + my ($date) = @_; + $date = when_is_it($date); + my ($m,$h,$d,$n,$y) = (localtime $date)[1..5]; + my $meridian; + if ($h == 0) + { $h = 12; $meridian = " am"; } + elsif ($h == 12) + { $meridian = " pm"; } + elsif ($h > 12) + { $h -= 12; $meridian = " pm"; } + else + { $meridian = " am"; } + return sprintf("%2d-%s-%d at %d:%02d%s", $d, $months[$n], ($y+1900), $h, $m, $meridian); + } + +sub commatize + { + my $number = shift; + my $txt; + my @txt; + my $i; + my $counter = 0; + if ($number > 1024) + { + $number /= 1024; + unshift @txt, (($number*10) % 10); + unshift @txt, "."; + } + + do + { + $i = $number % 10; + $number = int($number / 10); + if ($number && !(++$counter % 3)) + { $i = ' '.$i; } + unshift @txt, $i; + } + while($number); + + $txt = join "", @txt; + return $txt; + } + +sub carbondate + { + my ($date, $nobold) = @_; + my $span = (time - $date); + + my $boldnew = (!defined($nobold) || !($nobold)) ? 1 : 0; + + if ($boldnew && $span < 86400) # modified today + { $color = "new"; } + elsif ($span < 604800) # modifed this week + { $color = "recent"; } + elsif ($span < 1209600) # modifed 2 weeks ago + { $color = "med"; } + elsif ($span < 3024000) # modifed 5 weeks ago + { $color = "old"; } + elsif ($span < 12315200) # modifed 6 months ago + { $color = "older"; } + else + { $color = "quiet"; } + + return $color; + } + +sub pretty_date + { + my ($timeinsecs, $nobold) = @_; + my $date = verbosedate($timeinsecs); + my $color = carbondate($timeinsecs, $nobold); + + return qq($date); + } + +sub extend_span + { + my ($os, $od) = @_; + if ($os eq "now") + { $os = time; } + my $span = $os - $od; + if ($DEBUG) + { + print qq(\nSTART: $os
END: $od
SPAN: $span
); + print qq(DAYS: ).int($span / (60*60*24)).qq(
\n); + } + return ($od, int($od-($span*2.6))); + } + +sub hushview + { + my ($n, $bias, $nobold) = @_; + $bias = 1 unless ($bias); + my $txt = commatize($n); + if ($n < 30) + { $n = 0 if (!$n); return qq!$n!.qq! v.!; } + if ($n < 200) + { return qq!$txt!.qq! v.!; } + elsif ($n < 500) + { return qq!$txt!.qq! v.!; } + elsif ($n < 1000) + { return qq!$txt!.qq! v.!; } + elsif ($n < 5000) + { return qq!$txt!.qq! kv.!; } + elsif ($nobold || $n < 10000) + { return qq!$txt!.qq! kv.!; } + else + { return qq!$txt!.qq! kv.!; } + } + +sub hushsize + { + my ($n, $bias, $nobold) = @_; + $bias = 1 unless ($bias); + my $txt = commatize($n / 1024); + if ($n < 1024) + { $n = 0 if (!$n); return qq!$n!.qq! b.!; } + if ($n < 1024*1024) + { return qq!$txt!.qq! kb.!; } + elsif ($n < (20000000/$bias)) + { return qq!$txt!.qq! mb.!; } + elsif ($n < (50000000/$bias)) + { return qq!$txt!.qq! mb.!; } + elsif ($n < (80000000/$bias)) + { return qq!$txt!.qq! mb.!; } + elsif ($nobold || $n < (170000000/$bias)) + { return qq!$txt!.qq! mb.!; } + else + { return qq!$txt!.qq! mb.!; } + } + +sub hushnull + { + my ($n, $unit, $nobold) = @_; + my $out = ''; + + if ($n < 3) + { $out .= qq!$n!; } + elsif ($n < 6) + { $out .= qq!$n!; } + elsif ($n < 10) + { $out .= qq!$n!; } + elsif ($n < 16) + { $out .= qq!$n!; } + elsif ($nobold || $n < 21) + { $out .= qq!$n!; } + else + { $out .= qq!$n!; } + $out .= " $unit." if ($unit); + $out .= ""; + return $out; + } + +sub courtesy_s + { + my ($v) = @_; + if ($v == 1) + { return ""; } + else + { return "s"; } + } + +sub linebr + { + my ($text, $short) = @_; + chomp $text; + unless ($text =~ /($1<\/a> /g; + } + } + $text =~ s/\s((dj )?phatty)/ $1<\/a>/i; + $text =~ s/( )/  /g; + $text =~ s/\r?\n/
/g; + # avoid stuffing tables, lists with br's + $text =~ s/tr>
/tr>/g; + $text =~ s/td>
/td>/g; + $text =~ s/ul>
/ul>/g; + $text =~ s/ol>
/ol>/g; + return $text; + } + +sub tidy_urls + { + my ($line) = @_; + if ($line =~ /https?:\/\//) + { + my ($pre, $post) = split /http/, $line, 2; + my ($url, $space, $rest) = split /(\s)/, $post, 2; + # splitting on regex with parens produces + # a bonus secret list element -- whatever (it) matched + if (($url =~ /gif$/i || $url =~ /png$/i || $url =~ /jpg$/i) && ($pre !~ /$space); + } + else + { + my $thumb_url = $url; # lc($url); + # $thumb_url =~ s/(data\/\d+\/)/$1.thumb\/b./; + $line = qq($pre$space); + } + } + else + { + my $curl = $url; + $curl =~ s!^s?://(www.)?!!i; + $curl =~ s!^([-A-Za-z0-9\.]+)/.*!$1!; # get domain-part of url + $line = qq($pre[$curl]$space); + } + $line .= tidy_urls($rest); + } + return $line; + } + +sub nbsp + { ' ' } +sub middot + { ' · ' } + +sub profile_link + { + my ($username) = @_; + my $link = +# qq() . + qq() . + $username . + qq(); + return $link; + } +sub message_link + { + my ($username) = @_; + my $link = +# qq() . + qq() . + $username . + qq(); + return $link; + } + +sub details_link + { + my ($t) = @_; + if ($t != -1 && $BUCKY_KEYWORD_IN_DETAILS_URL) + { return $t->{keyword}; } + else + { return $BUCKY_LEXICON_DETAILS; } + } + +sub get_revision + { + my ($thread) = @_; + return "" if ($thread->{revision} == 0); + my $rev = $thread->{revision}; + my $number = 0; + my $digits = ""; + my @letters = qw(z a b c d f g h j k l m n p q r s t v w x y); + do + { + $number = $rev % 21; + $rev = int($rev / 21); + $digits = $letters[$number].$digits; + } + while($rev != 0); + return $digits; + } + +sub get_age + { + my ($t) = @_; + my $age = abs( time - $t ); + my $m; + + use integer; + + # now + if ($age < 5) + { return "now"; } + + # seconds + if ($age < 60) + { return sprintf ("%ds", $age); } + + # minutes + $age /= 60; + if ($age < 60) + { return sprintf ("%dm", $age); } + + # hours + $m = $age % 60; + $age /= 60; + if ((int($m) > 0) && ($age < 2)) + { return sprintf ("%dh%dm", $age, $m); } + elsif ($age < 24) + { return sprintf ("%dh", $age); } + + # days + $age /= 24; + if ($age < 7) + { return sprintf ("%dd", $age); } + + # weeks + my $d = $age % 7; + $age /= 7; + if ($age < 12) + { return sprintf ("%dw", $age); } + + # months + my $m = $age / 4; + my $w = $age % 4; + $age /= 4; + $age /= 12; + if ($m < 12) + { + return sprintf ("%dm", $m); + } + + # years + return sprintf("%dy", $age); + +# # hours +# $m = $age % 60; +# $age /= 60; +# if ((int($m) > 0) && ($age < 2)) +# { return sprintf ("%dh%dm", $age, $m); } +# elsif ($age < 24) +# { return sprintf ("%dh", $age); } +# +# # days +# $age /= 24; +# if ($age < 30) +# { return sprintf ("%dd", $age); } +# +# # months +# my $m = $age / 30; +# if ($age < 365) +# { return sprintf ("%dmo", $m); } +# +# # years +# $m = $age % 365; +# $m /= 30; +# $age /= 365; +# if ($m > 0) +# { return sprintf("%dy%dm", $age, $m); } +# else +# { return sprintf("%dy", $age); } + } + +1; + diff --git a/lib/forms.pm b/lib/forms.pm new file mode 100644 index 0000000..5f31368 --- /dev/null +++ b/lib/forms.pm @@ -0,0 +1,854 @@ + +############################################# +# FORMS +############################################# + +sub sticky_button + { + my ($keyword) = @_; + my $checked = ''; + if (check_key($USER->{stickies}, $keyword)) + { $checked = " checked"; } + print qq(
); + print "sticky? "; + print qq(); + print qq!
!; + print qq{} if ($DEBUG); + print qq{}; + print qq{}; + print qq{}; + print qq{
}; + print qq(
\n); + } + +# short upload form for sidebar +sub upload_form + { + my ($keyword) = @_; +print < +

+make a new post +
+ +
+MID + + print qq{\n} if ($DEBUG); + if ($keyword) + { + print "category: "; + keyword_pulldown($keyword); + print "
\n"; + } + + print < + +subject:
+ +
+ +description:
+ +
+ + + + +
big post form |
+ +
 +
+MID2 + } + +############################################# + +sub reply_form + { + my ($id, $t) = @_; + my $submittag; + return unless ($USER != -1 ); + if ($t->{comments} == 0) + { $submittag = "POST"; } + else + { $submittag = "REPLY"; } + + print qq{
\n}; + + if ($DEBUG) { print qq!\n\n!; } + + print <POST A COMMENT . . . + + + + + + +FORMEND + + if (! check_key($t->{display}, "no-upload")) + { + print < + + +
+ + + +
+ +
+FORMEND + } + else + { + print qq(); + } + print < + +
+big form + + +
+FORMEND + } + +############################################# + +sub curt_post_form + { + my ($c) = @_; + my $pid = ($c->{parent_id} > 0) ? $c->{parent_id} : -1; + + print qq{
\n}; + + if ($DEBUG) { print qq!\n\n!; } + + my $date = plaindate($c->{date}); + my $comment = $c->{comment}; + $comment =~ s/&/&/g; + $comment =~ s/>/>/g; + $comment =~ s/$c->{username} posted this comment on $date: + + + + + +
+ + +
+FORMEND + } + +############################################# + +sub curt_reply_form + { + my ($c, $t, $k) = @_; + + print qq{
\n}; + + if ($DEBUG) { print qq!\n\n!; } + if ($c != -1) + { + my $date = plaindate($c->{date}); + print <$c->{username} posted this comment on $date: +
$c->{comment}
+ + +FORMEND + } + else + { + print qq!\n!; + } + print < + + + +
+ + +
+FORMEND + } + +############################################# + +sub hoot_form + { + my ($id, $t) = @_; + print qq{
\n}; + if ($DEBUG) { print qq!\n\n!; } + print < + + + + + +
+big form + +FORMEND + print ""; + } + +############################################# + +sub print_garrow + { + my ($a, $b) = @_; + $a =~ s/\s/ /g; + print qq!$a:$b\n!; + } + +############################################# + +sub onebutton + { + my ($id, $key, $button) = @_; + + print qq(
\n); + print qq(\n); + print qq(\n); + print qq(\n
\n); + } + +sub onecheckbox + { + my ($key, $gloss, $tokens) = @_; + + print qq(\n); + print qq() . + qq( $gloss ); + } + +sub oneradiobutton + { + my ($key, $value, $gloss, $check) = @_; + + print qq(\n); + print qq() . + qq( $gloss ); + } + +############################################# + +sub privacy_select + { + my ($key, $level) = @_; + print ""; + print ""; + oneradiobutton($key, 0, $BUCKY_CONFIG->{PRIVACY_WORLD}, $level) if $BUCKY_CONFIG->{PRIVACY_WORLD}; + oneradiobutton($key, 1, $BUCKY_CONFIG->{PRIVACY_BBS}, $level) if $BUCKY_CONFIG->{PRIVACY_BBS}; + oneradiobutton($key, 1.5, $BUCKY_CONFIG->{PRIVACY_KEYWORD}, $level) if $BUCKY_CONFIG->{PRIVACY_KEYWORD}; + oneradiobutton($key, 2, $BUCKY_CONFIG->{PRIVACY_OWNER}, $level) if $BUCKY_CONFIG->{PRIVACY_OWNER}; + print ""; + print "
"; + } + +############################################# + +sub admin_form + { + my ($id, $t, $f, $k) = @_; + print < + + +
+
+exit settings screen


+adminhead + ($many, $flagged) = find_jpeg($files, $t->{flagged}); + print qq!
!; + + thread_display_settings($id, $t, $k); + print q{ }; + print q{}; + print q{}; + keyword_display_settings($id, $t, $k); + print q{ }; + + if ($t->{files} > 0) + { + print q{ }; + file_display_settings($id, $t); + print q{ }; + } + print q{}; + print q{}; + thread_delete_box($id); + print q{}; + print q{}; + } + +sub thread_display_settings + { + my ($id, $t, $k) = @_; + + my $rcolor = get_color($t, $k); + + print qq!
!; + print qq!
!; + print <display settings +
+keywordhead + print qq!
!; + print qq!
\n!; + print qq{\n} if ($DEBUG); + print qq{\n}; + print qq{\n}; + + print qq!!; + print qq!!; + print qq!!; + print qq!!; + print qq!!; + print qq!!; + print qq!!; + print qq!!; + print qq!!; + + print qq!!; + print qq!!; + print qq!!; + print qq!!; + print qq!
!; + print qq(title: ); + print qq!!; + print qq( ); + print qq!
!; + print qq(color: ); + print qq!!; + color_dropdown($rcolor, 0); + print qq!
 !; + + print qq!!; + print qq!!; + onecheckbox("no-upload", "disable file upload", $t->{display}); + print qq!!; + print qq!!; + onecheckbox("shorturl", "shorten urls", $t->{display}); + print qq!!; + print qq!!; + onecheckbox("editable", "comments editable by ops", $t->{display}); + print qq!!; + print qq!!; + onecheckbox("opset", "post settings available to ops", $t->{display}); + print qq!!; + print qq!!; + onecheckbox("no-zip-button", "no zip button", $t->{display}); + print qq!!; + + if ($t->{keyword} ne undef) + { + print qq!!; + onecheckbox("hidekws", "hide keyword list", $t->{display}); + print qq!!; + } + print qq!
!; + + if ($t->{files} > 5) + { + my $filelist = 1; + print qq!!; + print qq!!; + if (check_key($t->{display}, "ffl")) + { $filelist = 2; } + elsif (check_key($t->{display}, "nfl")) + { $filelist = 0; } + oneradiobutton("filelist", 2, "full file list", $filelist); + print qq!!; + oneradiobutton("filelist", 1, "trim if many images", $filelist); + print qq!!; + oneradiobutton("filelist", 0, "no file list", $filelist); + print qq!!; + print qq!
!; + } + else + { + print qq(); + } + + print qq(\n\n); + print qq!
!; + print qq!!; + + print qq!
!; + print qq!!; + print_garrow("date posted", (verbosedate($t->{createdate}))); + print_garrow("last changed", (verbosedate($t->{lastmodified}))); + print_garrow("total comments", (hushnull($t->{comments}))); + print_garrow("total files", (hushnull($t->{files}))); + my $par = get_participation($t->{id}); + my $ps = $par != 1 ? 's' : ''; + print_garrow("participating",(hushnull($par).qq! duder$ps!)); + if ($t->{zipped} == -1) + { + my $zipfile = retrieve_zip_mechanism($t); + if ($zipfile == 1) + { print_garrow("zipfile?", qq(in progress)); } + } + if ($t->{zipped} == 0) + { + print_garrow("zipfile?", qq(none)); + } + if ($t->{zipped} == 1) + { + my $zip = get_file_from_filename(generate_zip_filename($t)); + print_garrow("zipfile?", qq(exists, complete as of ).(verbosedatetime($zip->{date}))[0].qq(
freshen | flush)); + } + print qq!
!; + + print qq!
!; + print qq!
!; + + print qq!!; + print qq!!; + } + +sub keyword_display_settings + { + my ($id, $t, $k) = @_; + + print < +
+category & tag settings +
+keywordhead + +# no keyword set + if ($t->{keyword} eq undef) + { + print qq!
\n!; + print qq{\n} if ($DEBUG); + print qq{\n}; + print qq{\n}; + print qq!!; + print qq! + + + + +
SELECT ONE:  !; + keyword_pulldown($t->{keyword}); + print < + +
+or
make new category +
+kwform + } + else + { + print qq{current category: $k->{keyword}}; + + print qq! · detach!; + + if ($k->{owner} eq $USER->{username} || check_op($k) || $USER->{ulevel} == 3) + { + print qq! · settings!; + } + } + print qq(
); + print qq!
\n!; + print qq{\n} if ($DEBUG); + my $tags_string = tags_stringify( $t->{tags} ); + print qq{\n}; + print qq{\n}; + print qq{\n}; + + print qq(Tags: ); + print qq!!; + + print < + +
+
+privacy settings +
+kwform + + print qq!
\n!; + print qq{\n} if ($DEBUG); + print qq{\n}; + print qq{\n}; + + print qq!!; + print qq!!; + print qq!!; + print qq!
viewable by  ·!; + privacy_select("private", $t->{private}); + print qq!
!; + if ($t->{private} > 1) + { + print qq!\n!; + print qq!users checked off below will be able to read and update this post!; + if ($k != -1 && $k->{public} != 1) + { + print qq!,
but cannot see the rest of the keyword!; + } + print qq!.\n!; + print qq!!; + user_checkerboard($t->{allowed}, undef, $t->{username}); + } + print < + + +
+ +privend + } + +sub file_display_settings + { + my ($id, $t) = @_; + print < +file settings
+
+dirtop + + print qq!
!; + print qq{\n}; + print qq{\n}; + print qq{\n} if ($DEBUG); + print < + + + + · + + +actionform + file_list($files, -1, 1); + print < + +end + } + +sub thread_delete_box + { + my ($id) = @_; + print < + + + + + + + + + + +formend + } + +############################################# + +sub profile_form + { + my ($uname) = @_; + my $profile = get_user_profile($uname); + + print qq!
\n!; + print qq!! if ($DEBUG); + print qq!!; + + print <
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + +profileform + + print qq!\n!; + + print < + + + + +profileform + + if (-e $data_path."/profile/.thumb/pro.".$uname.".jpg") + { print qq!\n!; } + + $stick = $profile->{stickies}; + $sink = $profile->{sink}; + $stick =~ s/^ (.*)/$1/; + $stick =~ s/(.*) $/$1/; + $sink =~ s/^ (.*)/$1/; + $sink =~ s/(.*) $/$1/; + print < + + +profileform + print ""; + onecheckbox("welcome", "welcome box", $USER->{boxes}); + print ""; + onecheckbox("bPod", "bPod", $USER->{boxes}); + print ""; +# onecheckbox("radio", "radio free chompy (when broadcasting)", $USER->{boxes}); +# print ""; + onecheckbox("postform", "quick-post form", $USER->{boxes}); + print ""; + onecheckbox("hootbox", "chat", $USER->{boxes}); + print ""; + onecheckbox("photostream", "photostream", $USER->{boxes}); + print ""; + print < + + + + + +profileform + print ""; + onecheckbox("autoplay", "autoplay mp3s", $USER->{boxes}); + if ($USER->{'ulevel'} == 3) + { + print ""; + onecheckbox("showhidden", "show hidden posts", $USER->{boxes}); + } + print ""; + onecheckbox("nologout", "never log out (your cookie will not expire)", $USER->{boxes}); + print ""; + print < + + + + +
profile settings
Real name:
Email address:
AIM:
Phone:
Location:
Timezone:!; + print qq!!; + print qq!
Profile picture:
current profile picture: tick to delete picture
home page
Sticky keywords:
Change password?
please verify:		 +
+ +
+

+ + +

+ +profileform + return; + } + +############################################# + +sub message_form + { + my ($recipient, $oldmsg) = @_; + my $subject = ''; + $recipient = '' if ($recipient == -1); + + print qq{
\n}; + if ($DEBUG) { print qq!\n!; } + print qq!\n!; + if ($$oldmsg{mbox} =~ /drafts/) + { + print qq!\n!; + } + + print < + +
+
+FORMmid + + print qq!!; + print qq!!; + + if ($oldmsg == -1) + { + $subject = get_random_line("subjects"); + } + elsif ($$oldmsg{subject} =~ /^Re: / || $$oldmsg{mbox} =~ /drafts/) + { $subject = $$oldmsg{subject}; } + else + { $subject = "Re: ".$$oldmsg{subject}; } + + print qq! +
!; + print qq[to: ]; + print qq!!; + print < +need to find someone? +FORMrecip + print qq!
!; + print <subject: + +
+
+
+FORMsubj + + print qq[
\n]; + + print < + + +
+FORMEND + } + +sub login_form + { + my $uri = ''; + print qq{
\n}; + + if ($input->{redir} =~ /\?/) + { + my ($duh, $qs) = split /redir=/, $ENV{QUERY_STRING}, 2; + $uri .= "$qs"; + } + else + { + $uri .= $input->{redir}; + } + + if (defined($uri) && $uri !~ /logout/) + { print qq{\n}; } + + if ($DEBUG) + { print qq{\n}; } + print < + + + + + +
username:
password:
 
+ + +loginform + } + +1; diff --git a/lib/getargs.pm b/lib/getargs.pm new file mode 100644 index 0000000..bf3c08c --- /dev/null +++ b/lib/getargs.pm @@ -0,0 +1,134 @@ +# This is _getargs, a Perl/CGI argument reader capable of retrieving RFC1867 file uploads +# as well as "normal" URL-encoded input. +# (c) Vivtek 2000. Licensed under the terms of the GNU Public License. +# Documentation at http://www.vivtek.com/cgi/getargs.html +# +# You may freely use and copy this code for any purpose, as long as this comment block +# remains attached exactly as it is. Modified forms of this code must clearly state the +# fact that they're modified. This code is distributed with no warranty at all -- if it +# breaks, it's not my problem. If it breaks your system, it's still not my problem. + +sub getargs { + # Grab the query string + my $input = $ENV{QUERY_STRING}; + + # Decode any URL form encoding, add onto query string + if (lc($ENV{CONTENT_TYPE}) eq 'application/x-www-form-urlencoded') { + $input .= "&" if $input ne ''; + while (<>) { + chomp; + $input .= $_; + } + } + + my $i; + my @t; + my %tagset; + + # Iterate through each query argument from the input string + foreach $i (split /&/, $input) { + + # Split the query argument into key/value + @t = split /=/, $i, 2; + + # Replace + with spaces + $t[1] =~ tr/+/ /; + + # Translate hex into chars + $t[1]=~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; + + # Set tag for this CGI arg + $tagset{$t[0]} = $t[1]; + } + # Bail out and return this if it's not a multipart form slash file submit + return \%tagset if (lc($ENV{CONTENT_TYPE}) !~ m'multipart/form-data;'); + + # Ugly multi-file upload shit to follow + my $line; + my $lines; + my $name; + my $type; + my $filename; + my $file = 0; + my $localname; + my $uploads = shift @_; + my ($junk,$boundary) = split /=/, $ENV{CONTENT_TYPE}, 2; + $boundary =~ s/\n//; + $boundary = "--$boundary"; + LINE: while (<>) { + last if ($_ eq "${boundary}--\r\n"); + if ($_ eq "$boundary\r\n") { + $line=<>; # Get first line of headers. + $line =~ s/.*?; //; # Chop off the Content-Disposition part, we don't need it. + ($name, $filename) = split /; /, $line, 2; + ($junk, $name) = split /"/, $name; + close _GETARGS_TEMP; + $file = 0; + $lines = 0; + if ($filename ne "") { + $file = 1; + ($junk, $filename) = split /"/, $filename; + $tagset{"_details_$name"} = $filename; + $line=<>; + chomp $line; + ($junk, $type) = split ": ", $line; + $type =~ s/\r*//g; + $tagset{"_details_$name"} .= "|" . $type; + $ext = $$uploads{mime}{$type}; + if ($ext eq '') { + $ext = $filename; + $ext =~ s/^.*\.//; + } + $tagset{$name} = getargs_makefilename ($$uploads{file}, \%tagset, $filename); +# if ($ext ne '') { $tagset{$name} .= ".$ext"; } + $localname = "$$uploads{base}/$tagset{$name}"; + if ($localname ne '') { + if (open _GETARGS_TEMP, ">$localname") { + $tagset{"_details_$name"} .= "|" . $localname; + chmod 0644, $localname; + } + } + } + while ($line=<>) { next LINE if $line == "\n"; } + } + + if ($file) { + # Write the line to the temp file. + print _GETARGS_TEMP $_; + } else { + s/[\r\n]*$//; + if ($lines > 0) {$tagset{$name} .= "\n"; } + $tagset{$name} .= $_; + $lines ++; + } + } + close _GETARGS_TEMP; + + return \%tagset; +} + +sub getargs_makefilename { + my $spec = shift(@_); + my $object = shift(@_); + my $field = shift(@_); + + while ($spec =~ /\[(.*?)\]/) { + $tag = $1; + if ($tag eq '(field)') { + $val = $field; + } else { + $val = $$object{$tag}; + } +# $val =~ tr/ /_/; + $val =~ s/[&!"'*;]//g; + $val =~ s/\\//g; + $val =~ s/://g; + $tag =~ s/\(/\\(/g; + $tag =~ s/\)/\\)/g; + $spec =~ s/\[$tag\]/$val/g; + } + + return $spec; +} + +1; diff --git a/lib/headers.pm b/lib/headers.pm new file mode 100644 index 0000000..dffc84c --- /dev/null +++ b/lib/headers.pm @@ -0,0 +1,347 @@ +#### bucky's cheezy default headers! + +use RGB; + +our $SEEN_HEADER = 0; + +sub header + { + # my ($title, $subtitle, $sticky, $color, $sidetitle) = @_; + my ($args) = @_; + my $title = ref($args) ? $args->{title} : $args; + my $color = exists $args->{color} ? $args->{color} : "plain"; + + if ($SEEN_HEADER == 1) + { + # probably having an error if this has already been called + # already seen content-type so . . . + + print < +
+ + +
$title
+ERRORHEADER + return; + } + $SEEN_HEADER = 1; + print "Content-type: text/html\n\n"; + my $buhtitle = $title; + $buhtitle =~ s/<(([^ >]|\n)*)>//g; + $color = $COLORS{$color} if exists $COLORS{$color}; + my $rgb = RGB->new($color); + $rgb->perturb([4,4,8]); + $rgb->add(nighttime_quotient()); + my $rgb_out = $rgb->hex(); + print < + + $BUCKY_NAME [$buhtitle] + + + +head + print qq( \n) if $color eq "black"; + if ($0 =~ /login/) + { + print qq[\n]; + print qq! \n\n\n!; + } + else + { + print qq! \n\n\n!; + } + if ($BUCKY_CONFIG->{SNOWBALL_MACHINE} eq "on" && $0 =~ /index/) # && (time % 13) < 7) + { + do_snowfall(); + $title = "ACTIVATE SNOWBALL MACHINE !!!"; + print <<__CSS__; + +__CSS__ + } + print < +
+ +mid + + # print the header text. as these variables lie in different quadrants of a table, + # all may not exist, so here's some business logic! + # title sidetitle (nb: there must always be a title) + # subtitle sidesubtitle + print qq(); + print qq(); + + if (exists $args->{sidetitle}) + { + print qq(); + } + + if (exists $args->{subtitle} || exists $args->{sidesubtitle}) + { print qq!\n!; } + if (exists $args->{subtitle}) + { + print qq!!; + } + if (exists $args->{sidesubtitle}) + { + print qq!!; + } + print qq!\n!; + print qq!
{sidetitle} && exists $args->{sidesubtitle}) + { print qq( colspan=2); } + print qq(>); + print qq($title); + print qq({subtitle} && ! exists $args->{sidesubtitle}) + { print qq( rowspan=2); } + print qq(>); + print $args->{sidetitle}; + print qq(
{sidetitle} && ! exists $args->{sidesubtitle}) + { print qq( colspan=2); } + print qq(>); + print qq!! . $args->{subtitle} . qq!{sidetitle} && ! exists $args->{subtitle}) + { print qq( colspan=2); } + print qq(>); + print qq!! . $args->{sidesubtitle} . qq!
!; + } + +# sticky_button($args->{sticky}) if (($args->{sticky}) && ($USER != -1)); + +sub menu + { + my ($args) = @_; + my $kw = $args->{keywords}; + my $ftp = $BUCKY_CONFIG->{FTP_ENABLED} && $args->{ftp}; + my $loggedin = ($USER != -1); + my $keyed = (defined($kw) && ($kw->{public} || check_op($kw))); + print < + +
+ + + +bigtitle + + if ( $loggedin ) + { + print qq!home!; + + print qq! | !; + + # print qq!dump |\n! if ($USER->{ulevel} > 1); + + print qq!search | !; + + if ($keyed) + { print qq!post |\n!; } + else + { print qq!post |\n!; } + + if (defined($ftp) && $ftp > 0) + { + if ($ftp < 5) + { print qq(ftp here |\n); } + else + { print qq(ftp here |\n); } + } + elsif ($ftp == 0) + { print qq(ftp |\n); } + elsif ($keyed) + { print qq(ftp |\n); } + else + { print qq(ftp |\n); } + + my $newmsg = count_new_messages($USER->{username}); + if ($newmsg > 0) + { print qq[inbox ($newmsg new) |\n]; } + else + { print qq[inbox |\n]; } + + print qq[message |\n]; + + print <profile | +logout + + +$lastlog | userlist + +bigfoot + } + else + { + # else: logged out, only display "login" + print <home +| +login + + + +bigfeet + } + + print < +
+ + +bighonk + } + +sub footer + { + print < +
+foot + + print < + + +foot + } + +sub send_welcome_message + { + my $id = shift; + my $uname = get_username($id); + new_message("$uname.inbox", {sender => "system", recipient => $uname, unread => 1, subject => $BUCKY_WELCOME_SUBJECT, body => $BUCKY_WELCOME_BODY}); + return 1; + } + +sub do_snowfall + { + print < + +// *********HAPPY WINTER F-A-G-S********* + +// Distributed by http://www.hypergurl.com + +// Set the number of snowflakes (more than 30 - 40 not recommended) +var snowmax=40; + +// Set the colors for the snow. Add as many colors as you like +var snowcolor=new Array("#aaaacc","#ddddFF","#ccccDD") //shitballs +//var snowcolor=new Array("#C8A46E","#A9834F","#5B3714") + +// Set the fonts, that create the snowflakes. Add as many fonts as you like +var snowtype=new Array("Arial Black","Arial Narrow","Times","Comic Sans MS","Georgia","Trebuchet MS") + +// Set the letter that creates your snowflake (recommended:*) +var snowletter="*" + +// Set the speed of sinking (recommended values range from 0.3 to 2) +var sinkspeed=0.6 + +// Set the maximal-size of your snowflaxes +var snowmaxsize=43 + +// Set the minimal-size of your snowflaxes +var snowminsize=16 + +// Set the snowing-zone +// Set 1 for all-over-snowing, set 2 for left-side-snowing +// Set 3 for center-snowing, set 4 for right-side-snowing +var snowingzone=1 + +/////////////////////////////////////////////////////////////////////////// +// CONFIGURATION ENDS HERE +/////////////////////////////////////////////////////////////////////////// + + +// Do not edit below this line +var snow=new Array() +var marginbottom +var marginright +var timer +var i_snow=0 +var x_mv=new Array(); +var crds=new Array(); +var lftrght=new Array(); +var browserinfos=navigator.userAgent +var ie5=document.all&&document.getElementById&&!browserinfos.match(/Opera/) +var ns6=document.getElementById&&!document.all +var opera=browserinfos.match(/Opera/) +var browserok=ie5||ns6||opera + +function randommaker(range) { + rand=Math.floor(range*Math.random()) + return rand +} + +function initsnow() { + if (ie5 || opera) { + marginbottom = document.body.clientHeight + marginright = document.body.clientWidth + } + else if (ns6) { + marginbottom = window.innerHeight + marginright = window.innerWidth + } + var snowsizerange=snowmaxsize-snowminsize + for (i=0;i<=snowmax;i++) { + crds[i] = 0; + lftrght[i] = Math.random()*15; + x_mv[i] = 0.03 + Math.random()/10; + snow[i]=document.getElementById("s"+i) + snow[i].style.fontFamily=snowtype[randommaker(snowtype.length)] + snow[i].size=randommaker(snowsizerange)+snowminsize + snow[i].style.fontSize=snow[i].size + snow[i].style.color=snowcolor[randommaker(snowcolor.length)] + snow[i].sink=sinkspeed*snow[i].size/5 + if (snowingzone==1) {snow[i].posx=randommaker(marginright-snow[i].size)} + if (snowingzone==2) {snow[i].posx=randommaker(marginright/2-snow[i].size)} + if (snowingzone==3) {snow[i].posx=randommaker(marginright/2-snow[i].size)+marginright/4} + if (snowingzone==4) {snow[i].posx=randommaker(marginright/2-snow[i].size)+marginright/2} + snow[i].posy=randommaker(6*marginbottom-marginbottom-6*snow[i].size) + snow[i].style.left=snow[i].posx + snow[i].style.top=snow[i].posy + } + movesnow() +} + +function movesnow() { + for (i=0;i<=snowmax;i++) { + crds[i] += x_mv[i]; + snow[i].posy+=snow[i].sink + snow[i].style.left=snow[i].posx+lftrght[i]*Math.sin(crds[i]); + snow[i].style.top=snow[i].posy + + if (snow[i].posy>=marginbottom-6*snow[i].size || parseInt(snow[i].style.left)>(marginright-3*lftrght[i])){ + if (snowingzone==1) {snow[i].posx=randommaker(marginright-snow[i].size)} + if (snowingzone==2) {snow[i].posx=randommaker(marginright/2-snow[i].size)} + if (snowingzone==3) {snow[i].posx=randommaker(marginright/2-snow[i].size)+marginright/4} + if (snowingzone==4) {snow[i].posx=randommaker(marginright/2-snow[i].size)+marginright/2} + snow[i].posy=0 + } + } + var timer=setTimeout("movesnow()",50) +} + +for (i=0;i<=snowmax;i++) { + document.write(""+snowletter+"") +} +if (browserok) { + window.onload=initsnow +} + + +snowfall + + } +1; + diff --git a/lib/images.pm b/lib/images.pm new file mode 100644 index 0000000..1b69db7 --- /dev/null +++ b/lib/images.pm @@ -0,0 +1,509 @@ +####################################################################### +# thumbnailing + +sub is_ungainly + { + my $fn = shift; return $fn =~ /tif$/ || $fn =~ /bmp/; + } +sub thumbnail_filename + { + my ($filename) = @_; + if (is_ungainly($filename)) + { + $filename =~ s/\..*$/.jpg/; + } + return lc $filename; + } +sub make_image_thumb + { + my ($args) = @_; + + my $file = $args->{file}; + my $key = $args->{key} || "t."; + my $maxwidth = $args->{maxwidth} || 450; + my $maxheight = $args->{maxheight} || 450; + + my $filename = $file->{filename}; + my $lcfilename = thumbnail_filename($filename); + + use integer; + + $key = "t." if (!defined($key)); + print $file->{filename} if ($DEBUG); + + my ($xold, $yold) = imgsize(qq!$data_path/$file->{thread}/$filename!); + my $x = $xold; + my $y = $yold; + my @convert_args = (); + + push @convert_args, "$data_path/$file->{thread}/$filename"; + if ($filename =~ /.gif$/) { + push @convert_args, "-coalesce"; + } + push @convert_args, "-geometry"; + if ($maxheight < 1 && $maxwidth < 1) + { push @convert_args, "450x450"; } + elsif ($maxwidth < 1 || $key eq "b.") + { push @convert_args, "450x".$maxheight; } + elsif ($maxheight < 1) + { push @convert_args, $maxwidth; } + else + { push @convert_args, $maxwidth."x".$maxheight; } + + print "\n$filename -> .thumb/$key$lcfilename\n" if ($DEBUG); + print "old size: $xold x $yold\n" if ($DEBUG); + + if ($filename =~ /.gif$/) { + push @convert_args, "+map"; + } + push @convert_args, "$data_path/$file->{thread}/.thumb/$key$lcfilename"; + if ($DEBUG) + { print join " ", @convert_args; print "\n"; } + system($CONVERT_PATH, @convert_args); + system($CHMOD_PATH, 755, "$data_path/$file->{thread}/.thumb/$key$lcfilename"); + } + +# make a square thumbnail: +# crop bottom if portrait, crop sides if landscape +sub make_square_thumb + { + my ($file, $maxwidth, $key) = @_; + my $filename = $file->{filename}; + my $lcfilename = lc($file->{filename}); + my $_temp_thumb = $filename; + use integer; + + $key = "t." if (!defined($key)); + + # x = width, y = height + my ($xold, $yold) = imgsize(qq!$data_path/$file->{thread}/$file->{filename}!); + my $x = $xold; + my $y = $yold; + my $ydiff = 0; + my $xdiff = 0; + my @convert_args; + + if ($x != $y) # we must crop + { + if ($x < $y) + { + push @convert_args, "-crop", $x."x".$x; + $y = $x; + } + elsif ($y < $x) + { + $xdiff = ($x - $y) / 2; + push @convert_args, "-crop", $y."x".$y.'+'.$xdiff; + $x = $y; + } + + $_temp_thumb = ".thumb/temporary.jpg"; + push @convert_args, "$data_path/$file->{thread}/$filename"; + push @convert_args, "$data_path/$file->{thread}/$_temp_thumb"; + + print "\n$filename -> .thumb/$key$lcfilename\n" if ($DEBUG); + print "old size: $xold x $yold\n" if ($DEBUG); + print "new size: $x x $y\n" if ($DEBUG); + if ($DEBUG) + { print join " ", @convert_args; print "\n"; } + + system($CONVERT_PATH, @convert_args); + + for ($i = 0; $i < 4; $i++) + { + my $_temp_thumb_cropped = $_temp_thumb; + $_temp_thumb_cropped =~ s/.jpg$/-$i.jpg/; + ($xold, $yold) = imgsize(qq!$data_path/$file->{thread}/$_temp_thumb_cropped!); + if ($xold == $x) + { + $_temp_thumb = $_temp_thumb_cropped; + last; + } + } + } + @convert_args = (); + push @convert_args, "-geometry"; + push @convert_args, $maxwidth."x".$maxwidth; + push @convert_args, "$data_path/$file->{thread}/$_temp_thumb"; + push @convert_args, "$data_path/$file->{thread}/.thumb/$key$lcfilename"; + if ($DEBUG) + { print join " ", @convert_args; print "\n"; } + system($CONVERT_PATH, @convert_args); + system($CHMOD_PATH, 755, "$data_path/$file->{thread}/.thumb/$key$lcfilename"); + system($RM_PATH, "$data_path/$file->{parent_id}/.thumb/temporary.jpg"); + system($RM_PATH, "$data_path/$file->{parent_id}/.thumb/temporary-0.jpg"); + system($RM_PATH, "$data_path/$file->{parent_id}/.thumb/temporary-1.jpg"); + system($RM_PATH, "$data_path/$file->{parent_id}/.thumb/temporary-2.jpg"); + } + +sub print_image_thumb + { + my ($file, $thumb_token, $string) = @_; + + my $lcfilename = thumbnail_filename($file->{filename}); + + $thumb_token = "t." if (!defined($thumb_token)); + + print qq!!; + + my $keyword = $file->{keyword} || "details"; + if ( $keyword == -1 ) + { $keyword = "details"; } + + if ($string == -1) + { print qq!!; } + else + { print qq!!; } + + print qq!!; + print qq(); + + if ($string != -1) + { + print qq(
); + if (length($file->{title})) + { print $file->{title}; } + else + { print clean_image_filename($file->{filename}); } + print qq! (! . profile_link($file->{username}) . qq!, ! . get_age($file->{date}) . qq!)!; + print qq(); + } + + print qq!!; + print qq!!; + } + +sub clean_image_filename + { + my ($filename) = @_; + return if ($filename =~ /IMG|DSC/); + $filename =~ s/[-_]/ /g; + $filename =~ s/\....$//; + return $filename; + } + +sub curt_filename + { + my ($fn) = @_; + if (length($fn->{filename}) > 27 && $fn->{filename} !~ / /) + { + my $filen = substr $fn->{filename}, 0, 24; + my $filext = substr $fn->{filename}, -4, 4; + return "$filen..$filext"; + } + else + { return $fn->{filename}; } + } + +sub print_flagged_jpeg + { + my ($f) = @_; + my $lcfilename = thumbnail_filename($f->{filename}); + make_image_thumb( + { + file => $f, + maxwidth => 390, + # maxheight => 305, + key => "s." + } ) if (! -e qq!$data_path/$f->{thread}/.thumb/s.$lcfilename!); + print qq!!; + } + +####################################################################################### +# image gallery building + +sub get_profile_image + { + my ($username, $prefix) = @_; + if (defined($prefix)) + { + if (-e $data_path."/profile/.thumb/$prefix$username.jpg") + { qq($live_path/profile/.thumb/$prefix$username.jpg) } + else + { qq($live_path/profile/.thumb/$prefix)."default".qq(.jpg) } + } + elsif (-e $data_path."/profile/$username.jpg") + { qq($live_path/profile/$username.jpg) } + else + { -1 } + } + +sub image_gallery + { + my ($files, $flagged, $many_jpgs) = @_; + my $i = 0; + my $j = 0; + print ""; + foreach my $f (sort { $a->{date} <=> $b->{date} } @$files) + { + next if ($f->{filename} !~ /(jpe?g|gif|png|bmp|tif)$/i); + next if (($f->{id} == $flagged->{id}) && ($many_jpgs % 3) == 1); + + my $lcfilename = thumbnail_filename($f->{filename}); + make_image_thumb( { file => $f, maxwidth => 145, maxheight => 120, key => "t." }) + if (! -e qq($data_path/$f->{thread}/.thumb/t.).$lcfilename); + make_image_thumb( { file => $f, maxwidth => 210, maxheight => 110, key => "b." }) + if (! -e qq($data_path/$f->{thread}/.thumb/b.).$lcfilename); + + print "\n" if ($j == 0); + print_image_thumb($f, "t."); + print "\n" if ($j == 2); + + $j = $j == 2 ? 0 : $j+1; + + $i++; + } + print qq!
\n!; + return $i; + } + +sub image_column + { + my ($files, $flagged, $many_jpgs) = @_; + my $i = 0; + my $j = 0; + if ($many_jpgs > 5) + { $thumb_token = "t."; } + else + { $thumb_token = "b."; } + print qq(); + foreach my $f (sort { $a->{date} <=> $b->{date} } @$files) + { + next if ($f->{filename} !~ /(jpe?g|gif|png|bmp|tif)$/i); + next if ($f->{id} == $flagged->{id}); + + my $lcfilename = thumbnail_filename($f->{filename}); + make_image_thumb( { file => $f, maxwidth => 145, maxheight => 120, key => "t." }) + if (! -e qq($data_path/$f->{thread}/.thumb/t.).$lcfilename); + make_image_thumb( { file => $f, maxwidth => 210, maxheight => 110, key => "b." }) + if (! -e qq($data_path/$f->{thread}/.thumb/b.).$lcfilename); + + if ($many_jpgs-1 == 4) # tile in a square + { + if ($i % 2 == 0) + { + print qq(\n); + print_image_thumb($f, $thumb_token); + } + else + { + print_image_thumb($f, $thumb_token); + print qq(\n); + } + } + else + { + print qq(\n); + print_image_thumb($f, $thumb_token); + print qq(\n); + } + + $i++; + } + print qq!
\n!; + return $i; + } + +sub index_photostream + { + my ($keyword,$tag) = @_; +if (2 != 1) + { + photostream({ recent => 1, vertical => 0, count => $INDEX_GALLERY_IMAGE_COUNT }); + return; + } +else { + print ""; +$i = 4; +print <<__CROWS__; + + + + +__CROWS__ + print "
\n"; +return; +} + if (check_key($USER->{boxes}, "photostream") || ($USER == -1) ) + { + if ( $keyword ne "all" ) + { photostream({ keyword => $keyword, vertical => 0, count => 4 }); } + elsif ( $tag ) + { photostream({ tag => $tag, vertical => 0, count => 4 }); } + else + { photostream({ user => 1, vertical => 0, count => 4 }); } + } + } + +sub photostream + { + my ($args) = @_; + my $vertical = $args->{vertical}; + my $count = $args->{count}; + my $user = $args->{user}; + my $recent = $args->{recent}; + my $keyword = $args->{keyword}; + my $tag = $args->{tag}; + if ( $recent ) + { + $args->{files} = get_recent_files(); + recent_image_gallery( $args ); + } + elsif ( $keyword ) + { + # TODO: privacy check + $args->{files} = get_keyword_files( $keyword ); + if ($args->{files} != -1) + { + user_image_gallery( $args ); + } + } + elsif ( $tag ) + { + $args->{files} = get_tag_files( $tag ); + if ($args->{files} != -1) + { + user_image_gallery( $args ); + } + } + else + { + for (my $i = 0; $i < 3; $i++) + { + my $username = get_random_user(); + $username = $BUCKY_ADMINISTRATOR if ($i == 2); + my ($count, $size) = count_user_files($username); + next unless ($count > 3); + $args->{files} = get_user_files( $username ); + if ($args->{files} != -1) + { + user_image_gallery( $args ); + return; + } + } + } + } + +sub recent_image_gallery + { + my ($args) = @_; + my $files = $args->{files}; + my $count = $args->{count} || 4; + my %seen; + print qq(); + print ""; + my $i = 0; + for my $f (@$files) + { + if (lc($f->{filename}) =~ /(jpe?g|gif|png)$/) { + if (! -e qq($data_path/$f->{thread}/.thumb/t.).lc($f->{filename})) { + make_image_thumb( { file => $f, maxwidth => 145, maxheight => 120, key => "t." }) + } + print_image_thumb($f, "t.", -1); + $i++; + last if ($i == $count); + } + } + print "" if (!$vertical); + print qq!
\n!; + } + +sub user_image_gallery + { + my ($args) = @_; + my $files = $args->{files}; + my $vertical = $args->{vertical} ? 1 : 0; + my $count = $args->{count} || 4; + my %seen; + print qq(); + print "" if (!$vertical); + for (my $i = 0; $i < $count; $i++) + { + my $f = get_random_image($files, \%seen, $i); + last if ($f == -1); + make_image_thumb( { file => $f, maxwidth => 145, maxheight => 120, key => "t." }) + if (! -e qq($data_path/$f->{thread}/.thumb/t.).lc($f->{filename})); + print "" if ($vertical); + print_image_thumb($f, "t.", -1); + print "" if ($vertical); + print "\n"; + } + print "" if (!$vertical); + print qq!
\n!; + } + +sub get_random_image + { + my ($files, $seen, $i) = @_; + my $f; + $c = 0; + while ($f = $files->[(int rand @$files)]) + { + return -1 if ((++$c) == 69); + print "$i/$c: $f->{id} -- $f->{private} -- $seen->{$f->{id}}
" if ($DEBUG); + next if (exists($seen->{$f->{id}})); + $seen->{$f->{id}} = 1; + next if ($f->{filename} !~ /(jpe?g|gif|png|bmp|tif)$/i); + last if ( ( $USER == -1 && $f->{private} > 0 ) + || ( ref($USER) && $f->{private} > 1 ) ); + last; + } + return $f; + } + +sub find_jpeg + { + my ($files, $flagged_id) = @_; + my $flagged = -1; + my $fagid = -1; + my $i = 0; + my $j = 0; + foreach my $f (@$files) + { + if ($$f{filename} =~ /(jpe?g|gif|png|bmp|tif)$/i) + { + if ($$f{id} == $flagged_id || $flagged == -1) + { + $fagid = $$f{id}; + $flagged = $i; + } + $j++; + } + $i++; + } + if ($flagged > -1) + { + print_flagged_jpeg($files->[$flagged]) + } + return ($j, $fagid); + } + +sub find_jpeg_v2 + { + my ($files, $flagged_id) = @_; + my $flagged = -1; + my $fagid = -1; + my $i = 0; + my $j = 0; + foreach my $f (@$files) + { + if ($$f{filename} =~ /(jpe?g|gif|png|bmp|tif)$/i) + { + if ($$f{id} == $flagged_id || $flagged == -1) + { + $fagid = $$f{id}; + $flagged = $i; + } + $j++; + } + $i++; + } + if ($flagged > -1) + { return ($j, $files->[$flagged]); } + else + { return ($j, -1); } + } + +1; + + diff --git a/lib/import.pm b/lib/import.pm new file mode 100644 index 0000000..7edefdc --- /dev/null +++ b/lib/import.pm @@ -0,0 +1,204 @@ +sub situate_imports + { + my ($pid, $uname) = @_; + my ($filename, $size, $date); + my $newfilename; + my $tempsubdir; + my $totalsize = 0; + my @stats; + + open T, ">$temp_path/.importnow"; + close T; + system($SYSTEM_CHMOD, "0777", "$temp_path/.importnow"); + print "Waiting to import...
" if ($DEBUG); + while (-e "$temp_path/.importnow") + { sleep(1); } + print "Setting permissions...
" if ($DEBUG); + while (-e "$temp_path/.importing") + { sleep(1); } + print "Ready to import!
" if ($DEBUG); + + foreach my $k (keys %$input) + { + next if ($k !~ /^imp/); + next if (! -e $temp_path."/".$$input{$k}); + $filename = $$input{$k}; + + if (! -e $data_path."/".$pid) + { + print "creating $data_path/$pid
\n" if $DEBUG; + system("$MKDIR_PATH", $data_path."/".$pid); + system("$MKDIR_PATH", $data_path."/".$pid."/.thumb"); + system("$CHMOD_PATH", "755", $data_path."/".$pid); + system("$CHMOD_PATH", "755", $data_path."/".$pid."/.thumb"); + } + + print $filename."
" if ($DEBUG); + + @stats = stat($temp_path."/".$filename); + $size = $stats[7]; + $date = $stats[9]; + $newfilename = $filename; + $newfilename =~ s/^(.*)\///; + $tempsubdir = $1; + + if (-e $data_path."/".$pid."/".$newfilename) + { + my $tfile = "another-$newfilename"; + my $i = 2; + while (-e $data_path."/".$pid."/".$tfile) + { + $tfile = $newfilename; + $tfile =~ s/(\....)$/-$i$1/; + $i++; + } + $newfilename = $tfile; + } + + system($MV_PATH, $temp_path."/".$filename, $data_path."/".$pid."/".$newfilename); + add_file($pid, $uname, $newfilename, $size, $date); + $totalsize += $size; + } + update_thread_size($pid); + flush_imports($tempsubdir); + } + +sub flush_imports + { + while ($tsd) + { + foreach my $d (recurse_imports($temp_path."/".$tsd."/")) + { + if (! -d $temp_path."/".$tsd."/".$d) + { print "Files still in $tsd, will not flush!
" if $DEBUG; return; } + } + system($RM_PATH, "-rf", $temp_path."/".$tsd); + return if ($tsd !~ /\//); + $tsd =~ s/^(.*)\///; + $tsd = $1; + } + } + + +sub list_imports + { + my $r = 0; + my $i = 0; + my $size = 0; + my $inc = 0; + my $title = ""; + my $files; + + print < + + + + + + + + +FILES + + @files = recurse_imports($temp_path."/"); + + foreach $file (sort @files) + { + if (-d $temp_path."/".$file) + { + if ($file =~ /$title\//) + { + $file =~ s/^.*\///; + $title .= " - $file"; + } + else + { $title = $file; } + next; + } + my @stats = stat($temp_path."/".$file); + $inc += display_import({filename => $file, date => $stats[9], size => $stats[7]}, $r, $i); + $size += $stats[7]; + $r = $r ? 0 : 1; + $i++; + } + + print qq!
  NameDate Size 
total size: !.(sprintf "%0.1fmb",$size/1000000).qq!
\n\n!; + + return ($title, $inc, $size); + } + +sub recurse_imports + { + my $d = shift; + return unless (-d $d); + my @files; + + opendir (DIR, $d) or die "couldn't list: $d, $!"; + @files = grep (!/^\./, sort readdir (DIR)); + closedir DIR; + + foreach my $f (@files) + { + push @files, + map { $f . "/" . $_ } + recurse_imports($d.$f); + } + + return @files; + } + +sub display_import + { + my ($f, $r, $i) = @_; + my $color; + my $inc = 0; + + if (abs(time - $$f{date}) < 5) # incomplete! use abs in case these are files from THE FUTURE! + { $color = "incomplete"; $inc = 1; } + elsif ((time - $$f{date}) < 86400) # modified today + { $color = "new"; } + elsif ((time - $$f{date}) < 604800) # modifed this week + { $color = "recent"; } + elsif ((time - $$f{date}) < 1209600) # modifed 2 weeks ago + { $color = "old"; } + else + { $color = "quiet"; } + + print qq[]; + if ($color eq "incomplete") + { + print qq[ ]; + print ''; + print qq[ $$f{filename}]; + print qq[]. (verbosedate($$f{date})), qq[]; + print qq[ $$f{size} ]; + } + else + { + if ($f->{filename} =~ /^temp_/) + { print qq[ ]; } + else + { print qq[]; } + if ($f->{filename} =~ /jpg|gif|png$/) + { + #print ""; + print ''; + } + else + { + print ''; + } + print qq[ ]; + print qq[$$f{filename}]; + print qq[]. (verbosedate($$f{date})), qq[]; + print qq[ $$f{size} ]; + } + + print qq[\n]; + + return $inc; + } + +1; + diff --git a/lib/invite.pm b/lib/invite.pm new file mode 100644 index 0000000..96c6de0 --- /dev/null +++ b/lib/invite.pm @@ -0,0 +1,485 @@ + +sub request_invite + { + my $clean_invite = parse_registration_input(); + my $result = 0; + if ($clean_invite != -1) + { + new_invite($clean_invite); + request_success(); + } + } + +sub generate_invite + { + my $invite_count = count_active_user_invites($USER->{username}); + my $newhash; + + # don't invite your whole social network + if ($invite_count >= 5) + { return -1 unless ($USER->{ulevel} == 3); } + + for (my $i = 0; $i < 3; $i++) + { + $newhash = make_new_hash($USER->{username} . time); + my $invite = get_invite_from_hash($hash); + last unless (invite_is_active($invite)); + } + + my $clean_invite = parse_invite_input($newhash); + if ($clean_invite != -1) + { $result = new_invite($clean_invite); } + $result ? return $newhash : return -1; + } + +sub validate_invite + { + my ($hash) = @_; + my $invite = get_invite_from_hash($hash); + + unless (invite_is_active($invite)) + { error("Bad invite key!"); } + + my $clean_register = parse_registration_input(); + if ($clean_register != -1) + { + my $uid = new_user($clean_register); + set_invite_state($invite, $BUCKY_INVITE_REDEEMED); + set_invite_username($invite, $clean_register->{username}); + # auto-op on keywords + add_mailbox("$clean_register->{username}.inbox", $clean_register->{username}, 0); + add_mailbox("$clean_register->{username}.outbox", $clean_register->{username}, 0); + add_mailbox("$clean_register->{username}.drafts", $clean_register->{username}, 1); + send_welcome_message($uid); + send_invite_receipt($invite->{attest}, $clean_register, $invite); + send_invite_receipt($BUCKY_ADMINISTRATOR, $clean_register, $invite); + validate_success(); + } + } + +sub validate_approve + { + my ($invite) = @_; + my $o = + { + username => $invite->{username}, + password => $invite->{password}, + realname => $invite->{realname}, + email => $invite->{email}, + grass => $invite->{grass} + }; + my $uid = new_user($o); + $result = set_invite_state($invite, $BUCKY_INVITE_APPROVED); + # auto-op on keywords + add_mailbox("$o->{username}.inbox", $o->{username}, 0); + add_mailbox("$o->{username}.outbox", $o->{username}, 0); + add_mailbox("$o->{username}.drafts", $o->{username}, 1); + send_welcome_message($uid); + return 1; + } + +sub send_invite_receipt + { + my ($recipient, $newuser, $invite) = @_; + my $mbox = ($recipient eq $BUCKY_ADMINISTRATOR) ? "$recipient.system" : "$recipient.inbox"; + $transcript = + qq($newuser->{username} has created an account via invite.\n\n) . + qq(real name: $newuser->{realname}\n\n) . + qq(email: $newuser->{email}\n\n) . + qq(invited by: $invite->{attest}\n\n); + new_message($mbox, + { + sender => "system", + recipient => $recipient, + unread => 1, + subject => "New user $newuser->{username} via invite", + body => $transcript + } ); + } + +############################# + +sub validate_success + { + header("account created!"); + print qq(



); + print "Your $BUCKY_NAME account has created!

"; + print "Please log in for the first time.\n"; + print qq(

\n\n); + login_form(); + print qq(
\n\n); + footer(); + } + +sub request_success + { + header("account requested!"); + print qq(
\n\n); + print "Your request for a $BUCKY_NAME account has been submitted and will be acted upon shortly.

"; + print qq(back to $BUCKY_NAME); + footer(); + } + +############################# + +sub registration_form + { + my ($invite) = @_; + my $invited = defined($invite) && $invite != -1; + + if ($invited) + { header("create an account"); } + else + { header("request an account"); } + + print <
+
+
+may i note here . . . that i test this with firefox
 +
+welcome to $BUCKY_NAME! +
+
+ +
+adduserform + + print qq(\n) if ($DEBUG); + + if ($invited) + { + print qq(\n); + print qq(\n); + } + else + { + print qq(\n); + } + + print <(lowercase):
+password:
+again!
+real name:
+email address:
+
+adduserfoot + + print <hello there duder, please say hello
+ +snark + + print < +

+ + + + + +

+
+addusereof + + footer(); + } + +############################# + +sub parse_invite_input + { + my ($newhash) = @_; + my $safe = 1; + + my $clean = + { + state => $BUCKY_INVITE_ACTIVE, + hash => $newhash, + attest => $USER->{username}, + keywords => scrub($input->{keyword}) + }; + + if ($safe) + { return $clean; } + else + { return -1; } + } + +sub parse_registration_input + { + my @error; + my $clean; + + if ($input->{username} =~ /(root|system|bucky|$BUCKY_SHORT_NAME)/) + { push @error, "Illegal username"; } + if ($input->{username} =~ /\s/) + { push @error, "Username cannot contain spaces"; } + if ($input->{pw1} ne $input->{pw2}) + { push @error, "Passwords don't match"; } + if (get_user($input->{username}) != -1) + { push @error, "User already exists"; } + + $clean = + { + state => $BUCKY_INVITE_REQUEST, + username => lc(scrub($input->{username})), + password => crypt($input->{pw1}, lc(scrub($input->{username}))), + realname => scrub($input->{realname}), + email => scrub($input->{email}), + grass => scrub($input->{grass}) + }; + + if (@error) + { + registration_form_error(@error); + return -1; + } + else + { + return $clean; + } + } + +sub registration_form_error + { + my (@error) = @_; + header("registration form error"); + print "Sorry, there was an error in your registration:

"; + print "

    \n"; + foreach my $e (@error) + { + print "
  • $e\n"; + } + print "
\n"; + print qq(Please go back and fix it . . .

); + footer(); + exit(1); + } + +############################# + +sub invite_result_box + { + my ($command, $hash, $result) = @_; + print qq(

); + if ($command eq "new") + { + if ($result) + { + print qq(invite created!

); + print qq(give the url to your friend!); + } + else + { + print qq(you were unable to make a new invite!

); + print qq(maybe you have been inviting too many people?!); + } + } + else + { + print qq($command ); + print $result ? "succeeded!" : "failed!"; + } + print qq(

\n); + } + +sub invite_create_box + { + print qq(
); + print qq(invite whomever..\n
\n); + print qq(only invite goodfellows,
my fellow ).$BUCKY_DUDER_NOUN.qq(s.

); + print qq(

\n); + print qq(\n) if ($DEBUG); + print qq(\n); + # keyword_pulldown(); + print qq(\n); + print qq(
); + print qq(
\n); + } + +############################# + +sub display_personal_invites + { + my $user_invites = get_invites_by_user($USER->{username}); + return if ($user_invites == -1); + print "Your invites:

"; + display_invites_table($user_invites); + } + +sub display_approve_list + { + my $invites = get_active_invites(); + print "Active invites and requests:

"; + display_invites_table($invites); + } + +{ +my %invites_seen; +sub display_invites_table + { + my ($invites) = @_; + my $r = 0; + print qq(\n); + + foreach my $i (sort { $b->{id} <=> $a->{id} } @$invites) + { + next if (exists($invites_seen{$i->{id}})); # minimize redundancy in admin list + $invites_seen{$i->{id}} = 1; + display_single_invite($i, $r); + $r = $r ? 0 : 1; + } + + print qq(
); + } +} + +sub display_single_invite + { + my ($i, $r) = @_; + + print qq(); + + print qq(); + print qq() if ($i->{state} == 2); + print $BUCKY_INVITE_STATES[$i->{state}]; + print qq() if ($i->{state} == 2); + print qq(); + + if ($i->{hash}) + { display_invite_row($i); } + else + { display_approve_row($i); } + print qq(\n); + } + +sub display_invite_row + { + my ($i) = @_; + + if ($i->{state} > 0) + { + print qq(); + print qq(); + print qq(); + print qq(); + + print qq(); + print qq(); + print qq(); + print qq(); + print qq(); + print qq(); + + print qq(
); + print qq(https://$BUCKY_HOST$BUCKY/invite/$i->{hash}); + print qq(
); + print qq(invited by ).profile_link($i->{attest}).qq(); + print qq(); + print qq(expires in); + print qq(); + print get_age($i->{expired}); + print qq(); + print invite_snuff_link("renew", $i->{id}) . qq( · ); + print invite_snuff_link("cancel", $i->{id}); + print qq(
); + print qq(); + } + elsif ($i->{state} == $BUCKY_INVITE_REDEEMED) + { + print qq(); + print qq(); + print qq(); + print qq(); + print qq(); + print qq(
); + print qq(invited by ).profile_link($i->{attest}).qq(); + print qq(); + print qq(new user: ); + print profile_link($i->{username}); + print qq(
); + print qq(); + } + else + { + print qq( ); + } + } + +# username => lc(scrub($input->{username})), +# realname => scrub($input->{realname}), +# email => scrub($input->{email}), +# grass => scrub($input->{grass}) + +sub display_approve_row + { + my ($i) = @_; + print qq(); + print qq(); + print qq(); + print qq(); + + print qq(); + print qq(); + print qq(); + print qq(); + + if ($i->{state} > 0) + { + print qq(); + print qq(); + print qq(); + + print qq(); + print qq(); + } + + print qq(
username: $i->{username}
realname: $i->{realname}
email: $i->{email}
 $i->{grass}
); + print qq(expires in); + print qq(); + print get_age($i->{expired}); + print qq(); + print invite_snuff_link("approve", $i->{id}) . qq( · ); + print invite_snuff_link("reject", $i->{id}); + print qq(
); + print qq(); + } + +sub invite_snuff_link + { + my ($c, $id) = @_; + return qq($c); + } + +############################# + +sub make_new_hash + { + my ($string) = @_; + $string = length($string) ? $string : time; + $hex = md5_hex ($string); + return substr $hex, 0, 16; # these will TOTALLY never collide + } + +sub invite_is_active + { + my ($invite) = @_; + return 0 if ($invite == -1); + return 0 if ($invite->{state} < 1); + #if ($invite->{expired} < time) + # { + # set_invite_state($invite, $BUCKY_INVITE_EXPIRED); + # return 0; + # } + return 1; + } + +1; + diff --git a/lib/keywords.pm b/lib/keywords.pm new file mode 100644 index 0000000..c600cd6 --- /dev/null +++ b/lib/keywords.pm @@ -0,0 +1,187 @@ +############################################### + +sub keyword_assign_mechanism + { + my ($kn, $tn, $ko) = @_; + if (!defined($kn)) + { error("no keyword specified!"); } + if (!defined($tn)) + { error("no post specified!"); } + if (!defined($ko)) + { $ko = get_keyword($kn); } + my %nk = + ( + threads => add_key($ko->{threads}, $tn) + ); + if ($DEBUG) + { + header("Assigning post to $kn"); + menu(); + foreach my $ky (keys %nk) + { print "$ky => $nk{$ky}
\n"; } + print "keyword ==> $kn
\n"; + } + update_keyword($kn, \%nk); + update_thread_keyword($tn, $kn); + } + +############################################### + +sub keyword_pulldown + { + my ($selected) = @_; + my $keywords = get_keywords(); + + if (! ($selected && $selected ne "all")) + { + if ($USER->{'username'} eq "flop4andy") + { + $selected = "dreamteamer"; + } + else + { + $selected = $BUCKY_DEFAULT_KEYWORD; + } + } + + print qq!\n!; + return; + } + +# return unless ($sees_private_keys); + + print qq!!; + foreach my $k (sort { lc($a) cmp lc($b) } keys %$keywords) + { + my $kh = $keywords->{$k}; + next if ($kh->{public} == 1); + next unless ($kh->{owner} eq $USER->{username} || check_op($kh)); + print qq!!; + } + print qq!\n!; + } + +############################################### + +sub keyword_form + { + my ($keyword, $k, $t) = @_; + my $checked = ""; + my $verb = "MODIFY"; + my $command = ($keyword eq "new") ? "create" : "update"; + $t = -1 unless (defined ($t)); + + # keyword ops(matrix) public(checkbox) agglutinate(checkbox) + + print < + +kf + print qq!\n! if ($DEBUG); + print < + +category + +kf + if ($keyword eq "new") + { + $verb = "CREATE"; + print qq!!; + } + else + { + print qq!$keyword!; + print qq!\n!; + } + print < + +kf + if ($t != -1) + { + print < +initial post +$t->{title} + +pub + } + + $checked = ($k->{public} == 1) ? " checked" : ""; + print < +color + +pub + my $rcolor = get_color(-1, $k); + color_dropdown($rcolor, 0); + print < + + +anyone can post + + +kf + + if ($k->{public} != 1 || $t != -1) + { + print < +operators + +kf + print qq!

!; + print qq!\n!; + print qq!--- if "anyone can post" is unchecked ---
users checked off below will share control of this category,
and will be able to add new posts to it,
alter privacy/color settings, etc.
\n!; + print qq!!; + if ($t != -1) + { user_checkerboard($t->{allowed}, undef); } + elsif (exists($k->{ops})) + { user_checkerboard($k->{ops}, undef); } + else + { user_checkerboard($k->{owner}, undef); } + print qq!
!; + + print < + +kf + } + + print < +  + + + + + +kf + } + +############################################### + +1; + diff --git a/lib/lastlog.pm b/lib/lastlog.pm new file mode 100644 index 0000000..94ffd99 --- /dev/null +++ b/lib/lastlog.pm @@ -0,0 +1,29 @@ +sub lastlog + { + my ($whoami) = @_; + my $lastlog_data = get_lastlog(); + my $lastlog_text = ""; + + for (my $i = 0; $i < @$lastlog_data; $i++) + { + my $lastlog = $lastlog_data->[$i]; + + last if ($LASTLOG_ONLY_FIRST_DAY && (time - $lastlog->{lastseen}) > 86400); + + $lastlog_text .= ", " if ($i > 0); + $lastlog_text .= message_link($lastlog->{username}); + + if ((time - $lastlog->{lastseen}) > 4) + { + $lastlog_text .= " [".(get_age($lastlog->{lastseen}))."]"; + # $lastlog_text .= " $lastlog->{last_hostname}" if ($DEBUG); # ...previously kept track of host + } + } + + return "$whoami->{username} [now]" unless (length($lastlog_text)); + + return $lastlog_text; + } + +1; + diff --git a/lib/message.pm b/lib/message.pm new file mode 100644 index 0000000..4dad0d6 --- /dev/null +++ b/lib/message.pm @@ -0,0 +1,195 @@ +sub send_message + { + my ($message) = @_; + new_message("$sender.outbox", $message); + new_message("$recipient.inbox", $message); + } + +sub display_message + { + my $message = shift; + my $image = get_profile_image($message->{sender}, $AVATAR_MED_PREFIX); + print qq!
!; + print qq!!; + print qq!]; + + print qq["; + + print qq["; + + my ($tddate, $tdtime) = verbosedatetime($m->{date}); + print qq["; + print qq["; + + print qq["; + + print qq[]; + + print qq[\n]; + } + +# sort methods +# title, date, size, files, username + +sub get_sort_method + { + my ($s, $o) = @_; + + if ($o eq "a") + { + if ($s eq "t") { return \&sort_by_subject; } + elsif ($s eq "s") { return \&sort_by_sender; } + elsif ($s eq "d") { return \&sort_by_date; } + } + elsif ($o eq "d") + { + if ($s eq "t") { return \&rsort_by_subject; } + elsif ($s eq "s") { return \&rsort_by_sender; } + elsif ($s eq "d") { return \&rsort_by_date; } + } + else + { return \&rsort_by_date; } + } + +sub sort_by_subject { sort { uc($a->{subject}) cmp uc($b->{subject}) } @_; } +sub rsort_by_subject { sort { uc($b->{subject}) cmp uc($a->{subject}) } @_; } +sub sort_by_date { sort { $a->{date} <=> $b->{date} } @_; } +sub rsort_by_date { sort { $b->{date} <=> $a->{date} } @_; } +sub sort_by_sender { sort { uc($a->{sender}) cmp uc($b->{sender}) } @_; } +sub rsort_by_sender { sort { uc($b->{sender}) cmp uc($a->{sender}) } @_; } + + +1; + + diff --git a/lib/privacy.pm b/lib/privacy.pm new file mode 100644 index 0000000..fcf3188 --- /dev/null +++ b/lib/privacy.pm @@ -0,0 +1,133 @@ +sub check_privacy + { + my ($t, $k) = @_; + $k = -1 unless (defined($k)); + if ($USER == -1 && $t->{private} > 0) + { return 0; } + if ($t->{private} < 2) + { return 1; } + if ($t->{username} eq $USER->{username}) + { return 1; } + if (check_key($t->{allowed}, $USER->{id})) + { return 1; } + if ($USER->{ulevel} == 3) # A:.H:. + { return 1; } + if ($k != -1) + { + if ($k->{owner} eq $USER->{username}) + { return 1; } + if ($k->{public} == 1 && $t->{private} != 2) + { return 1; } + if (check_key($k->{ops}, $USER->{id})) + { return 1; } + } + return 0; + } + +sub check_participation + { + my ($files, $comments) = @_; + foreach my $f (@$files) + { + return 2 if ($f->{username} eq $USER->{username}); + } + foreach my $c (@$comments) + { + return 1 if ($c->{username} eq $USER->{username}); + } + return 0; + } + +sub check_keyword + { + my ($k) = @_; + if ($k != -1) + { + print "keyword: $k->{keyword}
owner: $k->{owner}
" if ($DEBUG); + print "ops: $k->{ops}
" if ($DEBUG); + print "public: $k->{public}
" if ($DEBUG); + if ($k->{public} == 1) + { return 1; } + return 0 if ($USER == -1); + if ($k->{owner} eq $USER->{username}) + { return 1; } + if (check_key($k->{ops}, $USER->{id})) + { return 1; } + } + return 0; + } +sub check_op + { + my ($k) = @_; + if ($k != -1) + { + print "keyword: $k->{keyword}
owner: $k->{owner}
" if ($DEBUG); + print "ops: $k->{ops}
" if ($DEBUG); + print "public: $k->{public}
" if ($DEBUG); + if ($k->{owner} eq $USER->{username}) + { return 1; } + if (check_key($k->{ops}, $USER->{id})) + { return 1; } + if ($k->{public} == 1) + { return 0; } + } + return 0; + } + +sub user_checkerboard + { + my ($selected, $skip, $owner) = @_; + my $users = get_all_users((time - 2*28*24*3600)); + my $i = 0; + my $j = 0; + my $r = 0; + + print qq!
!; + + print qq(); + print qq(); + if ($image != -1) + { + print qq(); + } + + print qq!!; + print qq!!; + + print qq!!; + + print qq!!; + + print qq!!; + + print qq!!; + print qq!
); + print qq(); + print qq(); + print qq(); + print qq(!; + print qq!$message->{subject}!; + print qq!
!; + print qq!!; + print qq!sent by $message->{sender} !; + print qq!on !.(verbosedate($message->{date})); +# print qq! (!.get_age($message->{date}).qq! ago)!; + print qq!
!; + print qq!
!; + print qq!
\n!; + print linebr($message->{body}); + print qq!
!; + print qq!
!; + print qq!
!; + print qq!!; + if ($message->{mbox} =~ /drafts/) + { + print qq{[edit] }; + } + else + { + print qq{[reply] }; + } + print qq![delete]!; + print qq!!; + print qq!
!; + print qq!!; + } + +sub message_list + { + my ($messages, $box) = @_; + my $r = 0; + + if ($DEBUG) + { + print qq!Printing message list. Message ids:!; + for (my $i = 0; $i < @$messages; $i++) + { print $messages->[$i]->{id}." "; } + print qq!

\n\n!; + } + + if ($messages == -1) + { + print qq[
No messages in this mailbox!]; + return; + } + + print qq!!; + + foreach my $message (@$messages) + { + display_message_row($message, $box, $r); + $r = $r ? 0 : 1; + } + + print "
\n\n"; + } + +sub display_message_row + { + my ($m, $box, $r) = @_; + my $color = carbondate($m->{date}); + + if ($DEBUG) + { + print qq!Displaying message $m->{id}\n!; + } + + print qq[

 ]; + print ""; + if ($m->{sender} eq "system") + { + print qq(system); + } + elsif ($m->{sender} eq $USER->{username}) + { + print qq[to $m->{recipient}]; + } + else + { + print qq[$$m{sender}]; + } + print qq[ · ]; + print ""; + print "]; + print qq[]; + if ($$m{unread}) + { print qq[$m->{subject}]; } + else + { print qq[$m->{subject}]; } + print qq[]; + print "]; + print qq[$tddate ]; + print "]; + print qq[$tdtime]; + print "]; + print qq[].hushsize($m->{size},.0000001,1).qq[]; + print "]; + if ($box =~ /drafts/) + { + print qq{[edit] }; + } + else + { + print qq{[reply] }; + } + print qq{[delete]}; + print qq[
!; + + foreach my $duder (sort { $a->{username} cmp $b->{username} } @$users) + { + next if (check_key($skip, $duder->{id})); + $checked = check_key($selected, $duder->{id}); + + print qq[\n] if ($j == 0); + print qq[\n]; + print qq[\n] if ($j == 3); + + $r = $r ? 0 : 1; + $r = $j == 3 ? int(!$r) : $r; + $j = $j == 3 ? 0 : $j+1; + $i++; + $checked = 0; + } + + print "
]; + print qq[ $duder->{username}]; + print qq[
\n"; + } + +sub update_whitelist + { + my $whitelist = make_whitelist(); + if ($whitelist eq " ") + { print "whitelist cleared
"; } + else + { print "new whitelist: $whitelist
"; } + switch_whitelist($id, $whitelist); + return $whitelist; + } + +sub make_whitelist + { + my $whitelist = " "; + foreach my $name (corral($input, "user")) + { + my $nextid = get_uid($name); + $whitelist .= $nextid." "; + } + return $whitelist; + } + +1; + diff --git a/lib/profile.pm b/lib/profile.pm new file mode 100644 index 0000000..1e20a78 --- /dev/null +++ b/lib/profile.pm @@ -0,0 +1,127 @@ +################################## +# PROFILE ######################## + +sub show_profile + { + my ($uname) = @_; + my $loggedin = ($USER != -1); + my $profile = get_user_profile($uname); + my $files = get_user_files($uname); + my $threads = get_threads_by_user($uname); + my $keywords = get_keywords(); + my $image = get_profile_image($uname, $AVATAR_PROFILE_PREFIX); + + print qq!!; + print qq!!; + print qq!); + + print qq(); + + print qq(
\n!; + + print qq!
! if ($image != -1); + + print qq(); + profile_row("name", $$profile{realname}); + my $email = $$profile{email}; + $email =~ s/\@/ at<\/i> /i; + profile_row("email", $email) if ($loggedin); + profile_row("aim", $$profile{aim}) if ($$profile{aim} && $loggedin); + profile_row("phone", $$profile{phone}) if ($$profile{phone} && $loggedin); + profile_row("location", $$profile{location}) if ($$profile{location}); + my %tzs = ( -5 => eastern, -6 => central, -8 => pacific, 0 => englandish); + profile_row("timezone", $tzs{$profile->{timezone}}) if (exists $tzs{$profile->{timezone}}); + if ((time - $$profile{lastseen}) < 60) + { profile_row("last seen", "active now"); } + else + { profile_row("last seen", verbosedate($$profile{lastseen})); } + if (($USER->{username} ne $uname) && $loggedin) + { + profile_row("· · · ·", + qq[send $uname a message]); + } + print "
"; + + if ($files != -1) + { + user_image_gallery({ files => $files, vertical => 1, count => 8 }); + } + + print qq(		\n); + + if ($threads != -1) + { + print qq!!; + print qq(); + print qq(); + thread_box({ threads => $threads, kw => 'USER', dosum => 0, dohead => 0 }); + if ($files != -1) + { + print qq(); + print qq(); + print qq(); + file_list($files, 0, 1, 0); + } + print "
 threads by $uname
 
 files by $uname
\n"; + print "

\n\n"; + } + + print qq(

); + + footer(); + } + +sub profile_row + { + my ($k, $v) = @_; + print "$k · $v"; + } + +# moves files around +sub update_profile_image + { + my ($username) = @_; + $filename = $input->{userpic}; + + return if (! -e $temp_path."/".$filename); + if ($filename =~ /temp_$/) + { system($RM_PATH, $temp_path."/".$filename); return; } + + if (-e $data_path."/profile/".$username.".jpg") + { + print "moving old profile pic...
"; + system($MV_PATH, "$data_path/profile/$username.jpg", $data_path."/profile/".$username."-old.jpg"); + } + + $messages .= "updating profile pic for $username to $filename...
"; + system($MV_PATH, "$temp_path/$filename", "$data_path/profile/$username.jpg"); + + update_profile_thumb($username); + + return 1; + } + +# creates avatars +sub update_profile_thumb + { + my ($username) = @_; + + if (!-e "$data_path/profile/$username.jpg") + { + $messages .= "/profile/$username.jpg does not exist!" if $DEBUG; + return -1; + } + + my $profile_image = + { + filename => "$username.jpg", + thread => "profile" + }; + + make_image_thumb({file => $profile_image, maxwidth => $AVATAR_PROFILE_WIDTH, maxheight => $AVATAR_PROFILE_HEIGHT, key => $AVATAR_PROFILE_PREFIX}); + make_square_thumb($profile_image, $AVATAR_BIG_WIDTH, $AVATAR_BIG_PREFIX); + make_square_thumb($profile_image, $AVATAR_MED_WIDTH, $AVATAR_MED_PREFIX); + } + +1; + diff --git a/lib/radio.pm b/lib/radio.pm new file mode 100644 index 0000000..306d904 --- /dev/null +++ b/lib/radio.pm @@ -0,0 +1,100 @@ +####################################### +# self-enclosed polling mechanism for radio area + +use LWP; + +sub get_radio_info + { + my $radio; + my $raw_radio; + + print "" if ($DEBUG); + + $RADIO_STATUS_ENABLED = 1; + if ( ! $RADIO_STATUS_ENABLED || poll_radio_status() == -1) + { return -1; } + + print "\nRadio is up!
\n" if ($DEBUG); + + if (poll_cache_age($RADIO_INFO_PATH) > 60) + { + print "Polling radio...
\n" if ($DEBUG); + $raw_radio = go_slurp($RADIO_INFO_URL, $RADIO_INFO_PATH); + } + + $raw_radio ||= quickread($RADIO_INFO_PATH); + $radio = parse_colons($raw_radio); + + print "" if ($DEBUG); + + return $radio; + } + +sub poll_cache_age + { + my $file = shift; + my $ret = time - (stat($file))[9]; + print "Age of $file: $ret seconds...
\n" if ($DEBUG); + return $ret; + } + +sub poll_radio_status + { + my $status; + print "Polling radio status...
\n" if ($DEBUG); +# go_slurp($RADIO_STATUS_URL, $RADIO_STATUS_PATH); +# $status = quickread($RADIO_STATUS_PATH); + + my $r = HTTP::Request->new(GET => $RADIO_STATUS_URL); + my $re = LWP::UserAgent->new->request($r); + my $data = $re->content(); + + chomp($data); + if ($data eq "1") + { return 1; } + else + { return -1; } + } + +sub parse_colons + { + my $filedata = shift; + my %parsed; + + foreach $l (@$filedata) + { + chomp $l; + my ($k, $v) = split(/: /, $l, 2); + $k = lc($k); + $k =~ s/ //; + $parsed{lc($k)} = $v; + } + + return \%parsed; + } + +sub go_slurp + { + my ($url, $file) = @_; + my $r = HTTP::Request->new(GET => $url); + my $re = LWP::UserAgent->new->request($r); + my $data = $re->content(); + open F, ">$file" or return $data; + print F $data; + close F; + my @lines = split "\n", $data; + return \@lines; + } + +sub quickread + { + my $file = shift; + my @out; + open F, $file or die "problem with $file $!"; + @out=; + close F; + return \@out; + } + +1; + diff --git a/lib/rand.pm b/lib/rand.pm new file mode 100644 index 0000000..bf42e7d --- /dev/null +++ b/lib/rand.pm @@ -0,0 +1,20 @@ +#!/usr/bin/perl + +sub get_random_line + { + my ($file) = @_; + my $line; + + # inscrutable random line algorithm -- from the camel book + # $. is the number of the last line accessed + open FORTUNES, "$BUCKY_FORTUNES/$file" or error("Could not access fortune $file"); + srand; + rand($.) < 1 && ($line = $_) while ; + close FORTUNES; + + chomp $line; + return $line; + } + +1; + diff --git a/lib/randbg.pm b/lib/randbg.pm new file mode 100644 index 0000000..9f484f1 --- /dev/null +++ b/lib/randbg.pm @@ -0,0 +1,26 @@ +# randbg +# +# generates a background color within 0x0F of a given hex value. +# +# $bgcolor = randbg(0xfff); +# returns [#f0f0f0, #ffffff] +# $bgcolor = randbg(0x000); +# returns [#000000, #0f0f0f] +# $bgcolor = randbg(0x04d); +# returns [#0040d0, #0f4fdf] + +sub randbg { + my $base = shift; + my $i = sprintf '%06x' , + ((0xf00 & $base) * 0x100000 + (int rand 0x10) * 0x010000 + + (0x0f0 & $base) * 0x001000 + (int rand 0x10) * 0x000100 + + (0x00f & $base) * 0x000010 + (int rand 0x10) * 0x000001); + return $i; +} + +# randbg (0xfff); +# randbg (0x000); +# randbg (0x04d); + +1; + diff --git a/lib/session.pm b/lib/session.pm new file mode 100644 index 0000000..2074ee4 --- /dev/null +++ b/lib/session.pm @@ -0,0 +1,262 @@ +#!/usr/bin/perl +######################################### +# _session.txt +# coordinates all raw input/output +# plus formatting and headers for some reason + +use DBI; +use Image::Size; +use constants; + +our $base_path = $BUCKY_CONFIG->{BASE_PATH}; +our $temp_path = $base_path."incoming"; +our $data_path = $base_path."data"; +our $live_path = "/bucky/data"; + +our $USER = -1; + +our $input = getargs( { base => $temp_path, file => "temp_[(field)]" } ); + +our $DEBUG = $ENV{REQUEST_URI} =~ /debug/; +if ($DEBUG) { print "Content-type: text/html\n\nENTERING DEBUG MODE . . .

"; } + +$input->{object_from_uri} = get_object_from_uri(); +$input->{script_from_uri} = get_script_from_uri(); + +our $cookies = getCookies(); + +our $dsn = "DBI:mysql:$BUCKY_DB:localhost;mysql_read_default_file=$BUCKY_DB_CNF"; +our ($dbh, $sth); + +# extract script from URI +sub get_script_from_uri + { + my $request_uri = $ENV{REQUEST_URI}; + # /profile + # /profile/ + # /profile/jules + # /profile/jules/ + # /profile?username=jules + # /profile/jules?username=rakubian + + my ($script, $object) = $request_uri =~ /^$BUCKY\/(\w+)\/?(\w+)?\??/; + return $script if (length($script) > 0); + return undef; + } + +# extract object from URI, if using / URI delimiters +sub get_object_from_uri + { + my $request_uri = $ENV{REQUEST_URI}; + + my ($method, $object) = $request_uri =~ /^$BUCKY\/(\w+)\/([a-zA-Z0-9]+)/; + + # only return object if it exists and has a length > 0 + print "method: $method
\n" if ($DEBUG); + print "view: $object
\n" if ($DEBUG); + + return $object if (length($object) > 0); + return undef; + +# return $object || undef; +# return ""; + } + +# check cookies, return userhash, lastlog +sub checkin + { + my $lastlog; + + my $user = check_cookie(); + if (ref($user) && $user != -1) + { print "
HELLO $user->{username}
" if $DEBUG; } + elsif ($ENV{REQUEST_URI} =~ /$BUCKY\/invite/) + { return ( -1 ); } + else + { logout(0); } + + $lastlog = lastlog($user); + touch_user($user->{id}) if ($user != -1); + return ($user, $lastlog); + } + +sub check_cookie + { + if (exists($cookies->{name})) + { + if ($cookies->{name} && $cookies->{name} ne 'unknown') + { $user = auth($cookies->{name}, $cookies->{pass}); } + elsif ($ENV{REQUEST_URI} =~ /$BUCKY\/invite/) + { return ( -1 ); } + } + } +# check passwords, set cookie +sub auth + { + my ($inname, $inpass) = @_; + + $inname = lc($inname); +# $inname = "marc"; + + my ($dbuh) = get_user($inname); + + if ($dbuh != -1 && $dbuh->{ulevel} > 0 && $dbuh->{password} eq $inpass) + { + my $forever = check_key($dbuh->{boxes}, "nologout"); + setCookie( { name => "name", value => $inname, path => "$BUCKY/", domain => $BUCKY_COOKIE_DOMAIN, nologout => $forever } ); + setCookie( { name => "pass", value => $inpass, path => "$BUCKY/", domain => $BUCKY_COOKIE_DOMAIN, nologout => $forever } ); +# setCookie("name", $inname, "$BUCKY/", $BUCKY_COOKIE_DOMAIN ); +# setCookie("pass", $inpass, "$BUCKY/", $BUCKY_COOKIE_DOMAIN ); + + return ($dbuh); + } + else +# { return -1; } + { logout(0); } + } + +sub logout + { + my $error = shift; + my $lender = undef; + my $s = $ENV{'HTTPS'} eq "on" ? "s" : ""; + + setCookie( { name => "name", value => undef, path => "$BUCKY/", domain => $BUCKY_COOKIE_DOMAIN } ); + setCookie( { name => "pass", value => undef, path => "$BUCKY/", domain => $BUCKY_COOKIE_DOMAIN } ); + +# setCookie("name", "", "$BUCKY/", $BUCKY_COOKIE_DOMAIN ); +# setCookie("pass", "", "$BUCKY/", $BUCKY_COOKIE_DOMAIN ); + + print "Location: http$s://$BUCKY_HOST$BUCKY/login"; + + if ($ENV{REQUEST_URI} !~ /login/ && $ENV{REQUEST_URI} !~ /logout/ && $ENV{REQUEST_URI} ne "$BUCKY/index" && $ENV{REQUEST_URI} ne "/bucky/") + { + $lender .= "redir=$ENV{REQUEST_URI}"; + } + + if (defined($lender) || $error > 0) + { + print "?"; + print "error=$error&" if ($error > 0); + print $lender; + } + + print "\n\n"; + + $dbh->disconnect() if (defined($dbh)); + exit (0); + } + +sub nice_redirect + { + my $uri = ''; + if ($input->{redir} && $input->{redir} ne "/bucky/") + { + redirect($input->{redir}); + } + else + { + redirect("$BUCKY/index"); + } + } + +sub redirect + { + my $uri = shift; + my $s = ($ENV{'HTTPS'} eq "on" || exists($input->{secure})) ? "s" : ""; + print "Location: http$s://$BUCKY_HOST$uri\n\n"; + $dbh->disconnect() if (defined($dbh)); + exit (0); + } + +sub error + { + my $reason = shift; +# my $f = get_random_flagged_image(); + if (defined($USER) && $USER != -1) + { + header("

error: $reason
"); + print qq(
); + print qq(
); + print qq(
); + my $filename = lc($f->{filename}); + print qq!
\n!; + print "

sorry, there was an error:

$reason

"; + print qq!go back | home\n!; + print qq(

); + print qq(
); + } + else + { + header("error: $reason"); + print "there was an error:

$reason

"; + } + footer(); + $dbh->disconnect() if (defined($dbh)); + exit(1); + } + +sub corral + { + my ($things, $key) = @_; + my @values; + foreach my $k (sort keys %$things) + { + next unless ($k =~ /^$key/); + push @values, $things->{$k}; + } + return sort @values; + } + +# keys -- for storing arrays of ids + +sub split_keys + { + my ($string) = @_; + my @out; + foreach my $v (split(" ", $string)) + { + if (defined($v)) + { push @out, $v; } + } + return @out; + } + +sub check_key + { + my ($string, $key) = @_; + if ($string =~ /\s$key\s/) + { return 1; } + else + { return 0; } + } + +sub add_key + { + my ($string, $key) = @_; + $string .= " $key " unless (check_key($string, $key)); + $string =~ s/( )+/ /g; + return $string; + } + +sub toggle_key + { + my ($string, $key) = @_; + if (check_key($string, $key)) + { $string =~ s/ $key / /; } + else + { $string .= " $key "; } + $string =~ s/( )+/ /g; + return $string; + } + +sub delete_key + { + my ($string, $key) = @_; + $string =~ s/ $key / /; + $string =~ s/( )+/ /g; + return $string; + } + +1; + diff --git a/lib/settings.pm b/lib/settings.pm new file mode 100644 index 0000000..2767cac --- /dev/null +++ b/lib/settings.pm @@ -0,0 +1,315 @@ +############################################# +# SETTINGS - thread maintain forms + +sub admin_form + { + my ($id, $t, $f, $k) = @_; + print < + +adminhead + if ($t->{files} > 0) + { + print qq(\n); + } + else + { + print qq(\n); + } + print < +
+exit settings screen


+adminhead + ($many, $flagged) = find_jpeg($files, $t->{flagged}); + print qq!!; + + thread_display_settings($id, $t, $k); + keyword_display_settings($id, $t, $k); + print q{ }; + + if ($t->{files} > 0) + { + print q{ }; + file_display_settings($id, $t); + print q{ }; + } + print q{}; + print q{}; + thread_delete_box($id); + print q{}; + print q{}; + } + +sub thread_display_settings + { + my ($id, $t, $k) = @_; + + my $rcolor = get_color($t, $k); + + print qq!

!; + print qq!
!; + print <display settings +
+keywordhead + print qq!
!; + print qq!
\n!; + print qq{\n} if ($DEBUG); + print qq{\n}; + print qq{\n}; + + print qq!!; + print qq!!; + print qq!!; + print qq!!; + print qq!!; + print qq!!; + print qq!!; + print qq!!; + print qq!!; + + print qq!!; + print qq!!; + print qq!
!; + print qq(title: ); + print qq!!; + print qq( ); + print qq!
!; + print qq(color: ); + print qq!!; + color_dropdown($rcolor, 0); + print qq!
 !; + + print qq!!; + print qq!!; + onecheckbox("shorturl", "shorten urls", $t->{display}); + print qq!!; + print qq!!; + onecheckbox("editable", "comments editable by ops", $t->{display}); + print qq!!; + print qq!!; + onecheckbox("opset", "post settings available to ops", $t->{display}); + print qq!!; + onecheckbox("no-zip-button", "no zip button", $t->{display}); + print qq!!; + + if ($t->{keyword} ne undef) + { + onecheckbox("hidekws", "hide keyword list", $t->{display}); + } + + if ($t->{files} > 5) + { + print qq!
!; + print qq!!; + my $ffl = check_key($t->{display}, "ffl"); + my $nfl = check_key($t->{display}, "nfl"); + oneradiobutton("filelist", 2, "full file list", $ffl); + print qq!!; + oneradiobutton("filelist", 1, "trim if many images", (!$nfl && !$ffl)); + print qq!!; + oneradiobutton("filelist", 0, "no file list", $nfl); + print qq!!; + print qq!
!; + } + print qq!
!; + print qq!!; + print qq!!; + print qq!!; + + print qq!
!; + print qq!!; + print_garrow("date posted", (verbosedate($t->{createdate}))); + print_garrow("last changed", (verbosedate($t->{lastmodified}))); + print_garrow("total comments", (hushnull($t->{comments}))); + print_garrow("total files", (hushnull($t->{files}))); + my $par = get_participation($t->{id}); + my $ps = $par != 1 ? 's' : ''; + print_garrow("participating",(hushnull($par).qq! duder$ps!)); + if ($t->{zipped} == -1) + { + my $zipfile = retrieve_zip_mechanism($t); + if ($zipfile == 1) + { print_garrow("zipfile?", qq(in progress)); } + } + if ($t->{zipped} == 0) + { + print_garrow("zipfile?", qq(none)); + } + if ($t->{zipped} == 1) + { + my $zip = get_file_from_filename(generate_zip_filename($t)); + print_garrow("zipfile?", qq(exists, complete as of ).(verbosedatetime($zip->{date}))[0].qq(
freshen | flush)); + } + print qq!
!; + + print qq!
!; + print qq!
!; + print qq!
!; + + print qq!!; + print qq!!; + + print < +
+category settings +
+keywordhead + +# no keyword set + if ($t->{keyword} eq undef) + { + print qq!\n!; + print qq{\n} if ($DEBUG); + print qq{\n}; + print qq{\n}; + print qq!!; + print qq! + + + + +
SELECT ONE:  !; + keyword_pulldown($t->{keyword}); + print < + +
+or
make new category +
+kwform + } + else + { + print qq{current category: $k->{keyword}}; + + print qq! · detach!; + + if ($k->{owner} eq $USER->{username} || check_op($k) || $USER->{ulevel} == 3) + { + print qq! · settings!; + } + } + print < +
+privacy settings +
+kwform + + print qq!!; + print qq!!; + print qq!!; + print qq!
viewable by  ·!; + privacy_select("private", $t->{private}); + print qq!
!; + if ($t->{private} > 1) + { + print qq!\n!; + print qq!users checked off below will be able to read and update this post!; + if ($k != -1 && $k->{public} != 1) + { + print qq!,
but cannot see the rest of the keyword!; + } + print qq!.\n!; + print qq!!; + user_checkerboard($t->{allowed}, undef, $t->{username}); + } + print < + + +
+ +privend + } + +sub file_display_settings + { + my ($id, $t) = @_; + print < +file settings
+
+dirtop + + print qq!
!; + print qq{\n}; + print qq{\n}; + print qq{\n} if ($DEBUG); + print < + + + + · + + +actionform + file_list($files, -1, 1); + print < + +end + } + +sub thread_delete_box + { + my ($id) = @_; + print < + + + + + + + + + + +formend + } + +############################################# + +sub print_garrow + { + my ($a, $b) = @_; + $a =~ s/\s/ /g; + print qq!$a:$b\n!; + } + +1; + diff --git a/lib/tags.pm b/lib/tags.pm new file mode 100644 index 0000000..5e6e0a6 --- /dev/null +++ b/lib/tags.pm @@ -0,0 +1,147 @@ +sub get_tags_from_string + { + my ($tags_string) = @_; + + my @tags; + my @raw_tags; + my @new_tags; + + # Determine delimiters: commas or spaces + + # count commmas + my $countComma = $tags_string =~ s/(\,)/$1/gi; + + # comma delimiter? + if ( $countComma > 0 ) + { + @raw_tags = split ( '\,', $tags_string ); + } + # no comma delimiter, try for next delimiter + else + { + # count chunks of whitespace + my $countWhitespace = $tags_string =~ s/(\s+)/$1/gi; + + # whitespace delimiter? + if ( $countWhitespace > 0 ) + { + @raw_tags = split ( /\s+/, $tags_string ); + } + + # no delimiter, treat entire thing as tag + else + { + push( @raw_tags, $tags_string ); + } + } + + # clean up each raw tag + foreach my $raw_tag (@raw_tags) + { + # Clean whitespace, bad chars + $raw_tag = scrub($raw_tag); +# print "raw tag: $raw_tag
\n"; + next unless (length($raw_tag) > 0) && (length($raw_tag) <= 16); + + # If already a tag, just store name + if ( tag_already( $raw_tag ) ) + { +# print "Tag Already: $raw_tag
\n"; + push ( @tags, $raw_tag ); + } + # If not a tag, add to new tags array so we can create new tag + else + { +# print "Tag New: $raw_tag
\n"; + new_tag( $raw_tag ); + push ( @tags, $raw_tag ); + + } + } + + return \@tags; + + # retrieve already existing tags + + # create new tags + } +sub tags_stringify_links + { + my ($t, $limit) = @_; + my $tags = $t->{tags} || return ''; + my $thread_id = $t->{id}; + + + my $tags_links; + foreach my $tag (@$tags) + { + next if (defined($limit) && $limit-- <= 0); + push( @$tags_links, "$tag" ); + } + my $return_string = join(', ', @$tags_links) if ref($tags); + if (defined($limit) && ($limit < 0) ) + { $return_string .= " ..."; } + return $return_string || ''; +# return join(', ', @$tags_links ) if ref($tags); +# return ''; + } +sub tags_stringify + { + my ($tags) = @_; + return join(', ', @$tags ) if ref($tags); + return ''; + } +sub tag_assign_mechanism + { + my ($tag_name, $t) = @_; + + # Verify inputs + error("no tag specified!") if (!defined($tag_name)); + error("no thread specified!") if (!defined($t)); + + # Retrieve tag object + my $tag = get_tag( $tag_name ) || error("no tag $tag_name"); + + # Check to see if tag is already associated with thread + # Add association for thread_id + if ( ! tag_thread_already( $tag, $t) ) + { + update_tag_for_thread( $tag, $t ); + return "Assigning tag $tag_name
\n"; + } + } +sub tag_remove_mechanism + { + my ($tag_name, $t) = @_; + + # Verify inputs + error("no tag specified!") if (!defined($tag_name)); + error("no thread specified!") if (!defined($t)); + + # Retrieve tag object + my $tag = get_tag( $tag_name ) || error("no tag $tag_name"); + + if ( tag_thread_already( $tag, $t) ) + { + delete_tag_for_thread( $tag, $t ); + return "Removing tag $tag_name
\n"; + } + } +sub tag_already + { + my ($tag_name) = @_; + my $tag = get_tag_count( $tag_name ); + return ($tag > 0); + } +sub tag_thread_already + { + my ( $tag_name, $thread ) = @_; + if (ref($tag_name)) + { $tag_name = $tag_name->{tag}; } + if (! ref($thread)) + { $thread = get_thread( $thread ); } +# print "those tags: " . $thread->{tags} . "
\n"; + return grep ( /^$tag_name$/, @{$thread->{tags}} ) + } +1; + diff --git a/lib/threads.pm b/lib/threads.pm new file mode 100644 index 0000000..b20bbc6 --- /dev/null +++ b/lib/threads.pm @@ -0,0 +1,411 @@ +######################################### +# THREADS.PM + +my $r = 0; +my $firstbox = 1; +my %tk; + +our $our_keywords = {}; + +sub alpha_index + { + my ($keywords, $limit, $date) = @_; +$our_keywords = $keywords; + my %organized; + my $oldest = $date eq "now" ? time : $date; + my $recently = time - 86400 * $BUCKY_INDEX_LATEST; # two days ago + my $i = 0; + + while ($limit > $i) + { + my $threads = throttle_threads({ keyword => $keyword, limit => ($limit-$i), newest => $oldest, oldest => 0 }); + last if ($threads == -1); + foreach my $t (@$threads) + { + if ( check_privacy ( $t, $keywords->{ $t->{keyword} } ) ) + { + # If keyword is undefined, file it under "unsorted" + my $this_kw = $t->{keyword} ? $t->{keyword} : "unsorted"; + + # put newest (last 2 days) or unsorted posts in one place + if ( $t->{date} > $recently || ! length($t->{keyword}) ) + { + push @{ $organized{'latest'} }, $t; + } + + push @{$organized{$this_kw}}, $t; + $i++; + } + $oldest = $t->{date} if ($t->{date} < $oldest); + last if ($limit == $i); + } + print "Oldest: $oldest, i: $i\n" if ($DEBUG); + } + + if ($date eq "now") + { + foreach my $k (sort { lc($a) cmp lc($b) } keys %$keywords) + { + next unless (check_key($USER->{stickies}, $k)); + next if (check_key($USER->{sink}, $k)); + next unless (exists($organized{$k})); + thread_box({ threads => $organized{$k}, kw => $keywords->{$k}, dosum => 0, dohead => 1 }); +# print qq(); + } +# print qq(); + } + +print qq(); + index_photostream(); +print qq(); + + thread_box({ threads => $organized{"latest"}, kw => "LATEST", dosum => 0, dohead => 1 }); + + foreach my $k (sort { lc($a) cmp lc($b) } (keys(%organized))) + { + next if (check_key($USER->{stickies}, $k)); + next if (check_key($USER->{sink}, $k)); + next if ($k =~ /^(unsorted|latest)$/i); + thread_box({ threads => $organized{$k}, kw => $keywords->{$k}, dosum => 0, dohead => 1 }); + print qq(); + } + + thread_box({ threads => $organized{"unsorted"}, dosum => 0, dohead => 1 }) if ($BUCKY_CONFIG->{UNSORTED_POSITION} eq "bottom"); + + if ($i >= $limit) + { + print qq(); + print qq(show all >>); + } + } + +sub thread_box + { + my ($args) = @_; + my $threads = $args->{threads} || undef; + my $kw = $args->{kw} || undef; + my $tag = $args->{tag} || undef; + my $dosum = exists($args->{dosum}) ? $args->{dosum} : undef; + my $dohead = exists($args->{dohead}) ? $args->{dohead} : undef; + my $line = 0; + my $user = 0; + my $latest = 0; + $dosum = 1 unless (defined($dosum)); + $dohead = 1 unless (defined($dohead)); + my $sum = 0; + my $isop; + $firstbox = 1; + my $method = \&rsort_by_date; + if (exists($args->{sort_by}) && $arts->{sort_by} eq "name") + { $method = \&sort_by_name; } + if ($kw eq "USER") + { + $user = 1; + $isop = 1; + $kw = -1; + } + elsif ($kw eq "LATEST") + { + $latest = 1; + $isop = 1; + $kw = -1; + } + elsif ($kw != -1) + { $isop = check_op($kw); } + else + { $isop = 1; } + foreach my $th (&{$method}(@$threads)) + { + my $printed = 0; +# next if ($kw == -1 && defined($th->{keyword})); + if ($line == 0) + { + if ($dohead && $tag) + { + print qq(); + print qq[]; + print qq[tag: ]; + print qq(); + print qq(); + print qq(); + print qq(); + print qq[]; + print qq($tag->{tag}); + print qq(); + print qq(); + print qq(); + } + if ($dohead && $latest) + { + print qq(); + print qq[]; + print qq(the latest ); + print qq(); + print qq(·); + print qq(); + print qq(welcome back to $BUCKY_NAME!! Start a new thread...); + print_boxtop(1); + } + elsif ($dohead && (!defined($kw) || $kw == -1)) + { + my $unsorted_keyword = get_random_line("keywords"); + print qq(); + print qq[]; + print qq[]; + print $unsorted_keyword; + print qq(); + print qq( · ); + print qq(); + print qq(); + print qq(show all); + print qq( · post); + print qq( · ftp); + print qq(); + print qq(); + } + elsif ($user) + { + # this is all broken for some reason, is rewritten somewhere...! + print_boxtop(1); + } + elsif ($dohead) + { + $polite_keyword = $th->{keyword}; + $polite_keyword =~ s/ / /g; + print qq(); + print qq[]; + print qq[]; + print $polite_keyword; + print qq(); + print qq( · ); + print qq(); + print qq(); + if ($kw->{public} == 1 || $isop) + { + # print qq(show all); + # print qq( · ); + + print qq(post) if ($USER != -1); + + # 20070903 - marc - no more ftp + print qq( · ftp); + } + if ($isop || $USER->{ulevel} == 3) + { + print qq( · ); + print qq(settings); + } + print qq(); + print qq(); + } + $line++; + } + if ($dosum == -1) + { $printed = check_thread_row($th, $kw, 4, $line); } + else + { $printed = check_thread_row($th, $kw, 3, $line); } + $sum += $th->{size}; + $line++ if ($printed); + last if ($dosum == -1 && $line == 6); + } + if ($line != 0) + { + print_boxbottom(1); + if ($dosum > 0) + { + $line -= 1; + my $s = $line != 1 ? 's' : ''; + print qq($line thread$s); + print qq(, ).hushsize($sum,1.7).qq(); + } + } + } + +sub print_boxtop + { + print qq!!; + } + +sub print_boxbottom + { + print qq!!; + } + +sub check_thread_row + { + my ($thread, $keyword, $brief, $box) = @_; + my $priv = 0; +# uncomment to skip threads already printed +# return 1 if ($tk{$thread->{id}} == 1); + $tk{$thread->{id}} = 1; + return 1 if ($brief eq "NOPRINT"); + if ($thread->{private} != 0) + { + $priv = check_privacy($thread, $keyword); + if ($priv == 0) + { return 0; } + } + if ($box == 1 && $keyword != -1) + { + print_boxtop($firstbox); + } + if ($thread->{'keyword'} && $keyword == -1) { $keyword = $our_keywords->{$thread->{'keyword'}} } + display_thread($thread, $keyword, $r, $priv, $brief, $box); + $r = $r ? 0 : 1; + return 1; + } + +sub display_thread + { + my ($t, $k, $r, $priv, $brief, $box) = @_; + my $color = carbondate($t->{date}); + my $rcolor = get_color($t, $k, $box); + my $old = ((time - $t->{date}) > 2419200) ? 1 : 0; + my $box = (defined($box)) ? $box : 0; + + if ($DEBUG) + { + print qq!
Displaying post $t->{id} -- $t->{title}
\n!; + } + + print qq[]; + + print qq[]; + print ""; + print qq[$t->{username} ]; + + if ($t->{private} == 2) + { print qq[.:]; } + elsif ($t->{private} == 1) + { print qq[:]; } + else + { print qq[·]; } + print " "; + print ""; + + if ($box > 0) + { + $rcolor = "tan" if ($rcolor eq "plain"); + print qq(); + } + else + { + print qq[]; + } + my $thread_link_class; + if ($t->{date} > (time - 209828) && $t->{date} > 1168910000) + { $thread_link_class = "threadname newthread"; } + else + { $thread_link_class = "threadname"; } + + print qq(); + print qq($t->{title}); + print qq(); + print ""; + + my ($age) = get_age($t->{date}); + + print qq(); + print ""; + print qq(  $age ); + print ""; + print ""; + +# my ($tddate, $tdtime) = verbosedatetime($t->{date}); +# print qq[]; +# print qq[ $tddate ]; +# print ""; +# if ($0 !~ /(details|profile)/) +# { +# print qq[]; +# print qq[$tdtime]; +# print ""; +# } + + print qq[]; + print " "; + if ($t->{viewed} > 0) + { print hushview($t->{viewed}, "v") . ""; } + else + { print ""; } + # decrement comments count here so we treat the first comment" as the body of the post + if (($t->{comments} - 1) > 0) + { print " ".hushnull($t->{comments} - 1, "c") . ""; } + else + { print " "; } + +# print qq[]; +# if (!ref($t->{tags})) +# { print " "; } +# else +# { print "  ". tags_stringify_links ( $t, 3 ). ""; } +# if ($t->{files} > 0) +# { print "" .hushnull($t->{files}, "f") . ""; } +# else +# { print " "; } + +# print ""; + + print qq[]; + if ($t->{files} > 0) + { + print " ".hushsize($t->{size},1.2,$old),qq[]; + if ($0 !~ /(details|profile)/) + { + print qq[in ]; + print hushnull($t->{files}, "f"); + print ""; + } + } + print ""; + + print qq[\n]; + } + +# sort methods +# title, date, size, files, username + +sub get_sort_method + { + my ($s, $o) = @_; + + if ($o eq "a") + { + if ($s eq "t") { return \&sort_by_title; } + elsif ($s eq "s") { return \&sort_by_size; } + elsif ($s eq "d") { return \&sort_by_date; } + elsif ($s eq "c") { return \&sort_by_comments; } + elsif ($s eq "f") { return \&sort_by_files; } + elsif ($s eq "a") { return \&sort_by_author; } + } + elsif ($o eq "d") + { + if ($s eq "t") { return \&rsort_by_title; } + elsif ($s eq "s") { return \&rsort_by_size; } + elsif ($s eq "d") { return \&rsort_by_date; } + elsif ($s eq "c") { return \&rsort_by_comments; } + elsif ($s eq "f") { return \&rsort_by_files; } + elsif ($s eq "a") { return \&rsort_by_author; } + } + else + { return \&rsort_by_date; } + } + +sub sort_by_name { sort { uc($$a{title}) cmp uc($$b{title}) } @_; } +sub sort_by_title { sort { uc($$a{title}) cmp uc($$b{title}) } @_; } +sub rsort_by_title { sort { uc($$b{title}) cmp uc($$a{title}) } @_; } +sub sort_by_date { sort { $$a{date} <=> $$b{date} } @_; } +sub rsort_by_date { sort { $$b{date} <=> $$a{date} } @_; } +sub sort_by_size { sort { $$a{size} <=> $$b{size} } @_; } +sub rsort_by_size { sort { $$b{size} <=> $$a{size} } @_; } +sub sort_by_files { sort { $$a{files} <=> $$b{files} } @_; } +sub rsort_by_files { sort { $$b{files} <=> $$a{files} } @_; } +sub sort_by_comments { sort { $$a{comments} <=> $$b{comments} } @_; } +sub rsort_by_comments { sort { $$b{comments} <=> $$a{comments} } @_; } +sub sort_by_author { sort { uc($$a{username}) cmp uc($$b{username}) } @_; } +sub rsort_by_author { sort { uc($$b{username}) cmp uc($$a{username}) } @_; } + +1; + -- cgit v1.2.3-70-g09d2