summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
l---------cgi-bin/21
-rwxr-xr-xcgi-bin/adminz207
-rwxr-xr-xcgi-bin/bless23
-rwxr-xr-xcgi-bin/category290
-rwxr-xr-xcgi-bin/comment186
-rwxr-xr-xcgi-bin/details275
-rwxr-xr-xcgi-bin/import286
-rwxr-xr-xcgi-bin/inbox125
-rwxr-xr-xcgi-bin/index293
-rwxr-xr-xcgi-bin/invite123
-rw-r--r--cgi-bin/localbucky.pm70
-rw-r--r--cgi-bin/localbucky.pm.tmpl54
-rwxr-xr-xcgi-bin/login86
-rwxr-xr-xcgi-bin/logout12
-rwxr-xr-xcgi-bin/maintain289
-rwxr-xr-xcgi-bin/message149
-rwxr-xr-xcgi-bin/murder23
-rwxr-xr-xcgi-bin/playlist81
-rwxr-xr-xcgi-bin/post267
-rwxr-xr-xcgi-bin/profile167
-rwxr-xr-xcgi-bin/recipe148
-rwxr-xr-xcgi-bin/services_f83
-rwxr-xr-xcgi-bin/services_k62
-rwxr-xr-xcgi-bin/services_th54
-rw-r--r--cgi-bin/settings24
-rwxr-xr-xcgi-bin/tag290
-rwxr-xr-xcgi-bin/users228
-rw-r--r--lib/Bucky1.pm53
-rw-r--r--lib/RGB.pm151
-rw-r--r--lib/boxes.pm165
-rw-r--r--lib/color.pm117
-rw-r--r--lib/comments.pm287
-rw-r--r--lib/constants.pm82
-rw-r--r--lib/cookies.pm55
-rw-r--r--lib/db.pm2400
-rw-r--r--lib/files.pm241
-rw-r--r--lib/format.pm414
-rw-r--r--lib/forms.pm854
-rw-r--r--lib/getargs.pm134
-rw-r--r--lib/headers.pm347
-rw-r--r--lib/images.pm509
-rw-r--r--lib/import.pm204
-rw-r--r--lib/invite.pm485
-rw-r--r--lib/keywords.pm187
-rw-r--r--lib/lastlog.pm29
-rw-r--r--lib/message.pm195
-rw-r--r--lib/privacy.pm133
-rw-r--r--lib/profile.pm127
-rw-r--r--lib/radio.pm100
-rw-r--r--lib/rand.pm20
-rw-r--r--lib/randbg.pm26
-rw-r--r--lib/session.pm262
-rw-r--r--lib/settings.pm315
-rw-r--r--lib/tags.pm147
-rw-r--r--lib/threads.pm411
55 files changed, 12346 insertions, 0 deletions
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: <b>$t->{title}</b><br>\n";
+ }
+ elsif ($input->{c} eq "pass")
+ {
+ do_password_reset();
+ }
+ elsif ($input->{c} eq "p")
+ {
+ if ($input->{private} == 1)
+ {
+ print "Thread is now <b>private</b>.<br>";
+ switch_thread_privacy($id, 1);
+ $t->{allowed} = update_whitelist();
+ $t->{private} = 1;
+ }
+ else
+ {
+ print "Thread is now <b>public</b>.<br>";
+ switch_thread_privacy($id, 0);
+ $t->{private} = 0;
+ }
+ }
+ elsif ($input->{c} eq "f")
+ {
+ my @flagged = corral($input, "file");
+ if ($DEBUG)
+ {
+ print "<br>\nfiles flagged: ";
+ foreach (@flagged)
+ { print; print " "; }
+ print "<br>\n";
+ }
+ if ($input->{verb} eq "flag")
+ {
+ print "Flagged file $flagged[0]<br>";
+ 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:!<br>\n";
+ print "Where do you want to move these files here<br>\n";
+ print "Moving files...<br>\n";
+ # system("mv", $data_path/$oldpid/$filenamea ..., "$data_path/$newpid/");
+ print "Moving ids...<br>\n";
+ print "Recalculating thread sizes...<br>\n";
+ }
+ elsif ($input->{verb} eq "rm")
+ {
+ if (!$input->{ok})
+ {
+ print qq!<center><p><div class="bluebox" style="width: 320px; padding: 10px;"><big><b>Are you sure you want to delete these files?</b></big><hr noshade color="$BUCKY_COLOR_HR"><p>\n!;
+ print qq!<form action="$BUCKY/maintain" method="post" enctype="multipart/form-data">!;
+ print qq{<input type=hidden name="c" value="f">\n};
+ print qq{<input type=hidden name="id" value="$id">\n};
+ print qq{<input type=hidden name="debug" value="1">\n} if ($DEBUG);
+ print qq{<input type=hidden name="verb" value="rm">\n};
+ print qq{<input type=hidden name="ok" value="1">\n};
+
+ my $i = 0;
+ my $fid = shift(@flagged);
+ foreach my $fh (sort_by_id(@$files))
+ {
+ next if ($fid != $$fh{id});
+ $i++;
+ print qq{<input type=hidden name="file$i" value="$fid">\n};
+ print $$fh{filename}."<br>\n";
+ $fid = shift(@flagged);
+ }
+
+ print qq{<br><input type="submit" value="YES YES DELETE THE FILES" class="clicky"></form></div></center>};
+ }
+ 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}<br>\n!;
+ $fid = shift(@flagged);
+ }
+
+ print "Recalculating thread size...<br>\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{<table width="100%" cellpadding=0 cellspacing=0 border=0><tr><td align=left valign=top>\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 <<end;
+<div class="message" style="float: right;">
+<b>password reset form</b>
+<hr color="$BUCKY_COLOR_HR">
+end
+ password_reset_form();
+ print "</div>";
+
+# "flush" zips button
+# recalculcate thread sizes
+# links to approval etc (alert!)
+ print qq{</td></tr></table>\n\n};
+ }
+
+sub password_reset_form
+ {
+ my $users = get_all_users();
+
+ print qq!<form action="$BUCKY/adminz" method="post" enctype="multipart/form-data">!;
+ print qq{<input type=hidden name="c" value="pass">\n};
+ print qq{<input type=hidden name="debug" value="1">\n} if ($DEBUG);
+ print qq!<table cellpadding=2 cellspacing=0 border=0>!;
+ print qq!<tr><td align="right">user:</td><td align="left">!;
+ print qq!<select name="user">!;
+ foreach $c (sort_by_username(@$users))
+ {
+ print qq!<option value="$c->{username}"!;
+ print qq!>$c->{username}</option>!;
+ }
+ print qq!</select>\n!;
+ print <<pws;
+</td></tr>
+<tr><td align="right">
+password?<br>
+</td><td align="left">
+<input type="password" name="pw1" value="" size=13 maxlength=20><br>
+</td></tr>
+<tr><td align="right" valign="top">
+<small>again!</small>
+</td><td align="left">
+<input type="password" name="pw2" value="" size=13 maxlength=20><br>
+<input type="submit" value="RESET PASSWORD" class="clicky">
+</td></tr>
+</table>
+pws
+ print qq!</form>\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}<br>\n);
+ }
+ else
+ {
+ print "passwords don't match!<br>\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 "<br><br>";
+ 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 "<br><br>";
+
+ keyword_form($k->{keyword}, $k);
+
+ print qq!<center><table border=0 cellpadding=0 cellspacing=0 class="threadmain" width="580">!;
+ my $threads = get_threads_by_keyword($k->{keyword});
+ thread_box({ threads => $threads, kw => $k });
+
+ print qq!</table>!;
+ 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}<br>\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}<br>\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}<br>\n"; }
+ print "keyword ==> $t->{keyword}<br>\n";
+ print "detaching <b>$t->{title}</b> from <b>$t->{keyword}</b><br>\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(<table width="100%" cellpadding=0 cellspacing=0 border=0>);
+ print qq(<tr>);
+#############################
+# KEYWORD LIST
+ print qq(<td align=center valign=top width="100">\n);
+ print qq(<div class="bluebox"><span style="line-height: 1.5em;"><nobr>);
+ 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(<big><big><b>$start - $pre</b></big></big><br> );
+ print $s;
+ print qq(</nobr></span></div>);
+ print qq(<div class="bluebox"><span style="line-height: 1.5em;"><nobr>);
+ $s = '';
+ $with_letter = 1;
+ $p='';
+ $start = $l;
+ }
+ }
+ $with_letter += 1;
+ $p||=$l;
+ $pre=$l;
+ $s .= qq(<a style="$css" href="$BUCKY/category/$k">$k</a><br>);
+ }
+if ($s)
+ {
+ print qq(<big><big><b>$start - $pre</b></big></big><br> );
+ print $s;
+ print qq(</div>);
+ print qq(<div class="bluebox"><small><span style="line-height: 1.5em;"><nobr>);
+ }
+ print qq(</div>);
+ print qq(<div class="bluebox"><small><span style="line-height: 1.5em;"><nobr>);
+ print qq(.: <a href="$BUCKY/category/unsorted"><i>unsorted</i></a> :.<br>);
+ print qq(</nobr></span></small></div></td>\n);
+
+ print qq(<td width="300" align=right valign=top>\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(</td>\n);
+ print qq(<td align=left valign=top>\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(<center><table border=0 cellpadding=0 cellspacing=0 class="threadmain" width="580">);
+
+ 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(</table>);
+ print qq(</td></tr>);
+
+ print qq(</table>\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(<span class="lite"><a href="$BUCKY/).details_link($thread).qq(/$comment->{thread}">back to post</a> &middot; $thread->{title}</span>),
+ $header_args->{color} = "ivory";
+
+ header ($header_args);
+ menu();
+ print <<duh;
+<table width=100% border=0 cellpadding=0 cellspacing=5>
+<tr><td align=center valign=top width=100%><div style="width: 399px;">
+duh
+ curt_post_form($comment);
+ print qq!</td></tr></table>\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(<span class="lite"><a href="$BUCKY/).details_link($thread).qq(/$comment->{thread}">back to post</a> ($thread->{title})</span>);
+ $header_args->{color} = "ivory";
+
+ header ($header_args);
+ menu();
+ print qq!<center><p><div class="bluebox" style="width: 320px; padding: 10px;"><big><b>Are you sure you want to !;
+ print qq!delete this comment?</b></big><hr noshade color="$BUCKY_COLOR_HR"><p>\n!;
+ my $subcomment = substr($comment->{comment}, 0, 64);
+ $subcomment =~ s/</&lt;/g;
+ $subcomment =~ s/>/&gt;/g;
+ $subcomment =~ s/"/&quot;/g;
+ print "<p>".$subcomment."</p>";
+ print qq!<form action="$BUCKY/comment" method="post" enctype="multipart/form-data">!;
+ print qq(<input type=hidden name="c" value="delete">\n);
+ print qq(<input type=hidden name="id" value="$comment->{id}">\n);
+ print qq(<input type=hidden name="debug" value="1">\n) if ($DEBUG);
+ print qq(<input type=hidden name="ok" value="yes">\n);
+
+ print qq(<br><input type="submit" value="DELETE" class="clicky"></form></div></center>);
+ print qq(</td></tr></table>\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(<span class="lite"><a href="$BUCKY/).details_link($thread).qq(/$comment->{thread}">back to post</a> &middot; $thread->{title}</span>);
+ $header_args->{color} = "ivory";
+
+ header ($header_args);
+ menu();
+ print <<duh;
+<table width=100% border=0 cellpadding=0 cellspacing=5>
+<tr><td align=center valign=top width=100%><div style="width: 399px;">
+duh
+ curt_reply_form($comment, $thread, $keyword);
+ print qq!</td></tr></table>\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}:<p><tt>";
+ }
+
+ $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 <a href="$BUCKY/profile/$t->{username}">$t->{username}</a> on ! .
+ verbosedate($t->{createdate}) . " &middot; active " . $age .
+ qq! &middot; $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! &middot; !;
+ $header_args->{subtitle} .= qq!<a href="$BUCKY/maintain/$t->{id}">options</a>!;
+ }
+# else
+# {
+# $header_args->{subtitle} .=
+# qq! &middot; <a href="$BUCKY/index">go to <b>index</b></a>!;
+# }
+
+ $header_args->{subtitle} .= qq! &middot; !;
+ $header_args->{subtitle} .= qq!<span class="lite"><a href="scp://$BUCKY_FTP_USER\@$BUCKY_FTP_HOST/var/bucky/$t->{id}">download\!</a></span>!;
+
+ my @participants = get_participants($t, $files, $comments);
+
+ $header_args->{sidetitle} = details_participation(@participants)
+ if (@participants > 0);
+ $header_args->{sidesubtitle} = "<small><i>see also:</i> ".details_tags_box($t, $kw)."</small>"
+ 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(<center><table border=0 cellpadding=0 cellspacing=0 width="100%">);
+ }
+ else
+ {
+ print qq(<center><table border=0 cellpadding=0 cellspacing=0>);
+ }
+
+ print qq(<tr><td align=right valign=top width=440>);
+ print qq(<table class="commentbox" cellpadding=0 cellspacing=0 border=0 width=440>);
+
+ if ($flagged != -1 && $many_jpgs > 1)
+ {
+ print qq(<td align=center valign=middle colspan=2>);
+ print_flagged_jpeg($flagged);
+ print qq(</td></tr>);
+ }
+
+ sideshow_comments({ thread => $t, keyword => $kw, comments => $comments });
+ print qq(<tr><td align=center valign=top colspan=2>);
+ reply_form($t->{id}, $t);
+ print qq(</td></tr>);
+ print qq(</table>);
+
+ if ($flagged != -1 && $many_jpgs == 1)
+ {
+ print qq(<td align=left valign=top colspan=2 style="padding: 10px;">);
+ print_flagged_jpeg($flagged);
+ }
+ elsif ($many_jpgs > 1 || @$files > $many_jpgs)
+ {
+ print qq(<td align=left valign=top style="padding-left: 5px;">);
+ }
+ else
+ {
+ print qq(<td align=left valign=top style="padding-left: 5px;">);
+ }
+ 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__;
+ <div id='mp3player'>LOADING MP3 PLAYER ...</div>
+
+<script type="text/javascript" src="/js/swfobject1.js"></script>
+<script type="text/javascript">
+ var s2 = new SWFObject("/mediaplayer.swf", "playlist", "392", "200", "7");
+ s2.addVariable("file","$z_playlist");
+ s2.addVariable("shuffle","false");
+ s2.addVariable("backcolor","0xEEEEEE");
+ s2.addVariable("frontcolor","0x111111");
+ s2.addVariable("lightcolor","0x444444");
+ s2.addVariable("displayheight","0");
+ s2.addVariable("width","392");
+ s2.addVariable("height","200");
+ s2.addVariable("volume","50");
+ s2.addVariable("autostart","$z_autoplay");
+ s2.write("mp3player");
+</script>
+__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 "</td>";
+
+ print qq(</tr></table></center>);
+ }
+
+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(&nbsp;);
+ $out .= qq(<a href="$BUCKY/profile/$p">);
+ $out .= qq(<img src="$image" width="$AVATAR_MED_WIDTH" height="$AVATAR_MED_WIDTH" border=1">);
+ $out .= qq(</a>);
+ }
+ }
+ if ($pcount > 6)
+ {
+ $out .= "<small>&nbsp;+&nbsp;".($pcount - 4);
+ $out .= "&nbsp;$BUCKY_DUDER_NOUN";
+ $out .= courtesy_s($pcount - 4);
+ $out .= "</small>";
+ }
+ 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(<table border=0 cellpadding=0 cellspacing=0 class="threadmain" width="$width">);
+ thread_box({ threads => $t, kw => $kw });
+ print qq(</table>);
+ }
+ }
+ }
+
+##############################
+
+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}."<br>"; }
+ }
+ 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<br>" 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: <a href="$BUCKY/details/$thread_id">link!</a>};
+ 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__;
+<center>
+<br>
+<div style="text-align: left; width: 300px; padding: 10px;" class="bluebox">
+<center><b><big>SORRY!</big></b>
+<hr noshade color="$BUCKY_COLOR_HR">
+You have maxed out your upload quota!<p>
+Delete some things you've uploaded, then try again.
+</center></div><br></center>
+__SORRY__
+ exit;
+ }
+ print <<impHEAD;
+<center>
+<br>
+<div style="float: right; text-align: left; width: 200px; padding: 10px; font-size: 11px; background-color: #f8f8f8;" class="bluebox"><center>
+
+<big><b>UPLOAD FILES TO BUCKY WITH CONVENIENCE USING SFTP</b></big>
+<hr noshade color="$BUCKY_COLOR_HR">
+
+You must generate a cryptographic key to use this service. Don't worry it's easy!<br/>
+<br/>
+<hr noshade color="#ddd">
+<br/>
+
+ON A MAC / UNIX<br/>
+<br/>
+recc'd sftp client: <a href="http://cyberduck.ch/" target="_blank">Cyberd*ck</a><br/>
+<b>to generate the key</b>, from Terminal run:<br/>
+<big><tt><b>ssh-keygen -t rsa</b></b></tt></big><br/>
+<a href="/cgi-bin/bucky/message/jules">send me the public key</a>
+<br/>
+(private key is handled automatically)
+<br/>
+<br/>
+<hr noshade color="#ddd">
+<br/>
+
+ON WINDOWS ...<br/>
+<br/>
+recc'd sftp client: <a href="http://winscp.net/" target="_blank">WINSCP (PC)</a><br/>
+<b>generate the key</b> with the program <a href="http://www.chiark.greenend.org.uk/~sgtatham/putty/download.html" target="_blank">puttygen</a>
+<br/>
+<a href="/cgi-bin/bucky/message/jules">send me the public key</a>
+<br/>
+(the private key goes in the program when you set up the session.)
+
+<br/>
+<br/>
+<hr noshade color="#ddd">
+<br/>
+
+log in here:
+<br/>
+<br/>
+<tt><big>
+$BUCKY_FTP_HOST<br>
+username: $BUCKY_FTP_USER</big></tt>
+
+<br/>
+<br/>
+<hr noshade color="#ddd">
+<br/>
+
+Once you're in, upload your files and they should show up below. <b>Check off</b> 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 <b>ftp here</b>.);
+ }
+ print qq!</center></div>\n\n!;
+
+ print qq!<form name="checkz" action="$BUCKY/import" method="post" enctype="multipart/form-data">\n!;
+ print qq!<div width=500>\n!;
+ ($title, $inc, $size) = list_imports();
+
+ print <<widget;
+<script type="text/javascript">
+<!--
+function toggle()
+ {
+ var e = document.checkz.elements.length;
+ for (var i = 0; i < e; i++)
+ {
+ var y = "document.checkz[i].type";
+ type = eval(y);
+
+ var n = "document.checkz[i]";
+ box = eval(n);
+
+ if (type == "checkbox")
+ {
+ if (box.checked == false)
+ { box.checked = true; }
+ else
+ { box.checked = false; }
+ }
+ }
+ }
+-->
+</script>
+<table cellpadding=0 cellspacing=0 width="580">
+<tr>
+<td align="left" valign="top"><input type=button value="toggle checked" onClick="JavaScript:toggle()"></td>
+<td align="center" valign="middle">
+widget
+
+ if ($inc)
+ {
+ print "<center><small><i><b>INCOMPLETE</b> FILES ARE SHOWN IN ITALICS -- PLEASE WAIT FOR YOUR UPLOAD TO FINISH</i></small></center><p>\n\n";
+ }
+
+ if ($DEBUG) { print qq!<input type="hidden" name="debug" value="$DEBUG">\n!; }
+ print qq!<input type="hidden" name="c" value="n">\n!;
+
+ print qq!<center>!;
+ print qq!<table cellpadding=2 cellspacing=0>!;
+ if ($thread != -1 && check_privacy($thread, $keyword))
+ {
+ print qq!<tr><td align="right" valign="baseline">!;
+ print qq!&nbsp;!;
+ print qq!<td><td align="left" valign="baseline">!;
+ print qq!These files will be added to:<p><big><b>$thread->{title}</b></big><br>\n!;
+ print qq!posted by $thread->{username} on !.verbosedate($thread->{createdate}).qq!<p>\n\n!;
+ print qq!<input type="hidden" name="id" value="$thread->{id}">\n!;
+ print qq!</td></tr>!;
+ }
+ else
+ {
+ print qq!<input type="hidden" name="id" value="new">\n\n!;
+ print qq!<tr><td align="right" valign="baseline">!;
+ print qq!title:&nbsp;!;
+ print qq!<td><td align="left" valign="baseline">!;
+ print qq!<input type="text" name="title" value="$title" size=40 maxlength=48><br>\n!;
+ print qq!</td></tr>!;
+ print qq!<tr><td align="right" valign="baseline">!;
+ print "keyword:&nbsp;";
+ print qq!<td><td align="left" valign="baseline">!;
+ 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!</td></tr>!;
+ }
+ print qq!<tr><td>!;
+ print "&nbsp;";
+ print qq!</td></tr>!;
+
+ print qq!<tr><td align="right" valign="top">!;
+ print qq!comment:&nbsp;!;
+ print qq!<td><td align="left" valign="top">!;
+ print <<impFOOT;
+<p>
+<textarea name="comment" cols="40" rows="10"></textarea>
+<p>
+<input type="submit" value="IMPORT" class="clicky">
+</td>
+</tr>
+</table>
+</td>
+</tr>
+</table>
+</center>
+</form>
+</div>
+
+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 "<br><br>";
+ 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!<center>!;
+
+ print <<userbox;
+<div class="bluebox" style="float: right;">
+<b>message center</b>
+<hr noshade color="$BUCKY_COLOR_HR">
+<center>
+<table border=0 cellspacing=2 width=100>
+<tr><td align=left><small><b>Folders</b></small></td><td align=center><small>msgs</small></td></tr>
+userbox
+
+ foreach my $b (@$boxes)
+ {
+ my $count = $b->{mcount} || 0;
+ my $bn = $b->{mbox};
+ $bn =~ s/^$USER->{username}\.//;
+ print qq!<tr><td align=left><small><a href="$BUCKY/inbox/$bn"><b>$bn</b></a></small></td>! .
+ qq!<td align=center>!.hushnull($count, undef, 1).qq!</td></tr>!;
+ }
+
+ print <<userbox;
+</table>
+</center>
+<hr noshade color="$BUCKY_COLOR_HR">
+<small>
+<a href="$BUCKY/message"><b>Compose New Mail</b></a>
+</small>
+<hr noshade color="$BUCKY_COLOR_HR">
+<small>
+need to find someone?<br>
+<a href="$BUCKY/users"><u>check the userlist</u></a>
+</small>
+</div>
+userbox
+
+ print qq!<table width="100%" cellpadding=0 cellspacing=0 border=0><tr><td align=left valign=top>!;
+
+ message_list($messages, $box);
+
+ if (@$messages == $limit)
+ {
+ print qq!<div align="right"><big><br>!;
+ $oldest = $messages->[-1]->{date};
+ print qq(<a href="$BUCKY/inbox/$box&limit=$limit&start=$oldest">next <b>$limit</b> messages &gt;&gt;</a>);
+ print qq!</big></div>\n!;
+ }
+
+ print qq!</td></tr></table>!;
+
+ 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 "<br><br>";
+ 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 "<br><br>";
+
+ keyword_form($k->{keyword}, $k);
+
+ print qq!<center><table border=0 cellpadding=0 cellspacing=0 class="threadmain" width="580">!;
+ my $threads = get_threads_by_keyword($k->{keyword});
+ thread_box({ threads => $threads, kw => $k });
+
+ print qq!</table>!;
+ 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}<br>\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}<br>\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}<br>\n"; }
+ print "keyword ==> $t->{keyword}<br>\n";
+ print "detaching <b>$t->{title}</b> from <b>$t->{keyword}</b><br>\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(<table width="100%" cellpadding=0 cellspacing=0 border=0>);
+ print qq(<tr>);
+
+#############################
+# KEYWORD LIST
+ print qq(<td align=center valign=top style="width: 100px">\n);
+ print qq(<div class="bluebox" width="100"><span style="line-height: 1.5em;"><nobr>);
+ 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(<big><big><b>$start - $pre</b></big></big><br> );
+ print $s;
+ print qq(</nobr></span></div>);
+ print qq(<div class="bluebox" width="100"><span style="line-height: 1.5em;"><nobr>);
+ $s = '';
+ $with_letter = 1;
+ $p='';
+ $start = $l;
+ }
+ }
+ $with_letter += 1;
+ $p||=$l;
+ $pre=$l;
+ $s .= qq(<a style="$css" href="$BUCKY/category/$k">$k</a><br>);
+ }
+if ($s)
+ {
+ print qq(<big><big><b>$start - $pre</b></big></big><br> );
+ print $s;
+ print qq(</div>);
+ print qq(<div class="bluebox" width="100"><small><span style="line-height: 1.5em;"><nobr>);
+ }
+ print qq(</div>);
+ print qq(<div class="bluebox"><small><span style="line-height: 1.5em;"><nobr>);
+ print qq(.: <a href="$BUCKY/category/unsorted"><i>unsorted</i></a> :.<br>);
+ print qq(</nobr></span></small></div></td>\n);
+
+#############################
+# PRINT MAIN PANE
+ print qq(<td align=left valign=top>\n);
+
+# index_photostream($keyword,$tag);
+
+# print qq(<table border=0 cellpadding=0 cellspacing=0 class="threadmain" width="580">);
+# print qq(<table border=0 cellpadding=0 cellspacing=0 class="threadmain">);
+ print qq(<table border=0 cellpadding=0 cellspacing=0 class="threadmain" width="100%">);
+
+ 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(</table>);
+ print qq(</td>\n);
+
+#############################
+# PRINT SIDEBAR
+ print qq(<td width="300" align=left valign=top>\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(</td>);
+
+###############################
+
+ print qq(</tr>);
+ print qq(</table>\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(<table width="100%" cellpadding=0 cellspacing=0 border=0>);
+ print qq(<tr><td align=center valign=top>\n);
+
+ display_personal_invites($user_invites);
+ print "<p>";
+ display_approve_list() if ($USER->{ulevel} == 3);
+
+ print qq(</td>\n<td width="200" align=right valign=top>\n);
+
+ invite_result_box($command, $hash, $result) if ($command != -1);
+ invite_create_box();
+
+ print qq(</td></tr></table>\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 "<center><big><b><br>" . $BUCKY_CONFIG->{BUCKY_NAME} . " is down for maintenance!<p>please check back in a bit.</b></big></center>";
+ 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<br>\n" if $DEBUG; logout(); }
+
+ # User successfully logged in! Update the last login time
+ update_lastsession( $USER->{username} );
+ $USER->{lastsession} = $USER->{lastseen};
+
+ if ($DEBUG)
+ {
+ print "<div class=\"message\">\n";
+ print "uid: $USER->{id}\n<p>username: $USER->{username}\n<p>\n";
+ print "</div>\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{<hr color="$BUCKY_COLOR_HR" style="padding: 0px; margin: 2px;"><br><br><br><center><div class=message>};
+
+ # Display any login errors
+ if ($input->{error} == 1)
+ { print "bad username/password!<br>"; }
+ elsif ($input->{error} == 2)
+ { print "illegal traversal!<br>"; }
+
+ print "<b>$BUCKY_LOGIN_WELCOME</b>";
+ print qq{</b><br>\n<hr color="$BUCKY_COLOR_HR">\n\n};
+
+ login_form();
+
+ print qq(<p>\n<small>\n);
+# print qq(<a href="$BUCKY/index"><b>tour</b> the hacklab</a>);
+# print qq(<p>want an account?<br><a href="$BUCKY/invite">request one</a><br>);
+ print qq(</small></div></center>\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 <a href="$BUCKY/profile/$t->{username}">$t->{username}</a> on ! .
+ (verbosedate($t->{createdate})) .
+ qq! &middot; <span class="lite"><a href="$BUCKY/!.details_link($t).qq!/$t->{id}">view post</a></span>!,
+ 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: <b>$t->{title}</b><br>\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: <b>$t->{color}</b><br>\n";
+ print qq(<link rel="stylesheet" href="/css/bogart/$t->{color}.css">);
+ }
+
+ 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: <b>$t->{display}</b><br>\n";
+ }
+
+ # touch_thread($t);
+ admin_form($t->{id}, $t, $files, $k);
+ }
+ elsif ($input->{c} eq "p")
+ {
+ if ($input->{private} == 2)
+ {
+ print "Thread is now <b>" . $BUCKY_CONFIG->{PRIVACY_OWNER} . "</b>.<br>";
+ switch_thread_privacy($t->{id}, 2);
+ $t->{allowed} = update_whitelist();
+ $t->{private} = 2;
+ }
+ elsif ($input->{private} == 1)
+ {
+ print "Thread is now viewable by <b>" . $BUCKY_CONFIG->{PRIVACY_BBS} || "other users" . "</b>.<br>";
+ switch_thread_privacy($t->{id}, 1);
+ $t->{allowed} = update_whitelist();
+ $t->{private} = 1;
+ }
+ else
+ {
+ print "Thread is now viewable by <b>" . $BUCKY_CONFIG->{PRIVACY_WORLD} . "</b>.<br>";
+ 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} . "<br>" if ($DEBUG);
+ # First: add new tags
+ my $tags = get_tags_from_string( $input->{tags} );
+ foreach my $tag (@$tags)
+ {
+ print "Assigning tag $tag<br>\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 "<br>\nfiles flagged: ";
+ foreach (@flagged)
+ { print; print " "; }
+ print "<br>\n";
+ }
+ if ($input->{verb} eq "flag")
+ {
+ print "Flagged file $flagged[0]<br>";
+ 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:!<br>\n";
+ print "Where do you want to move these files here<br>\n";
+ print "Moving files...<br>\n";
+ # system("mv", $data_path/$oldpid/$filenamea ..., "$data_path/$newpid/");
+ print "Moving ids...<br>\n";
+ print "Recalculating post sizes...<br>\n";
+ }
+ elsif ($input->{verb} eq "rm")
+ {
+ if (!$input->{ok})
+ {
+ print qq(<center><p><div class="bluebox" style="width: 320px; padding: 10px;"><big><b>Are you sure you want to delete these files?</b></big><hr noshade color="$BUCKY_COLOR_HR"><p>\n);
+ print qq(<form action="$BUCKY/maintain" method="post" enctype="multipart/form-data">);
+ print qq(<input type=hidden name="c" value="f">\n);
+ print qq(<input type=hidden name="id" value="$t->{id}">\n);
+ print qq(<input type=hidden name="debug" value="1">\n) if ($DEBUG);
+ print qq(<input type=hidden name="verb" value="rm">\n);
+ print qq(<input type=hidden name="ok" value="1">\n);
+
+ my $i = 0;
+ my $fid = shift(@flagged);
+ foreach my $fh (sort_by_id(@$files))
+ {
+ next if ($fid != $fh->{id});
+ $i++;
+
+ print qq{<input type=hidden name="file$fid" value="$fid">\n};
+ print $fh->{id}.": " if ($DEBUG);
+ print $fh->{filename}."<br>\n";
+
+ $fid = shift(@flagged);
+ }
+
+ print qq{<br><input type="submit" value="YES YES DELETE THE FILES" class="clicky"></form></div></center>};
+ }
+ 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}<br>\n!;
+
+ $fid = shift(@flagged);
+ }
+
+ print "Recalculating post size...<br>\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!<br><br><center><table width=400 border=0 cellpadding=0 cellspacing=0><tr><td class="bluebox" style="padding: 20px;"><big><b>POST DELETED\!</b></big></td></tr></table></center>\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(<br><br><center><table width=350 border=0 cellpadding=0 cellspacing=0><tr><td class="bluebox" style="padding: 10px;">);
+ print qq(<big>Are you <b>sure</b> you want to delete:<br>$t->{title}</big><br><br>);
+ print qq(Doing so will delete <b>$t->{files} file$fs</b> and <b>$t->{comments} comment$cs</b>,<br>);
+ print qq(<b>destroying</b> the hard work of $par duder$ps\!<br>);
+ print qq(<br>);
+ print qq(<form action="$BUCKY/maintain" method="post" enctype="multipart/form-data">\n);
+ print qq(<input type=hidden name="debug" value="1">\n) if ($DEBUG);
+ print qq(<input type=hidden name="id" value="$t->{id}">\n);
+ print qq(<input type=hidden name="c" value="clobber">\n);
+ print qq(<input type=hidden name="okay" value="1">\n);
+ print qq(<center><table cellpadding=0 cellspacing=10 border=0><tr><td><input type="submit" value="OKAY" class="clicky"></form></td><td><input type="button" value="ABORT" class="clicky" onclick=")."javascript: history.go(-1)".qq("></td></tr></table></center>);
+
+ print qq!</td></tr></table></center>!;
+ }
+ }
+ }
+ 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!<p><center><div class=message><big><br><b>$out</b><br><br><a href="$BUCKY/inbox/$box">return to $box</a><br><br></big></div></center>!;
+ 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__;
+<rss version="2.0" xmlns:media="http://">
+<channel>
+<title>$z_title</title>
+<link>$z_link</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__;
+<item>
+<title>$z_file</title>
+<link>$z_content</link>
+<description></description>
+<media:content url="$z_content" type="audio/mpeg" />
+</item>
+__RSS__
+ }
+
+ $rss .= "</channel>\n</rss>\n";
+
+ print "Content-type: text/xml\n\n";
+ $rss =~ s/&/&amp;/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(<span class="lite"><a href="$BUCKY/).details_link($t).qq($t->{id}">return to post</a></span>);
+
+ 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(<span class="lite"><a href=").keyword_link($k).qq(">return to $BUCKY_LEXICON_KEYWORD</a></span>);
+ header ($header_args);
+ }
+ else
+ {
+ header("Creating a new post...");
+ }
+ }
+ else
+ {
+ header("Creating a new post...");
+ }
+
+ menu();
+ print "<p>\n\n";
+ my $checked = '';
+
+ print qq(<form action="$BUCKY/post" method="post" enctype="multipart/form-data">\n);
+ print qq!<input type="hidden" name="debug" value="$DEBUG">\n\n! if ($DEBUG);
+
+ print <<FORMmid;
+<center>
+<table cellpadding=0 cellspacing=0 border=0>
+<tr><td class="bluebox" style="padding: 20px 40px 20px 40px;">
+FORMmid
+
+ if ($t != -1)
+ {
+ print qq!<input type="hidden" name="c" value="reply">!;
+ print qq!<input type="hidden" name="thread" value="$t->{id}">!;
+ print qq!<table border=0 width=100%><tr><td style="text-align: right; vertical-align: center;">replying to:</td><td align="center"><b><big><a href="$BUCKY/!.details_link($t).qq!/$t->{id}">$t->{title}</a></big></b><br>posted !.verbosedate($t->{createdate}).qq! by <a href="$BUCKY/profile/$t->{username}">$t->{username}</a></td></tr></table>!;
+ }
+ else
+ {
+ print qq!<table cellpadding=2 border=0>!;
+ print qq!<tr><td align="right" valign="baseline">!;
+ print qq!title:&nbsp;!;
+ print qq!</td><td align="left" valign="baseline">!;
+ print qq!<input name="title" value="" size=48 maxlength=48><br>\n!;
+ print qq!</tr>!;
+ print qq!<tr><td align="right" valign="baseline">!;
+ print "category: ";
+ print qq!</td><td align="left" valign="baseline">!;
+ if ($k->{public} || check_op($k))
+ {
+ keyword_pulldown($k->{keyword});
+ $checked = $k->{public} ? "" : " checked";
+ }
+ else
+ { keyword_pulldown(); }
+ print qq!</tr>!;
+ print qq!<tr><td align="right" valign="baseline">!;
+ print qq!tags:&nbsp;!;
+ print qq!</td><td align="left" valign="baseline">!;
+ print qq!<input name="tags" value="" size=30 maxlength=48><br>\n!;
+ print qq!</tr>!;
+ print qq!<tr><td align="right" valign="middle">!;
+ print qq!publicity:!;
+ print qq!</td><td align="left" valign="middle">!;
+ # don't need this
+ # print qq!<input type=checkbox name="private" value="1"$checked>!
+ privacy_select("private", $checked);
+ print qq!</td></tr>!;
+ print qq!<tr><td></td><td align="left" valign="top">!;
+ print qq!<small>(can be changed at any time via post settings)</small>\n!;
+ print qq!</td></tr>!;
+ print qq!<tr><td align="right" valign="baseline">!;
+ print qq!</table>!;
+ print qq!<input type="hidden" name="c" value="new">!;
+ }
+
+ print qq!<hr color="$BUCKY_COLOR_HR" size=1>!;
+ print qq!<p><textarea name="comment" cols="52" rows="16"></textarea><p>\n!;
+
+ if (! check_key($t->{display}, "no-upload"))
+ {
+ print <<FORMEND;
+<input type="file" name="file1" size="12" maxlength="192" style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;" /> <input type="file" name="file2" size="12" maxlength="192" style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;" /> <input type="file" name="file3" size="12" maxlength="192" style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;" /><br>
+<input type="file" name="file4" size="12" maxlength="192" style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;" /> <input type="file" name="file5" size="12" maxlength="192" style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;" /> <input type="file" name="file6" size="12" maxlength="192" style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;" /><br>
+<input type="file" name="file7" size="12" maxlength="192" style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;" /> <input type="file" name="file8" size="12" maxlength="192" style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;" /> <input type="file" name="file9" size="12" maxlength="192" style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;" /><p>
+FORMEND
+ }
+ print qq(<table cellpadding=0 cellspacing=0 border=0 width=100%><tr><td width=90% align="center"><small>);
+# if ($t != -1)
+# { print qq(remember! you can always use <a href="$BUCKY/import?id=$t->{id}"><u><b>ftp</b></u></a> to upload files . . .); }
+# else
+# { print qq(remember! you can always use <a href="$BUCKY/import"><u><b>ftp</b></u></a> to upload files . . .); }
+ print "&nbsp;";
+ print <<FORMEND;
+</small></td>
+<td align="left"><input type="submit" value="POST" class="clicky"></td></tr></table>
+</form>
+</td></tr></table>
+</center>
+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<p>";
+ }
+
+ $private = $input->{private} if ($input->{private});
+
+ $thread_id = add_thread($title, $USER->{username}, $private);
+ print "id: $thread_id<p>" 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: <a href="$BUCKY/details/$thread_id">link!</a>};
+ 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}<p>" 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!<a href="$BUCKY/profile?c=form">edit your profile</a>!
+ } );
+ }
+ 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!<a href="$BUCKY/profile">view your profile</a>!
+ } );
+
+ 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<br>\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 <a href="/bucky/">log back in</a><br>\n);
+ }
+ else
+ {
+ $messages .= "passwords don't match!<br>\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: <b>$USER->{boxes}</b><br>\n" if ($DEBUG);
+ }
+
+ if ($loggedin && update_profile($USER->{username}, $input))
+ {
+ $USER->{timezone} = $input->{timezone};
+ $dateoffset = -1;
+ $messages .= "profile updated<br>"
+ }
+ if ($loggedin && update_profile_image($USER->{username}))
+ {
+ $messages .= "profile image updated<br>";
+ }
+
+ header( {
+ title => "updating profile...",
+ subtitle => qq!<a href="$BUCKY/profile?c=form">edit your profile</a>!
+ } );
+ menu();
+ print qq(<div style="padding: 30px;"><div class="bluebox">$messages);
+ print qq(</div></div><hr color="$BUCKY_COLOR_HR" style="padding: 0px; margin: 2px;">);
+ show_profile($USER->{username});
+ }
+ else
+ {
+ logout() unless ($loggedin);
+ header( {
+ title => "profile for $USER->{username}",
+ subtitle => qq!<a href="$BUCKY/profile?c=form">edit your profile</a>!
+ } );
+ 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(<a href="$BUCKY/adminzz">roll back adminzz</a>) );
+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(<center><table border=0 cellpadding=0 cellspacing=0><tr><td>);
+find_jpeg($files, $thread->{flagged});
+sideshow_comments($thread, $keyword);
+reply_form($thread->{id}, $thread);
+print qq(</td></tr></table></center>);
+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 "<br><br>";
+ 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 "<br><br>";
+
+ keyword_form($k->{keyword}, $k);
+
+ print qq!<center><table border=0 cellpadding=0 cellspacing=0 class="threadmain" width="580">!;
+ my $threads = get_threads_by_keyword($k->{keyword});
+ thread_box({ threads => $threads, kw => $k });
+
+ print qq!</table>!;
+ 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}<br>\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}<br>\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}<br>\n"; }
+ print "keyword ==> $t->{keyword}<br>\n";
+ print "detaching <b>$t->{title}</b> from <b>$t->{keyword}</b><br>\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(<table width="100%" cellpadding=0 cellspacing=0 border=0>);
+ print qq(<tr>);
+#############################
+# KEYWORD LIST
+ print qq(<td align=center valign=top width="100">\n);
+ print qq(<div class="bluebox"><span style="line-height: 1.5em;"><nobr>);
+ 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(<big><big><b>$start - $pre</b></big></big><br> );
+ print $s;
+ print qq(</nobr></span></div>);
+ print qq(<div class="bluebox"><span style="line-height: 1.5em;"><nobr>);
+ $s = '';
+ $with_letter = 1;
+ $p='';
+ $start = $l;
+ }
+ }
+ $with_letter += 1;
+ $p||=$l;
+ $pre=$l;
+ $s .= qq(<a style="$css" href="$BUCKY/category/$k">$k</a><br>);
+ }
+if ($s)
+ {
+ print qq(<big><big><b>$start - $pre</b></big></big><br> );
+ print $s;
+ print qq(</div>);
+ print qq(<div class="bluebox"><small><span style="line-height: 1.5em;"><nobr>);
+ }
+ print qq(</div>);
+ print qq(<div class="bluebox"><small><span style="line-height: 1.5em;"><nobr>);
+ print qq(.: <a href="$BUCKY/category/unsorted"><i>unsorted</i></a> :.<br>);
+ print qq(</nobr></span></small></div></td>\n);
+
+ print qq(<td width="300" align=right valign=top>\n);
+
+ alerts();
+ if ($USER == -1)
+ {
+ bPod_box();
+ print qq(</td></tr>);
+ }
+ 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(</td><td align=left valign=top>\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(<center><table border=0 cellpadding=0 cellspacing=0 class="threadmain" width="580">);
+
+ 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(</table>);
+ print qq(</td>\n);
+ print qq(</tr>);
+ print qq(</table>\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(<table width="100%" cellpadding=0 cellspacing=0 border=0>);
+ print qq(<tr><td align=center valign=top>\n);
+
+ display_user_list($users);
+
+ print qq(</td>\n<td width="200" align=right valign=top>\n);
+
+ invite_result_box($command, $hash, $result) if ($command != -1);
+ invite_create_box() if ($USER->{'ulevel'} > 1);
+ grass_box($users);
+
+ print qq(</td></tr></table>\n\n);
+
+ footer();
+
+sub grass_box
+ {
+ my ($users) = @_;
+ print qq(<div class="message">);
+ print qq(<b>newest users</b>\n);
+ my $i = 0;
+ print "<table border=0 cellpadding=0 cellspacing=3>";
+ 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(<tr><td colspan=2><hr noshade color="$BUCKY_COLOR_HR">\n</td></tr>);
+ print qq(<tr>);
+ print qq(<td align="left"><b><a href="$BUCKY/profile/$z_user">$z_user</a></b></td>);
+ print qq(<td align="right"><small>$z_date</small></td>);
+ print qq(</tr>);
+ if (length($z_grass))
+ {
+ print qq(<tr>);
+ print qq(<td align="left" colspan=2>);
+ print "$z_grass";
+ print qq(</td>);
+ print qq(</tr>);
+ }
+ last if (++$i == 20);
+ }
+ print qq(</table>\n);
+ print qq(</div>\n);
+ }
+
+sub display_user_list
+ {
+ my ($users) = @_;
+ print qq[<table border=0 cellpadding=2 cellspacing=0>];
+ print qq[<tr>\n];
+ print qq(<td>&nbsp;</td>\n);
+print <<userrows;
+<td class="head">&nbsp;</td>
+<td class="head" style="padding-left: 4px; padding-right: 8px;"><b>username</b></td>
+<td class="head" style="padding-left: 4px; padding-right: 8px;"><b>realname</b></td>
+<td class="head" style="padding-left: 4px; padding-right: 2px; text-align: right;"><b>idle</b></td>
+<td class="head" style="padding-left: 4px; padding-right: 8px;" colspan=3><b>&nbsp;</b></td>
+userrows
+ # print qq(<td class="head" style="padding-left: 4px; padding-right: 8px;">&nbsp;</td>\n) if ($USER->{ulevel} == 3);
+ print "</tr>\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[<tr class="row$r">];
+ print_blank_cell(qq(<small><a href="$BUCKY/profile/$$duder{username}">profile</a>&nbsp;&middot;&nbsp;<a href="$BUCKY/message/$$duder{username}">send&nbsp;message</a>&nbsp;&middot;</small>), "right", "blank");
+
+ my $image = get_profile_image($duder->{username}, $AVATAR_MED_PREFIX);
+ if ($image != -1)
+ {
+ my $av .=
+ qq(<a href="$BUCKY/profile/$duder->{username}">).
+ qq(<img src="$image" width="$AVATAR_MED_WIDTH" border=1">).
+ qq(</a>);
+ print_user_cell($av);
+ }
+ else
+ {
+ print_user_cell(qq(<img src="/blank.gif" width="$AVATAR_MED_WIDTH" height="$AVATAR_MED_WIDTH">));
+ }
+
+ if ($duder->{ulevel} > 1 && $USER->{ulevel} == 3 && $show_all)
+ {
+ print_user_cell("&middot;&nbsp;".$duder->{username});
+ }
+ elsif ($vanished)
+ {
+ print_user_cell("<small>".$duder->{username}."</small>");
+ }
+ else
+ {
+ $duder->{username} =~ s/\n/<br>/g;
+ print_user_cell($duder->{username});
+ }
+
+ $duder->{realname} =~ s/\s/&nbsp;/g;
+ if ($vanished)
+ { print_user_cell("<small>".$duder->{realname}."</small>"); }
+ else
+ { print_user_cell($duder->{realname}); }
+
+ my $col = carbondate($duder->{lastseen}, 0);
+ $today++ if ($col eq "new");
+ if ($vanished)
+ {
+ print_user_cell(qq!<span class="$col"><small>!.(get_age($duder->{lastseen})).qq!&nbsp;ago</small></span>!, "right");
+ }
+ else
+ {
+ print_user_cell(qq!<small><span class="$col">!.(get_age($duder->{lastseen})).qq!</span></small>!, "right");
+ }
+
+ if ($USER->{ulevel} == 3)
+ {
+ if ($duder->{ccount} == 0)
+ { print_user_cell("&nbsp;"); }
+ else
+ { print_user_cell("&nbsp;<small>".hushnull($duder->{ccount}, "c", 1)."</small>", "right"); }
+
+ if ($duder->{fcount} == 0)
+ { print_user_cell("&nbsp;"); }
+ else
+ { print_user_cell("&nbsp;<small>".hushnull($duder->{fcount}, "f", 1)."</small>&nbsp;", "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(<a href="$BUCKY/$BUCKY_LEXICON_KEYWORD/$sticky">$sticky</a>, );
+ }
+ }
+ $cell =~ s/, $//;
+ print_user_cell($cell);
+
+ print qq[</tr>];
+ $r = $r ? 0 : 1;
+ $i++;
+ }
+
+ print qq(<tr><td colspan=9 align=right><small>) .
+ qq(total: <b>$i</b> users \(<b>$today</b> seen today);
+ print qq(, $neg <a href="$BUCKY/users?showall=1">vanished</a>) if (!$show_all && $USER->{ulevel} > 2);
+ print qq(\)</small>&nbsp;</td></tr>\n);
+ print <<approvefoot;
+</table></center>
+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[<td nobreak style="padding: 3px; vertical-align: middle; text-align: $align;">$v</td>];
+ }
+
+sub print_blank_cell
+ {
+ my ($v) = @_;
+ print qq[<td nobreak style="padding: 3px; background-color: #e6f0e6; vertical-align: middle; text-align: $align;">$v</td>];
+ }
+
+sub print_sinks
+ {
+ $cell = '&nbsp;';
+ 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(<a href="$BUCKY/$BUCKY_LEXICON_KEYWORD/$sticky">$sticky</a>, );
+ }
+ }
+ $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(<input type="hidden" name="debug" value="1">) : '';
+
+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(<div class="message" style="background-color: #ff6666; font-family: georgia, garamond, serif;">\n);
+ print qq(<br><a href="$url" style="font-family: georgia, garamond, serif; color: #000;"><b><u>);
+ print $msg;
+ print qq(</b></u></a><br><br>);
+ print qq(</div>\n);
+ }
+
+sub welcome_box
+ {
+ my ($files, $size) = count_user_files($USER->{username});
+ print qq(<div class="message">\n);
+ print qq(<b><big>$BUCKY_LOGIN_WELCOME</big></b><br>\n);
+ print qq(<small>you are using ),hushsize($size,2),qq( in $files files</small>);
+ print qq(</div>\n);
+ }
+sub search_box
+ {
+ print <<__SEARCH__;
+<div class="message">
+<table width=100% border=0 cellpadding=0 cellspacing=0 style="margin: 0px;">
+<form action="$BUCKY/2/search" method="get" enctype="multipart/form-data">
+$DEBUG_FORM_STRING
+<tr><td height=$AVATAR_MED_WIDTH>
+<table width=100% cellpadding=0 cellspacing=0 border=0>
+<tr><td style="text-align: center; vertical-align: middle;">
+<input name="q" value="" maxlength=1024 style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;
+ color: #140A0A; border: 1px #140A0A solid; padding: 1px; margin: 0px 0px 0px 0px; width: 100%;">
+</td>
+<td style="text-align: center; vertical-align: middle;">
+<input type="submit" value="SEARCH" class="clicky" style="margin: 0px 0px 0px 0px;">
+</td></tr></table>
+</td></tr></table>
+</div>
+</form>
+__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;
+
+<!-- bPod -->
+<div style="padding-left: 1px;" id = "bPod"></div><center>
+<script type="text/javascript" src="/js/swfobject.js"></script>
+<script type="text/javascript">
+ // <![CDATA[
+ var so = new SWFObject ("/bPod.swf", "bPod", 215, 210, 8, "$background" );
+ so.addParam ("scale", "noscale");
+bPod
+ print qq! so.addVariable("activeUser", "$USER->{username}" );\n! if ($USER != -1);
+ print qq! so.addVariable("uiGradient1", "$BPOD_COLOR_UI_GRADIENT_1" );\n!;
+ print qq! so.addVariable("uiGradient2", "$BPOD_COLOR_UI_GRADIENT_2" );\n!;
+ print qq! so.addVariable("uiStroke", "$BPOD_COLOR_UI_STROKE" );\n!;
+
+ print qq! so.addVariable("keywords", "$BPOD_URL_SERVICES_KEYWORDS" );\n!;
+ print qq! so.addVariable("files", "$BPOD_URL_SERVICES_FILES" );\n!;
+ print qq! so.addVariable("threads", "$BPOD_URL_SERVICES_THREADS" );\n!;
+ print qq! so.addVariable("singleFilePath", "$BPOD_URL_PREAMBLE_FILES" );\n!;
+ print qq! so.addVariable("singleThreadPath", "$BPOD_URL_DETAILS" );\n!;
+ print <<bPod;
+ so.write("bPod");
+ // ]]>
+</script>
+<!-- end bPod -->
+bPod
+ }
+
+sub radio_box
+ {
+ my $radio = get_radio_info();
+
+ if ($radio == -1)
+ {
+ #return;
+ print qq!<div class="message">\n!;
+ print qq[<small><b>RADIO: GOING DARK</b><br>\n];
+ print qq!<a href="http://radiofreehanoi.com/HOWTO">click here for broadcast instructions</a>\n</small>!;
+ print qq!</div>\n!;
+ }
+ else
+ {
+ print qq!<div class="message">\n!;
+ print qq!<b>$radio->{station}</b><br>\n!;
+ print qq!<small>$radio->{nowplaying}</small><br>\n!;
+ print qq!<a href="$radio->{tunein}"><small>$radio->{tunein}</small></a>\n!;
+ print qq!</div>\n!;
+ }
+ }
+
+sub hoot_box
+ {
+ my $hoot = uc( get_random_line("hoots") );
+print qq(<div align="left");
+ print qq(<div class="message2">\n);
+ print qq(<form action="$BUCKY/comment" method="post" enctype="multipart/form-data">);
+ print qq(<input type=hidden name="debug" value=1">\n) if ($DEBUG);
+print qq(<table width=100% border=0 cellpadding=3 cellspacing=0 style="margin: 0px;">);
+ print <<END;
+<tr><td colspan=2 height=$AVATAR_MED_WIDTH>
+<input type="hidden" name="id" value="1">
+
+<table width=100% cellpadding=0 cellspacing=0 border=0>
+<tr>
+<td style="text-align: center; vertical-align: middle;">
+<input name="comment" value="" maxlength=1024 style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;
+ color: #140A0A; border: 1px #140A0A solid; padding: 1px; margin: 0px 0px 0px 0px; width: 100%;">
+</td>
+<td style="text-align: center; vertical-align: middle;">
+<input type="submit" value="$hoot" class="clicky" style="margin: 0px 5px 0px 5px;">
+</td></tr></table>
+</form>
+</td></tr>
+<!-- PRINTING COMMENTS -->
+END
+ # <hr color="$BUCKY_COLOR_HR">
+ my $comments = get_comments(1, 15);
+ sideshow_comments({ comments => $comments, thread => -1, keyword => -1, noreply => 1, hootbox => 1, order => "asc", shorturl => 1 });
+print "</table>";
+print <<__DUH__;
+<br><big>~&gt;{ <a href="$BUCKY/details/1">GLIMPSE THE PAST</a> }&lt;~</big>
+__DUH__
+ print qq!</div>!;
+ }
+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!<select name="color"!;
+ print qq! onchange="this.form.submit();"! if ($quick);
+ print qq!>!;
+ foreach $c (keys %COLORS)
+ {
+ print qq!<option value="$c"!;
+ print qq! selected! if ($c eq $selected);
+ print qq!>$c</option>!;
+ }
+ print qq!</select>\n!;
+ }
+
+sub get_color
+ {
+ my ($t, $k, $row) = @_;
+ print qq!<tt> $t->{id}(color) = $t->{color}, $k->{color} </tt><br> ! 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<br>";
+ $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(<!-- STARTING TABLE ) . scalar(keys(%$comments)) . qq( c. -->);
+ print qq(<tr><td colspan=2 height=1><img src="/blank.gif" width=1 height=1 vspace=0 hspace=0></td></tr>);# 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(<tr>);
+ print qq(<td colspan=2 style="padding: 0px; margin: 0px;">\n);
+ print qq(<table cellpadding=0 cellspacing=0 border=0 width=100% style="padding: 0px; margin: 0px;">\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(</table>\n</td></tr>\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 .= "&nbsp;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 =~ /<br>/ ? undef : "<br><br>";
+ my $z_options = ($USER != -1) ? display_comment_options($args) : "&nbsp;";
+ $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(<tr>);
+
+print qq(<td style="padding:0px; width: $z_width; vertical-align: middle; text-align: right;);
+print qq(border-top: 2px solid #000; ) if ($args->{firstpost});
+ print qq(border-bottom: 2px solid #000; background-color: #666;);
+print qq(">);
+ if ($z_image != -1)
+ {
+print qq(<a href="$z_profile"><img src="$z_image" width="$z_width" height="$z_width" border=0></a>);
+ }
+print qq(</td>);
+
+ print qq(<td class="comment cc$z_r" style="vertical-align: middle; );
+print qq(border-top: 2px solid #000; ) if ($args->{firstpost});
+ print qq(border-left: 2px solid #000; ); # if ($z_image == -1);
+ print qq(border-bottom: 2px solid #000;);
+# print qq( border-right: 2px solid #ccc; padding: 0px;">);
+ print qq(">);
+ print qq(<table width="100%" border=0 cellpadding=0 cellspacing=0>);
+ print qq(<tr>);
+# print qq(<td colspan=2 align=left><small>$z_comment <div class="quiet" style="float: right;">$z_age&nbsp;</div></small></td>);
+ print qq(<td colspan=2 align=left><small>$z_comment</small></td>);
+ print qq(</tr>);
+ print qq(</table>);
+ print qq(</td>);
+
+# print qq(<td style="text-align: left; vertical-align: top; ) .
+# qq(border-right: 1px solid #ccc; ) .
+# qq( padding: 3px 3px 3px 6px; width: 20px;">);
+# print qq(<small><a href="$z_profile">$z_user</a><br>$z_age</small>);
+## print qq(<a href="$z_profile">$z_user</a>);
+# print qq(</td>);
+## print qq(<tr>);
+## print qq(<td colspan=2 align=right><small>$z_age</small></td>);
+## print qq(</tr>);
+# print qq(</tr>);
+ }
+ else
+ {
+ my $z_width = $AVATAR_BIG_WIDTH;
+ my $z_image = get_profile_image($c->{username}, $AVATAR_BIG_PREFIX);
+ print qq(<tr>);
+ print qq(<td style="text-align: center; vertical-align: top; ) .
+ qq(border-right: 1px solid #ccc; ) .
+ qq( padding: 3px 3px 1px 1px;" width=60>);
+ if ($z_image != -1)
+ { print qq(<a href="$z_profile"><img src="$z_image" width="$z_width" border=1></a>); }
+ print qq(<a href="$z_profile">$z_user</a>);
+ print qq(</td>);
+ print qq(<td class="comment c$z_r" style="vertical-align: top; );
+ print qq(border-top: 1px solid #ccc; ) if ($args->{firstpost});
+ print qq(border-bottom: 1px solid #ccc; border-right: 1px solid #ccc; padding: 3px 3px 3px 3px;">);
+ print qq(<table width="100%" height="" border=0 cellpadding=0 cellspacing=3>);
+ print qq(<tr>);
+ print qq(<td colspan=2 align=left>$z_comment$z_br</td>);
+ print qq(</tr>);
+ print qq(<tr>);
+ print qq(<td align=left>$z_options</td>);
+ print qq(<td align=right><small>$z_date</small></td>);
+ print qq(</tr>);
+ print qq(</table>);
+ print qq(</td></tr>);
+ }
+
+ 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 .= "&nbsp;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) : "&nbsp;";
+ $z_options .= " ($z_id)" if $DEBUG;
+
+ print qq(<tr>);
+
+ if ($z_image != -1)
+ {
+ print qq(<td style="text-align: right; vertical-align: top; ) .
+ qq(border-right: 1px solid #bbb; ) .
+ qq( padding: 3px 3px 1px 3px; width: 96px;">);
+ print qq(<a href="$z_profile"><img src="$z_image" width="$z_width" border=1></a><br>);
+ print qq(<a href="$z_profile">$z_user</a>);
+ print qq(</td>);
+ }
+ else
+ {
+ print qq(<td style="text-align: right; vertical-align: top; ) .
+ qq(border-right: 1px solid #ccc; ) .
+ qq( padding: 3px 3px 1px 3px; width: 94px;">&nbsp;);
+ print qq(<small><a href="$z_profile">$z_user</a></small>);
+ print qq(</td>);
+ }
+
+ print qq(<td class="subcomment c$z_r" style="vertical-align: top; );
+ print qq(border-bottom: 1px solid #ccc; ) unless ($args->{lastpost});
+ print qq(border-right: 1px solid #ccc; padding: 0px 0px 0px 0px; margin: 0px 0px 0px 0px;">);
+ print qq(<table width="100%" border=0 cellpadding=0 cellspacing=3>);
+ print qq(<tr>);
+ print qq(<td colspan=2 align=left>$z_comment</td>);
+ print qq(</tr>);
+ print qq(<tr>);
+ print qq(<td align=left>$z_options</td>);
+ print qq(<td align=right><small>$z_date</small></td>);
+ print qq(</tr>);
+ print qq(</table>);
+ print qq(</td></tr>);
+
+ 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(<small>);
+ $out .= $age < 86400 ?
+ qq(<span class="lite"><a href="$z_link?c=edit">edit</a></span>)
+ : qq(<a href="$z_link?c=edit">edit</a>);
+ $out .= middot();
+ $out .= qq(<a href="$z_link?c=delete">remove</a>);
+ $out .= middot();
+ $out .= qq(<a href="$z_link?c=reply">reply</a>);
+ $out .= qq(</small>);
+ }
+ else
+ {
+ $out .= qq(<small><a href="$z_link?c=reply">reply</a></small>);
+ }
+ }
+
+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 = <<WORDUP;
+<b>bucky</b> 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 <a href="$BUCKY/index/">home page</a>. 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."<br>" 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."<br>" 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."<br>" 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."<br>" 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."<br>" 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."<br>" 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."<br>" 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."<br>" 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 "<tt>$query</tt><br>" 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."<br>" 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<br>" 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."<br>" 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<br>" 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<br>" 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<br>" 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} . "<br>\n";
+# print $data->{row}->{owner} . "<br>\n";
+# print "columns : " .$columns . "<br>\n";
+ # Loop through row's columns to build SQL statement
+ my $first_set = 0;
+ foreach my $column (@$columns)
+ {
+# print $data->{row}->{$column} . "<BR>\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 . "<br>" 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."<br>" 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<br>" 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."<br>" 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<br>\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<br>\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."<br>" 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."<br>" 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."<br>" 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."<br>" 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."<br>" 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."<br>" 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."<br>" 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."<br>" 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."<br>" 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."<br>" 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."<br>" 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<br>" 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."<br>" 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!<br>\n" if ($DEBUG);
+ return -1;
+ }
+
+ $selected = $rows[(int rand @rows)];
+ print "Random flagged image: $selected->{thread}/$selected->{filename}<br>" 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!<div class="message">!;
+ my $zip = retrieve_zip_mechanism($t);
+ if ($zip != -1)
+ {
+ print qq!<small><b>A ZIP OF THESE FILES IS AVAILABLE:<br><a href="$live_path/$t->{id}/$zip">$zip</a></b></small>!;
+ }
+ else
+ {
+ print qq!<small><b>FOLDER ARCHIVAL IN PROGRESS</small><br>!;
+ print qq!<big><a href="$BUCKY/details/$t->{id}">CLICK HERE</a></big><small> IN A MOMENT</b></small>!;
+ }
+ print qq!</div>\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!<div class="message">!;
+ print qq!<small><b>A ZIP OF THESE FILES IS AVAILABLE:<br><a href="$live_path/$t->{id}/$zipfile">$zipfile</a></b></small>!;
+ print qq!</div>\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<br>\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!<p>\n\n!;
+ }
+
+ print <<FILES;
+<table border=0 cellpadding=0 cellspacing=0 class="main">
+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 '<tr>';
+ print '<td colspan=5 align="right" style="border-top: 1px dotted #ccc;">';
+ print qq!total size: !.hushsize($size, 1, 1).qq!</td></tr></table>\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!<br>\n!;
+ }
+
+ print qq[<tr class="row$r">];
+ if ($cbox)
+ {
+ print qq!<td align="right"><input type="checkbox" name="file$f->{id}" value="$f->{id}"!;
+ print " checked" if ($checked);
+ print qq!></td>!;
+ }
+
+ if ($0 !~ /(details|maintain)/)
+ {
+ print qq[<td align="left"><small><a href="$BUCKY/details/$f->{thread}" class="quietlink">go&nbsp;to&nbsp;post&nbsp;&gt;</a></small></td>];
+ }
+
+ if ((time - $f->{date}) < 150000 || $checked)
+ { print qq[<td align="left" nowrap class="filename bright">]; }
+ else
+ { print qq[<td align="left" nowrap class="filename">]; }
+ if (length($f->{filename}) > 50)
+ {
+ my $filen = substr $f->{filename}, 0, 47;
+ my $filext = substr $f->{filename}, -4, 4;
+ print qq[<a href="$live_path/$f->{thread}/$f->{filename}">$filen..$filext</a>];
+ }
+ else
+ {
+ print qq[<a href="$live_path/$f->{thread}/$f->{filename}">$f->{filename}</a>];
+ }
+ print qq[</td>];
+
+ my ($date, $time) = verbosedatetime($f->{date});
+
+# print qq[<td align="left" nowrap><small><span class="$color">]. (get_age($f->{date})), qq[</span></small></td>];
+ print qq[<td align="right" nowrap><span class="$color">$date</span></td>];
+ print qq[<td align="left" nowrap><small>&nbsp;<span class="$color">$time</span></small></td>];
+ print qq[<td class="filesize" nowrap><small>], hushsize($f->{size},2), qq[</small></td>];
+ print qq[<td align="left"><small><a href="$BUCKY/profile/$f->{username}" class="quietlink quiet">$f->{username}</a></small>&nbsp;</td>];
+ print qq[</tr>\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 = "&nbsp;am"; }
+ elsif ($h == 12)
+ { $meridian = "&nbsp;pm"; }
+ elsif ($h > 12)
+ { $h -= 12; $meridian = "&nbsp;pm"; }
+ else
+ { $meridian = "&nbsp;am"; }
+ return sprintf("%2d-%s-%d <small>%2d:%02d%s</small>", $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 = "&nbsp;am"; }
+ elsif ($h == 12)
+ { $meridian = "&nbsp;pm"; }
+ elsif ($h > 12)
+ { $h -= 12; $meridian = "&nbsp;pm"; }
+ else
+ { $meridian = "&nbsp;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(<span class="$color">$date</span>);
+ }
+
+sub extend_span
+ {
+ my ($os, $od) = @_;
+ if ($os eq "now")
+ { $os = time; }
+ my $span = $os - $od;
+ if ($DEBUG)
+ {
+ print qq(\nSTART: $os<br>END: $od<br>SPAN: $span<br>);
+ print qq(DAYS: ).int($span / (60*60*24)).qq(<br>\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!<span class="quiet">$n!.qq! v.</span>!; }
+ if ($n < 200)
+ { return qq!<span class="quiet">$txt!.qq!&nbsp;v.</span>!; }
+ elsif ($n < 500)
+ { return qq!<span class="quiet">$txt!.qq!&nbsp;v.</span>!; }
+ elsif ($n < 1000)
+ { return qq!<span class="old">$txt!.qq!&nbsp;v.</span>!; }
+ elsif ($n < 5000)
+ { return qq!<span class="med">$txt!.qq!&nbsp;kv.</span>!; }
+ elsif ($nobold || $n < 10000)
+ { return qq!<span class="recent">$txt!.qq!&nbsp;kv.</span>!; }
+ else
+ { return qq!<span class="new">$txt!.qq!&nbsp;kv.</span>!; }
+ }
+
+sub hushsize
+ {
+ my ($n, $bias, $nobold) = @_;
+ $bias = 1 unless ($bias);
+ my $txt = commatize($n / 1024);
+ if ($n < 1024)
+ { $n = 0 if (!$n); return qq!<span class="quiet">$n!.qq! b.</span>!; }
+ if ($n < 1024*1024)
+ { return qq!<span class="quiet">$txt!.qq!&nbsp;kb.</span>!; }
+ elsif ($n < (20000000/$bias))
+ { return qq!<span class="quiet">$txt!.qq!&nbsp;mb.</span>!; }
+ elsif ($n < (50000000/$bias))
+ { return qq!<span class="old">$txt!.qq!&nbsp;mb.</span>!; }
+ elsif ($n < (80000000/$bias))
+ { return qq!<span class="med">$txt!.qq!&nbsp;mb.</span>!; }
+ elsif ($nobold || $n < (170000000/$bias))
+ { return qq!<span class="recent">$txt!.qq!&nbsp;mb.</span>!; }
+ else
+ { return qq!<span class="new">$txt!.qq!&nbsp;mb.</span>!; }
+ }
+
+sub hushnull
+ {
+ my ($n, $unit, $nobold) = @_;
+ my $out = '';
+
+ if ($n < 3)
+ { $out .= qq!<span class="quiet">$n!; }
+ elsif ($n < 6)
+ { $out .= qq!<span class="older">$n!; }
+ elsif ($n < 10)
+ { $out .= qq!<span class="old">$n!; }
+ elsif ($n < 16)
+ { $out .= qq!<span class="med">$n!; }
+ elsif ($nobold || $n < 21)
+ { $out .= qq!<span class="recent">$n!; }
+ else
+ { $out .= qq!<span class="new">$n!; }
+ $out .= "&nbsp;$unit." if ($unit);
+ $out .= "</span>";
+ return $out;
+ }
+
+sub courtesy_s
+ {
+ my ($v) = @_;
+ if ($v == 1)
+ { return ""; }
+ else
+ { return "s"; }
+ }
+
+sub linebr
+ {
+ my ($text, $short) = @_;
+ chomp $text;
+ unless ($text =~ /(<a href=|<img)/)
+ {
+ if ($short)
+ {
+ $text = tidy_urls($text);
+ }
+ else
+ {
+ $text =~ s/(https?:\/\/\S+) ?/ <a href="$1" target="_blank">$1<\/a> /g;
+ }
+ }
+ $text =~ s/\s((dj )?phatty)/ <a href="\/phatty\/" target="_blank">$1<\/a>/i;
+ $text =~ s/( )/&nbsp; /g;
+ $text =~ s/\r?\n/<br>/g;
+ # avoid stuffing tables, lists with br's
+ $text =~ s/tr><br>/tr>/g;
+ $text =~ s/td><br>/td>/g;
+ $text =~ s/ul><br>/ul>/g;
+ $text =~ s/ol><br>/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 !~ /<img/))
+ {
+ if ($url =~ /\.thumb/)
+ {
+ $line = qq($pre<a href="http$url" target="_blank"><img src="http$url" border="0" width="100%"></a>$space);
+ }
+ else
+ {
+ my $thumb_url = $url; # lc($url);
+ # $thumb_url =~ s/(data\/\d+\/)/$1.thumb\/b./;
+ $line = qq($pre<a href="http$url" target="_blank"><img src="http$thumb_url" border="0" width="100%"></a>$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<a href="http$url" target="_blank">[$curl]</a>$space);
+ }
+ $line .= tidy_urls($rest);
+ }
+ return $line;
+ }
+
+sub nbsp
+ { '&nbsp;' }
+sub middot
+ { '&nbsp;&middot;&nbsp;' }
+
+sub profile_link
+ {
+ my ($username) = @_;
+ my $link =
+# qq(<a href="$BUCKY/profile?username=$username">) .
+ qq(<a href="$BUCKY/profile/$username">) .
+ $username .
+ qq(</a>);
+ return $link;
+ }
+sub message_link
+ {
+ my ($username) = @_;
+ my $link =
+# qq(<a href="$BUCKY/message?username=$username">) .
+ qq(<a href="$BUCKY/message/$username">) .
+ $username .
+ qq(</a>);
+ 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(<table border=0 height=10 cellpadding=0 cellspacing=0><tr><td valign=top>);
+ print "<small>sticky?&nbsp;</small>";
+ print qq(</td><td valign=top>);
+ print qq!<form action="$BUCKY/profile" method="post" enctype="multipart/form-data" name="stickiness">!;
+ print qq{<input type=hidden name="debug" value="1">} if ($DEBUG);
+ print qq{<input type=hidden name="c" value="sticky">};
+ print qq{<input type=hidden name="keyword" value="$keyword">};
+ print qq{<input type="checkbox" name="chexor" value="keyword"$checked onclick="this.form.submit();" style="padding: 0px; margin: 0px">};
+ print qq{</form>};
+ print qq(</td></tr></table>\n);
+ }
+
+# short upload form for sidebar
+sub upload_form
+ {
+ my ($keyword) = @_;
+print <<MID;
+<!-- upload form -->
+<div class="message">
+make a <b>new post</b>
+<hr noshade color="$BUCKY_COLOR_HR">
+<small>
+<form action="$BUCKY/post" method="post" enctype="multipart/form-data">
+MID
+
+ print qq{<input type=hidden name="debug" value=1">\n} if ($DEBUG);
+ if ($keyword)
+ {
+ print "category:&nbsp;";
+ keyword_pulldown($keyword);
+ print "<br>\n";
+ }
+
+ print <<MID2;
+
+<input type=hidden name="c" value="new">
+
+subject:<input name="title" value="" size=20 maxlength=50 style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;
+ color: #140A0A; border: 1px #140A0A solid; padding: 1px; margin: 5px 5px 0px 5px;"><br>
+
+<input type="file" name="file1" size="12" maxlength="192" style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;
+ color: #140A0A; border: 1px #140A0A solid; padding: 1px; margin: 5px;"><br>
+
+description:<br>
+<textarea name="comment" value="" rows="4" style="width: 100%; padding: 0px 1px 1px 1px; font-family: trebuchet ms, sans serif; font-size: 11px;">
+</textarea>
+<br>
+
+<table width="100%" border=0><tr>
+<td align=right valign=middle><small><a href="$BUCKY/post">big&nbsp;post&nbsp;form</a>&nbsp;|</small></td>
+<td align=left valign=middle><input type="submit" value="CREATE POST" class="clicky"></td>
+</tr></table>
+</form>
+</small>
+</div>
+MID2
+ }
+
+#############################################
+
+sub reply_form
+ {
+ my ($id, $t) = @_;
+ my $submittag;
+ return unless ($USER != -1 );
+ if ($t->{comments} == 0)
+ { $submittag = "POST"; }
+ else
+ { $submittag = "REPLY"; }
+
+ print qq{<form action="$BUCKY/comment" method="post" enctype="multipart/form-data">\n};
+
+ if ($DEBUG) { print qq!<input type="hidden" name="debug" value="$DEBUG">\n\n!; }
+
+ print <<FORMEND;
+<div align="left" style="padding: 5px 0px 5px 10px;"><small>POST A COMMENT . . .</small></div>
+<input type="hidden" name="id" value="$id">
+<table border=0 width="100%" cellpadding=0 cellspacing=0 style="padding: 0px; margin: 0px">
+<tr>
+<td align="center" valign="middle" colspan=2>
+<textarea id="comment" name="comment" rows="8" style="width: 96%; font-family: trebuchet ms, sans serif; font-size: 12px;">
+</textarea>
+</td>
+</tr>
+<tr>
+FORMEND
+
+ if (! check_key($t->{display}, "no-upload"))
+ {
+ print <<FORMEND;
+<td align="left" valign="middle" style="padding-left: 10px;">
+<!--<small>enter a comment in the box above OR add some files below OR <i>both!</i>&nbsp;</small><br>-->
+<input type="file" name="file1" size="12" maxlength="192" style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;" />
+<input type="file" name="file2" size="12" maxlength="192" style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;" /><br>
+<input type="file" name="file3" size="12" maxlength="192" style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;" />
+<input type="file" name="file4" size="12" maxlength="192" style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;" />
+</td>
+<td align="center" valign="middle" style="padding-right: 10px;">
+FORMEND
+ }
+ else
+ {
+ print qq(<td align="right" valign="middle" style="padding-right: 10px;">);
+ }
+ print <<FORMEND;
+<div style="text-align: center; width: 50px;">
+<input type="submit" class="clicky" value="$submittag">
+<br>
+<small><a href="$BUCKY/post?thread=$t->{id}">big&nbsp;form</a></small>
+</div>
+</form>
+</td></tr></table>
+FORMEND
+ }
+
+#############################################
+
+sub curt_post_form
+ {
+ my ($c) = @_;
+ my $pid = ($c->{parent_id} > 0) ? $c->{parent_id} : -1;
+
+ print qq{<form action="$BUCKY/comment" method="post" enctype="multipart/form-data">\n};
+
+ if ($DEBUG) { print qq!<input type="hidden" name="debug" value="$DEBUG">\n\n!; }
+
+ my $date = plaindate($c->{date});
+ my $comment = $c->{comment};
+ $comment =~ s/&/&amp;/g;
+ $comment =~ s/>/&gt;/g;
+ $comment =~ s/</&lt;/g;
+
+ print <<FORMEND;
+<div align="left" style="padding: 5px;">$c->{username} posted this comment on $date:</div>
+<input type="hidden" name="c" value="update">
+<input type="hidden" name="id" value="$c->{id}">
+<textarea name="comment" rows="21" style="width: 100%; font-family: trebuchet ms, sans serif; font-size: 12px;">
+$comment</textarea>
+<table border=0 width="100%" cellpadding=0 cellspacing=0 style="padding: 0px; margin: 0px">
+<tr>
+<td align="right" valign="middle" style="padding: 10px;">
+<input type="submit" class="clicky" value="EDIT COMMENT">
+</form>
+</td></tr></table>
+FORMEND
+ }
+
+#############################################
+
+sub curt_reply_form
+ {
+ my ($c, $t, $k) = @_;
+
+ print qq{<form action="$BUCKY/comment" method="post" enctype="multipart/form-data">\n};
+
+ if ($DEBUG) { print qq!<input type="hidden" name="debug" value="$DEBUG">\n\n!; }
+ if ($c != -1)
+ {
+ my $date = plaindate($c->{date});
+ print <<FORMEND;
+<div align="left" style="padding: 5px;">$c->{username} posted this comment on $date:
+<blockquote>$c->{comment}</blockquote></div>
+<input type="hidden" name="id" value="$t->{id}">
+<input type="hidden" name="parent_id" value="$c->{id}">
+FORMEND
+ }
+ else
+ {
+ print qq!<input type="hidden" name="id" value="$t->{id}">\n!;
+ }
+ print <<FORMEND;
+<textarea name="comment" rows="21" style="width: 100%; font-family: trebuchet ms, sans serif; font-size: 12px;">
+</textarea>
+<table border=0 width="100%" cellpadding=0 cellspacing=0 style="padding: 0px; margin: 0px">
+<tr>
+<td align="right" valign="middle" style="padding: 10px;">
+<input type="submit" class="clicky" value="REPLY">
+</form>
+</td></tr></table>
+FORMEND
+ }
+
+#############################################
+
+sub hoot_form
+ {
+ my ($id, $t) = @_;
+ print qq{<form action="$BUCKY/comment" method="post" enctype="multipart/form-data">\n};
+ if ($DEBUG) { print qq!<input type="hidden" name="debug" value="$DEBUG">\n\n!; }
+ print <<FORMEND;
+<input type="hidden" name="id" value="$id">
+<td style="text-align: center; vertical-align: middle; padding: 5px 10px 5px 10px;">
+<textarea name="comment" rows="2" style="width: 95%; font-family: trebuchet ms, sans serif; font-size: 11px;">
+</textarea>
+</td>
+<td style="text-align: center; vertical-align: middle; padding-right: 20px;">
+<input type="submit" class="clicky" value="CHAT">
+<br>
+<small><a href="$BUCKY/post?thread=$t->{id}">big&nbsp;form</a></small>
+</td></tr>
+FORMEND
+ print "</form>";
+ }
+
+#############################################
+
+sub print_garrow
+ {
+ my ($a, $b) = @_;
+ $a =~ s/\s/&nbsp;/g;
+ print qq!<tr><td style="text-align: right; vertical-align: middle;"><big>$a:</big></td><td style="text-align: left; vertical-align: middle; padding: 5px;">$b</a></td></tr>\n!;
+ }
+
+#############################################
+
+sub onebutton
+ {
+ my ($id, $key, $button) = @_;
+
+ print qq(<form action="$BUCKY/maintain" method="post" enctype="multipart/form-data">\n);
+ print qq(<input type=hidden name="id" value="$id">\n);
+ print qq(<input type=hidden name="c" value="$key">\n);
+ print qq(<input type="submit" value="$button" class="clicky" align="center">\n</form>\n);
+ }
+
+sub onecheckbox
+ {
+ my ($key, $gloss, $tokens) = @_;
+
+ print qq(<td valign=top align="right">\n);
+ print qq(<input type="checkbox" name="$key" value="1" style="padding: 0px; margin: 0px");
+ print qq( checked) if (check_key($tokens, $key));
+ print qq(></td>) .
+ qq(<td valign=top align="left">&nbsp;$gloss&nbsp;</td>);
+ }
+
+sub oneradiobutton
+ {
+ my ($key, $value, $gloss, $check) = @_;
+
+ print qq(<td valign=top align="right">\n);
+ print qq(<input type="radio" name="$key" value="$value" style="padding: 0px; margin: 0px");
+ print qq( checked) if ($check == $value);
+ print qq(></td>) .
+ qq(<td valign=top align="left">&nbsp;$gloss&nbsp;</td>);
+ }
+
+#############################################
+
+sub privacy_select
+ {
+ my ($key, $level) = @_;
+ print "<table cellpadding=0 cellspacing=2 border=0>";
+ print "<tr>";
+ 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 "</tr>";
+ print "</table>";
+ }
+
+#############################################
+
+sub admin_form
+ {
+ my ($id, $t, $f, $k) = @_;
+ print <<adminhead;
+<table width=100% border=0 cellpadding=0 cellspacing=5>
+<tr>
+<td colspan=2 align=left style="padding-left: 10px;">
+<div style="float: right; text-align: center;">
+<br>
+<a href="$BUCKY/details/$id"><u><big><b>exit</b> settings screen</big></u></a><br><br><br>
+adminhead
+ ($many, $flagged) = find_jpeg($files, $t->{flagged});
+ print qq!</div>!;
+
+ thread_display_settings($id, $t, $k);
+ print q{ </td>};
+ print q{</tr>};
+ print q{<tr><td align="left" valign="top">};
+ keyword_display_settings($id, $t, $k);
+ print q{ </td>};
+
+ if ($t->{files} > 0)
+ {
+ print q{ <td align=center valign=top>};
+ file_display_settings($id, $t);
+ print q{ </td>};
+ }
+ print q{</tr>};
+ print q{<tr><td colspan=2 align=right>};
+ thread_delete_box($id);
+ print q{</td></tr>};
+ print q{</table>};
+ }
+
+sub thread_display_settings
+ {
+ my ($id, $t, $k) = @_;
+
+ my $rcolor = get_color($t, $k);
+
+ print qq!<div style="text-align: center; width: 350px;">!;
+ print qq!<center>!;
+ print <<keywordhead;
+<big><b>display</b> settings</big>
+<hr noshade color="$BUCKY_COLOR_HR">
+keywordhead
+ print qq!<div style="text-align: center; width: 250px;">!;
+ print qq!<form action="$BUCKY/maintain" name="display" method="post" enctype="multipart/form-data">\n!;
+ print qq{<input type=hidden name="debug" value="1">\n} if ($DEBUG);
+ print qq{<input type=hidden name="id" value="$id">\n};
+ print qq{<input type=hidden name="c" value="display">\n};
+
+ print qq!<table border=0 cellpadding=0 cellspacing=0>!;
+ print qq!<tr>!;
+ print qq!<td align="right">!;
+ print qq(title:&nbsp;);
+ print qq!</td>!;
+ print qq!<td align="left">!;
+ print qq(<input type=text name="title" value="$t->{title}" size=30 maxlength=48> );
+ print qq!</td>!;
+ print qq!</tr>!;
+ print qq!<tr>!;
+ print qq!<td align="right">!;
+ print qq(color:&nbsp;);
+ print qq!</td>!;
+ print qq!<td align="left">!;
+ color_dropdown($rcolor, 0);
+ print qq!</td>!;
+ print qq!</tr>!;
+
+ print qq!<tr>!;
+ print qq!<td>&nbsp;</td>!;
+ print qq!<td align="left">!;
+
+ print qq!<table border=0 cellpadding=0 cellspacing=0>!;
+ print qq!<tr>!;
+ onecheckbox("no-upload", "disable file upload", $t->{display});
+ print qq!</tr>!;
+ print qq!<tr>!;
+ onecheckbox("shorturl", "shorten urls", $t->{display});
+ print qq!</tr>!;
+ print qq!<tr>!;
+ onecheckbox("editable", "comments editable by ops", $t->{display});
+ print qq!</tr>!;
+ print qq!<tr>!;
+ onecheckbox("opset", "post settings available to ops", $t->{display});
+ print qq!</tr>!;
+ print qq!<tr>!;
+ onecheckbox("no-zip-button", "no zip button", $t->{display});
+ print qq!</tr>!;
+
+ if ($t->{keyword} ne undef)
+ {
+ print qq!<tr>!;
+ onecheckbox("hidekws", "hide keyword list", $t->{display});
+ print qq!</tr>!;
+ }
+ print qq!</table>!;
+
+ if ($t->{files} > 5)
+ {
+ my $filelist = 1;
+ print qq!<table border=0 cellpadding=0 cellspacing=0>!;
+ print qq!<tr>!;
+ 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!</tr><tr>!;
+ oneradiobutton("filelist", 1, "trim if many images", $filelist);
+ print qq!</tr><tr>!;
+ oneradiobutton("filelist", 0, "no file list", $filelist);
+ print qq!</tr>!;
+ print qq!</table>!;
+ }
+ else
+ {
+ print qq(<input type="hidden" name="filelist" value="1">);
+ }
+
+ print qq(<input type="submit" value="UPDATE DISPLAY" class="clicky" align="center">\n</form>\n);
+ print qq!</td>!;
+ print qq!</tr>!;
+ print qq!</table>!;
+ print qq!</form>!;
+
+ print qq!<hr noshade color="$BUCKY_COLOR_HR" size=1>!;
+ print qq!<table cellpadding=0 cellspacing=0 border=0>!;
+ 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! <span class="older">duder$ps</span>!));
+ if ($t->{zipped} == -1)
+ {
+ my $zipfile = retrieve_zip_mechanism($t);
+ if ($zipfile == 1)
+ { print_garrow("zipfile?", qq(<b>in progress</b>)); }
+ }
+ 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,&nbsp;<small>complete&nbsp;as&nbsp;of&nbsp;).(verbosedatetime($zip->{date}))[0].qq(<br><u>freshen</u> | <u>flush</u></small>));
+ }
+ print qq!</table>!;
+
+ print qq!</center>!;
+ print qq!</div>!;
+
+ print qq!</td>!;
+ print qq!</tr>!;
+ }
+
+sub keyword_display_settings
+ {
+ my ($id, $t, $k) = @_;
+
+ print <<keywordhead;
+<div style="width: 350px;">
+<center>
+<big><b>category &amp; tag</b> settings</big>
+<hr noshade color="$BUCKY_COLOR_HR">
+keywordhead
+
+# no keyword set
+ if ($t->{keyword} eq undef)
+ {
+ print qq!<form action="$BUCKY/index" method="post" name="keyword" enctype="multipart/form-data">\n!;
+ print qq{<input type=hidden name="debug" value="1">\n} if ($DEBUG);
+ print qq{<input type=hidden name="thread" value="$id">\n};
+ print qq{<input type=hidden name="c" value="assign">\n};
+ print qq!<table border=0 cellpadding=0 cellspacing=0>!;
+ print qq!<tr><td align="center" valign="middle">SELECT ONE:&nbsp; !;
+ keyword_pulldown($t->{keyword});
+ print <<kwform;
+<input type="submit" value="SET CATEGORY" class="clicky">
+</form>
+</td>
+</tr>
+<tr>
+<td align="center" valign="middle">
+or<br><a href="$BUCKY/index?thread=$t->{id}&keyword=new"><big>make <b>new</b> category</big></a>
+</td>
+</tr>
+</table>
+kwform
+ }
+ else
+ {
+ print qq{current category: <b>$k->{keyword}</b>};
+
+ print qq!&nbsp;&middot;&nbsp;<a href="$BUCKY/index?c=detach&thread=$t->{id}!;
+ print qq!&debug=1! if ($DEBUG);
+ print qq!"><small>detach</small></a>!;
+
+ if ($k->{owner} eq $USER->{username} || check_op($k) || $USER->{ulevel} == 3)
+ {
+ print qq!&nbsp;&middot;&nbsp;<a href="$BUCKY/index?c=edit&keyword=$t->{keyword}!;
+ print qq!&debug=1! if ($DEBUG);
+ print qq!"><small>settings</small></a>!;
+ }
+ }
+ print qq(<br>);
+ print qq!<form action="$BUCKY/maintain" name="tags" method="post" enctype="multipart/form-data">\n!;
+ print qq{<input type=hidden name="debug" value="1">\n} if ($DEBUG);
+ my $tags_string = tags_stringify( $t->{tags} );
+ print qq{<input type=hidden name="tags_saved" value="$tags_string">\n};
+ print qq{<input type=hidden name="id" value="$id">\n};
+ print qq{<input type=hidden name="c" value="t">\n};
+
+ print qq(Tags: );
+ print qq!<input type=text name="tags" value="$tags_string" size=30 maxlength=48>!;
+
+ print <<kwform;
+<input type="submit" value="UPDATE TAGS" class="clicky">
+</form>
+<br>
+<br>
+<big><b>privacy</b> settings</big>
+<hr noshade color="$BUCKY_COLOR_HR">
+kwform
+
+ print qq!<form action="$BUCKY/maintain" name="privacy" method="post" enctype="multipart/form-data">\n!;
+ print qq{<input type=hidden name="debug" value="1">\n} if ($DEBUG);
+ print qq{<input type=hidden name="id" value="$id">\n};
+ print qq{<input type=hidden name="c" value="p">\n};
+
+ print qq!<table border=0 cellpadding=0 cellspacing=0>!;
+ print qq!<tr>!;
+ print qq!<td valign="middle" align=right>viewable by &nbsp;&middot;</td>!;
+ print qq!<td valign="middle" align=left>!;
+ privacy_select("private", $t->{private});
+ print qq!</td></tr></table>!;
+ if ($t->{private} > 1)
+ {
+ print qq!<span style="font-family: georgia, garamond, serif; font-size: 12px;">\n!;
+ print qq!<nobr><small>users checked off below will be able to <b>read</b> and <b>update</b> this post!;
+ if ($k != -1 && $k->{public} != 1)
+ {
+ print qq!,<br>but cannot see the rest of the keyword!;
+ }
+ print qq!.</small></nobr>\n!;
+ print qq!</span>!;
+ user_checkerboard($t->{allowed}, undef, $t->{username});
+ }
+ print <<privend;
+<input type="submit" value="UPDATE PRIVACY" class="clicky">
+</form>
+</small>
+</center>
+</div>
+privend
+ }
+
+sub file_display_settings
+ {
+ my ($id, $t) = @_;
+ print <<dirtop;
+<div style="width: 500px; text-align: center;">
+<big><b>file</b> settings</big><br>
+<hr noshade color="$BUCKY_COLOR_HR">
+dirtop
+
+ print qq!<form name="filez" action="$BUCKY/maintain" method="post" enctype="multipart/form-data">!;
+ print qq{<input type=hidden name="c" value="f">\n};
+ print qq{<input type=hidden name="id" value="$id">\n};
+ print qq{<input type=hidden name="debug" value="1">\n} if ($DEBUG);
+ print <<actionform;
+<script type="text/javascript">
+<!--
+function toggle()
+ {
+ var e = document.filez.elements.length;
+ for (var i = 0; i < e; i++)
+ {
+ var y = "document.filez[i].type";
+ type = eval(y);
+
+ var n = "document.filez[i]";
+ box = eval(n);
+
+ if (type == "checkbox")
+ {
+ if (box.checked == false)
+ { box.checked = true; }
+ else
+ { box.checked = false; }
+ }
+ }
+ }
+-->
+</script>
+
+ <input type=button value="toggle checked" onClick="JavaScript:toggle()"> &middot;
+ <select name="verb">
+ <option value="flag" selected>Check off main image...</option>
+ <option value="rm">Delete checked files (no undo)</option>
+<!-- <option value="move">Move checked files...</option> -->
+ </select>
+ <input type="submit" value="UPDATE FILES" class="clicky">
+actionform
+ file_list($files, -1, 1);
+ print <<end;
+</form>
+</div>
+end
+ }
+
+sub thread_delete_box
+ {
+ my ($id) = @_;
+ print <<formend;
+<tr>
+<td align="right" colspan=2 nowrap>
+<form action="$BUCKY/maintain" name="delete" method="post" enctype="multipart/form-data">
+<input type=hidden name="id" value="$id">
+<input type=hidden name="c" value="clobber">
+<input type="submit" value="EMERGENCY DELETE BUTTON" class="clicky" style="margin-right: 15px;">
+</form>
+</span>
+</td>
+</tr>
+</table>
+formend
+ }
+
+#############################################
+
+sub profile_form
+ {
+ my ($uname) = @_;
+ my $profile = get_user_profile($uname);
+
+ print qq!<form action="$BUCKY/profile" method="post" enctype="multipart/form-data">\n!;
+ print qq!<input type="hidden" name="debug" value="$DEBUG">! if ($DEBUG);
+ print qq!<input type="hidden" name="c" value="update">!;
+
+ print <<profileform;
+<br><br>
+<center>
+<table border=0 cellpadding=0 cellspacing=5>
+<tr><td colspan=2><hr noshade color="$BUCKY_COLOR_HR" size=1></td></tr>
+<tr><td align="left" colspan=2><b><big>profile settings</big></b></td></tr>
+<tr><td colspan=2><hr noshade color="$BUCKY_COLOR_HR" size=1></td></tr>
+<tr>
+<td align="right"><b>Real name:</b></td>
+<td align="left"><input type="text" name="realname" value="$$profile{realname}" size=20></td>
+</tr>
+<tr>
+<td align="right"><b>Email address:</b></td>
+<td align="left"><input type="text" name="email" value="$$profile{email}" size=30></td>
+</tr>
+<tr>
+<td align="right"><b>AIM:</b></td>
+<td align="left"><input type="text" name="aim" value="$$profile{aim}" size=15></td>
+</tr>
+<tr>
+<td align="right"><b>Phone:</b></td>
+<td align="left"><input type="text" name="phone" value="$$profile{phone}" size=15></td>
+</tr>
+<tr>
+<td align="right"><b>Location:</b></td>
+<td align="left"><input type="text" name="location" value="$$profile{location}" size=30></td>
+</tr>
+<tr>
+<td align="right"><b>Timezone:</b></td>
+profileform
+
+ print qq!<td align="left">!;
+ print qq!<select name="timezone">!;
+ my %tzs = ( eastern => -5, central => -6, pacific => -8, englandish => 0 );
+ foreach $tzk (sort keys %tzs)
+ {
+ print qq!<option value="$tzs{$tzk}"!;
+ print " selected" if ($tzs{$tzk} == $$USER{timezone});
+ print qq!>$tzk</option>!;
+ }
+ print qq!</select>!;
+ print qq!</td>\n!;
+
+ print <<profileform;
+</tr>
+<tr>
+<td align="right"><b>Profile picture:</b></td>
+<td align="left"><input type="file" name="userpic" size="12" maxlength="192" style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;" /></td>
+</tr>
+profileform
+
+ if (-e $data_path."/profile/.thumb/pro.".$uname.".jpg")
+ { print qq!<tr><td valign="top" align="right"><i>current profile picture:</i></td><td align="left"><img src="$live_path/profile/$uname.jpg" style="padding: 2px; height: 101px;"> <input type="checkbox" name="rmpic" value="1"> tick to delete picture</td></tr>\n!; }
+
+ $stick = $profile->{stickies};
+ $sink = $profile->{sink};
+ $stick =~ s/^ (.*)/$1/;
+ $stick =~ s/(.*) $/$1/;
+ $sink =~ s/^ (.*)/$1/;
+ $sink =~ s/(.*) $/$1/;
+ print <<profileform;
+<tr><td colspan=2><hr noshade color="$BUCKY_COLOR_HR" size=1></td></tr>
+<tr><td align="left" colspan=2><b><big>home page</big></b></td></tr>
+<tr><td colspan=2><hr noshade color="$BUCKY_COLOR_HR" size=1></td></tr>
+profileform
+ print "<tr>";
+ onecheckbox("welcome", "welcome box", $USER->{boxes});
+ print "</tr><tr>";
+ onecheckbox("bPod", "bPod", $USER->{boxes});
+ print "</tr><tr>";
+# onecheckbox("radio", "radio free chompy <small>(when broadcasting)</small>", $USER->{boxes});
+# print "</tr><tr>";
+ onecheckbox("postform", "quick-post form", $USER->{boxes});
+ print "</tr><tr>";
+ onecheckbox("hootbox", "chat", $USER->{boxes});
+ print "</tr><tr>";
+ onecheckbox("photostream", "photostream", $USER->{boxes});
+ print "</tr>";
+ print <<profileform;
+<tr>
+<td align="right"><b>Sticky keywords:</b></td>
+<td align="left"><input type="text" name="stickies" value="$stick" size=30></td>
+</tr>
+<!--
+<tr>
+<td align="right"><b>Sunken posts:</b></td>
+<td align="left"><input type="text" name="sink" value="$sink" size=30></td>
+</tr>
+-->
+<tr><td colspan=2><hr noshade color="$BUCKY_COLOR_HR" size=1></td></tr>
+profileform
+ print "<tr>";
+ onecheckbox("autoplay", "autoplay mp3s", $USER->{boxes});
+ if ($USER->{'ulevel'} == 3)
+ {
+ print "</tr><tr>";
+ onecheckbox("showhidden", "show hidden posts", $USER->{boxes});
+ }
+ print "</tr><tr>";
+ onecheckbox("nologout", "never log out (your cookie will not expire)", $USER->{boxes});
+ print "</tr>";
+ print <<profileform;
+<tr><td colspan=2><hr noshade color="$BUCKY_COLOR_HR" size=1></td></tr>
+<tr>
+<td align="right"><b>Change password?</b><br><small>please verify:</small></td>
+<td align="left">
+<input type="password" name="pw1" value="" size=13 maxlength=20><br>
+<input type="password" name="pw2" value="" size=13 maxlength=20>
+</td>
+</tr>
+</table>
+<p>
+
+<input type="submit" class="clicky" value="UPDATE PROFILE">
+</center>
+</form>
+profileform
+ return;
+ }
+
+#############################################
+
+sub message_form
+ {
+ my ($recipient, $oldmsg) = @_;
+ my $subject = '';
+ $recipient = '' if ($recipient == -1);
+
+ print qq{<form action="$BUCKY/message" method="post" enctype="multipart/form-data">\n};
+ if ($DEBUG) { print qq!<input type="hidden" name="debug" value="$DEBUG">\n!; }
+ print qq!<input type="hidden" name="c" value="s">\n!;
+ if ($$oldmsg{mbox} =~ /drafts/)
+ {
+ print qq!<input type="hidden" name="oldid" value="$$oldmsg{id}">\n!;
+ }
+
+ print <<FORMmid;
+<center>
+<table cellpadding=0 cellspacing=0 border=0>
+<tr><td class="bluebox">
+<div align="left" style="padding-right: 20px;">
+FORMmid
+
+ print qq!<table cellpadding=0 cellspacing=2 border=0>!;
+ print qq!<tr><td style="text-align: right; vertical-align: center;">!;
+ print qq[<b>to:</b> ];
+ print qq!</td><td style="text-align: left; vertical-align: center;">!;
+ print <<FORMrecip;
+ <input name="recipient" value="$recipient" size=20 maxlength=50 style="font-size: 11px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;
+ color: #140A0A; border: 1px #140A0A solid; padding: 1px; margin: 0px 5px 0px 5px;">
+<small><a href="$BUCKY/users">need to find someone?</a></small>
+FORMrecip
+ print qq!</td></tr>!;
+
+ 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!<tr><td style="text-align: right; vertical-align: center;">!;
+ print <<FORMsubj;
+<b>subject:</b>
+</td><td style="text-align: left; vertical-align: center;">
+<input name="subject" value="$subject" size=50 maxlength=64 style="font-size: 11px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;
+ color: #140A0A; border: 1px #140A0A solid; padding: 1px; margin: 0px 5px 0px 5px;"><br>
+</td></tr>
+</table>
+</div>
+FORMsubj
+
+ print qq[<textarea name="body" cols="80" rows="20" style="font-family: trebuchet ms, sans serif; font-size: 12px;">\n];
+ if ($$oldmsg{mbox} =~ /drafts/)
+ {
+ print $$oldmsg{body};
+ }
+ elsif ($oldmsg != -1)
+ {
+ my $verb = get_random_line("mail-verbs");
+ print "\n\n\n\n_______________\n";
+ print "on ".(plaindate($$oldmsg{date})).", ".$$oldmsg{sender}." $verb:\n\n";
+ print $$oldmsg{body};
+ print "\n";
+ }
+ print qq[</textarea><br>\n];
+
+ print <<FORMEND
+<input type="submit" name="send" value="SEND" class="clicky">
+<input type="submit" name="later" value="SAVE FOR LATER" class="clicky">
+</form>
+</td></tr></table>
+FORMEND
+ }
+
+sub login_form
+ {
+ my $uri = '';
+ print qq{<form action="https://$BUCKY_HOST$BUCKY/login" method="post" enctype="multipart/form-data" name="lf">\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{<input type=hidden name="redir" value="$uri">\n}; }
+
+ if ($DEBUG)
+ { print qq{<input type=hidden name="debug" value="1">\n}; }
+ print <<loginform;
+
+<center><table cellpadding=0 cellspacing=0 border=0>
+<tr><td valign="middle" align="right">username:</td><td valign="middle"><input type=text name="username" value="" size=9 maxlength=9 style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;
+ color: #140A0A; border: 1px #140A0A solid; padding: 1px; margin: 5px 5px 0px 5px;"></td></tr>
+
+<tr><td valign="middle" align="right">password:</td><td valign="middle"><input type=password name="password" size=9 maxlength=20
+style="font-size: 10px; font-family: Trebuchet MS, Helvetica, Arial, sans-serif;
+ color: #140A0A; border: 1px #140A0A solid; padding: 1px; margin: 5px 5px 0px 5px;"></td></tr>
+
+<tr><td>&nbsp;</td>
+<td valign="middle" align="center"><input type="submit" value="LOGIN" class="clicky"></td></tr></table></center>
+</form>
+
+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 <<ERRORHEADER;
+</td></tr></table>
+<center>
+<table width=100% cellpadding=0 cellspacing=0 border=0 style="padding: 0px margin: 0px;">
+<tr><td align=left style="padding: 0px 4px 0px 4px;"><span class="bigtitle">$title</span></td>
+</td></tr></table>
+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 <<head;
+<html>
+ <head>
+ <title>$BUCKY_NAME [$buhtitle]</title>
+ <link rel="stylesheet" href="/css/bogart.css" type="text/css">
+ <link rel="shortcut icon" href="/favicon.ico">
+ <style type="text/css">
+ <!--
+ body { background-color: $rgb_out; }
+ -->
+ </style>
+head
+ print qq( <link rel="stylesheet" href="/css/bogart/$color.css">\n) if $color eq "black";
+ if ($0 =~ /login/)
+ {
+ print qq[<script defer>\n<!-- \nfunction yoink(){document.lf.username.focus();}\n// -->\n</script>\n];
+ print qq! </head>\n\n<body onload=yoink()>\n!;
+ }
+ else
+ {
+ print qq! </head>\n\n<body>\n!;
+ }
+ if ($BUCKY_CONFIG->{SNOWBALL_MACHINE} eq "on" && $0 =~ /index/) # && (time % 13) < 7)
+ {
+ do_snowfall();
+ $title = "ACTIVATE SNOWBALL MACHINE !!!";
+ print <<__CSS__;
+<style>body {background-color: #fff;}</style>
+__CSS__
+ }
+ print <<mid;
+<center>
+<div style="width: 95%; text-align: left; border: 0px; margin-bottom: 120px;">
+<table cellpadding=0 cellspacing=0 border=0 style="padding: 0px margin: 0px;" width=100%>
+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(<tr>);
+ print qq(<td align=left valign=bottom style="padding: 0px 4px 0px 4px;");
+ if (! exists $args->{sidetitle} && exists $args->{sidesubtitle})
+ { print qq( colspan=2); }
+ print qq(>);
+ print qq(<span class="bigtitle">$title</span>);
+ print qq(</td>);
+
+ if (exists $args->{sidetitle})
+ {
+ print qq(<td align=right valign=bottom style="padding: 0px 4px 0px 0px;");
+ if (exists $args->{subtitle} && ! exists $args->{sidesubtitle})
+ { print qq( rowspan=2); }
+ print qq(>);
+ print $args->{sidetitle};
+ print qq(</td>);
+ }
+
+ if (exists $args->{subtitle} || exists $args->{sidesubtitle})
+ { print qq!</tr>\n<tr>!; }
+ if (exists $args->{subtitle})
+ {
+ print qq!<td align="left" valign="middle" style="padding: 2px 0px 0px 4px;"!;
+ if (exists $args->{sidetitle} && ! exists $args->{sidesubtitle})
+ { print qq( colspan=2); }
+ print qq(>);
+ print qq!<small><nobr>! . $args->{subtitle} . qq!</nobr></small></td>!;
+ }
+ if (exists $args->{sidesubtitle})
+ {
+ print qq!<td align="right" valign="middle" style="padding: 2px 4px 0px 0px;"!;
+ if (exists $args->{sidetitle} && ! exists $args->{subtitle})
+ { print qq( colspan=2); }
+ print qq(>);
+ print qq!<small><nobr>! . $args->{sidesubtitle} . qq!</nobr></small></td>!;
+ }
+ print qq!</tr>\n!;
+ print qq!</table>!;
+ }
+
+# 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;
+<table width=100% cellpadding=0 cellspacing=0 border=0 style="padding: 0px margin: 0px;">
+<tr><td colspan=2 align="center">
+<hr noshade color="$BUCKY_COLOR_HR" style="padding: 0px; margin: 2px;">
+</td></tr>
+<tr>
+<td align=left nowrap style="padding: 0px 4px 0px 4px;"><small>
+bigtitle
+
+ if ( $loggedin )
+ {
+ print qq!<span class="lite"><a href="$BUCKY/index">home</a></span>!;
+
+ print qq! | !;
+
+ # print qq!<a href="/cgi-bin/dump/index">dump</a> |\n! if ($USER->{ulevel} > 1);
+
+ print qq!<a href="$BUCKY/2/search">search</a> | !;
+
+ if ($keyed)
+ { print qq!<a href="$BUCKY/post/$kw->{keyword}">post</a> |\n!; }
+ else
+ { print qq!<a href="$BUCKY/post">post</a> |\n!; }
+
+ if (defined($ftp) && $ftp > 0)
+ {
+ if ($ftp < 5)
+ { print qq(<a href="$BUCKY/import?id=$input->{id}"><b>ftp here</b></a> |\n); }
+ else
+ { print qq(<a href="$BUCKY/import?id=$input->{id}">ftp here</a> |\n); }
+ }
+ elsif ($ftp == 0)
+ { print qq(<a href="$BUCKY/import">ftp</a> |\n); }
+ elsif ($keyed)
+ { print qq(<a href="$BUCKY/import?keyword=$kw->{keyword}">ftp</a> |\n); }
+ else
+ { print qq(<a href="$BUCKY/import">ftp</a> |\n); }
+
+ my $newmsg = count_new_messages($USER->{username});
+ if ($newmsg > 0)
+ { print qq[<b><a href="$BUCKY/inbox"><u>inbox ($newmsg new)</u></a></b> |\n]; }
+ else
+ { print qq[<a href="$BUCKY/inbox">inbox</a> |\n]; }
+
+ print qq[<a href="$BUCKY/message">message</a> |\n];
+
+ print <<bigfoot;
+<a href="$BUCKY/profile?c=form">profile</a> |
+<a href="$BUCKY/logout">logout</a>
+</small></td>
+<td align=right nowrap style="padding: 0px 4px 0px 4px;"><small>
+$lastlog | <a href="$BUCKY/users">userlist</a>
+</small></td></tr>
+bigfoot
+ }
+ else
+ {
+ # else: logged out, only display "login"
+ print <<bigfeet;
+<span class="lite"><a href="$BUCKY/index">home</a></span>
+|
+<a href="$BUCKY/login">login</a>
+</small></td>
+<td align=right nowrap style="padding: 0px 4px 0px 4px;"><small>
+</small></td></tr>
+bigfeet
+ }
+
+ print <<bighonk;
+<tr><td colspan=2 align="center">
+<hr noshade color="$BUCKY_COLOR_HR" style="padding: 0px; margin: 2px;">
+</td></tr>
+</table>
+bighonk
+ }
+
+sub footer
+ {
+ print <<foot;
+</div>
+</center>
+foot
+
+ print <<foot;
+
+</body>
+</html>
+
+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 <<snowfall;
+<script>
+
+// *********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("<span id='s"+i+"' style='position:absolute;top:-"+snowmaxsize+"'>"+snowletter+"</span>")
+}
+if (browserok) {
+ window.onload=initsnow
+}
+</script>
+
+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!<td align=center valign=middle>!;
+
+ my $keyword = $file->{keyword} || "details";
+ if ( $keyword == -1 )
+ { $keyword = "details"; }
+
+ if ($string == -1)
+ { print qq!<a href="$BUCKY/!.details_link().qq!/$file->{thread}">!; }
+ else
+ { print qq!<a href="$live_path/$file->{thread}/$file->{filename}">!; }
+
+ print qq!<img class="thumb" border=0 src="$live_path/$file->{thread}/.thumb/$thumb_token!.$lcfilename.qq!">!;
+ print qq(</a>);
+
+ if ($string != -1)
+ {
+ print qq(<br><small>);
+ if (length($file->{title}))
+ { print $file->{title}; }
+ else
+ { print clean_image_filename($file->{filename}); }
+ print qq! (! . profile_link($file->{username}) . qq!,&nbsp;! . get_age($file->{date}) . qq!)!;
+ print qq(</small>);
+ }
+
+ print qq!</a>!;
+ print qq!</td>!;
+ }
+
+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!<a href="$live_path/$f->{thread}/$f->{filename}"><img src="$live_path/$f->{thread}/.thumb/s.!.$lcfilename.qq!" class="thumb"></a>!;
+ }
+
+#######################################################################################
+# 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 "<table border=0 cellpadding=3 cellspacing=0 width=100%>";
+ 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 "<tr>\n" if ($j == 0);
+ print_image_thumb($f, "t.");
+ print "</tr>\n" if ($j == 2);
+
+ $j = $j == 2 ? 0 : $j+1;
+
+ $i++;
+ }
+ print qq!</table>\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(<table border=0 cellpadding=0 cellspacing=0>);
+ 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(<tr>\n);
+ print_image_thumb($f, $thumb_token);
+ }
+ else
+ {
+ print_image_thumb($f, $thumb_token);
+ print qq(</tr>\n);
+ }
+ }
+ else
+ {
+ print qq(<tr>\n);
+ print_image_thumb($f, $thumb_token);
+ print qq(</tr>\n);
+ }
+
+ $i++;
+ }
+ print qq!</table>\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 "<table border=0 cellpadding=3 cellspacing=0 width=100%>";
+$i = 4;
+print <<__CROWS__;
+<td align=center valign=middle><a href="/cgi-bin/bucky/details/246"><img class="thumb" border=0 src="/bucky/data/246/.thumb/t.dsc_0253.jpg"></a></a></td>
+<td align=center valign=middle><a href="/cgi-bin/bucky/details/246"><img class="thumb" border=0 src="/bucky/data/246/.thumb/t.dsc_0265.jpg"></a></a></td>
+<td align=center valign=middle><a href="/cgi-bin/bucky/details/246"><img class="thumb" border=0 src="/bucky/data/246/.thumb/t.dsc_0240.jpg"></a></a></td>
+<td align=center valign=middle><a href="/cgi-bin/bucky/details/246"><img class="thumb" border=0 src="/bucky/data/246/.thumb/t.dsc_0234.jpg"></a></a></td>
+__CROWS__
+ print "</table>\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(<table border=0 cellpadding=0 cellspacing=0 width="100%" style='margin:0 0 10px 0'>);
+ print "<tr>";
+ 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 "</tr>" if (!$vertical);
+ print qq!</table>\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(<table border=0 cellpadding=3 cellspacing=3 width="100%">);
+ print "<tr>" 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 "<tr>" if ($vertical);
+ print_image_thumb($f, "t.", -1);
+ print "</tr>" if ($vertical);
+ print "\n";
+ }
+ print "</tr>" if (!$vertical);
+ print qq!</table>\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}}<br>" 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...<br>" if ($DEBUG);
+ while (-e "$temp_path/.importnow")
+ { sleep(1); }
+ print "Setting permissions...<br>" if ($DEBUG);
+ while (-e "$temp_path/.importing")
+ { sleep(1); }
+ print "Ready to import!<br>" 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<br>\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."<br>" 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!<br>" 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;
+<center>
+<table border=0 cellpadding=0 cellspacing=0 class="main">
+ <tr>
+ <td class="head">&nbsp;</td>
+ <td class="head" align="left" nowrap>&nbsp;<b>Name</b><img src="/blank.gif" height="1" width="200"></td>
+ <td class="head"></td>
+ <td class="head" align="left" nowrap><b>Date</b></td>
+ <td class="head" align="right">&nbsp;<b>Size</b>&nbsp;</td>
+ </tr>
+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!<tr><td colspan=5 align="right" style="border-top: 1px dotted #ccc;">total size: !.(sprintf "%0.1fmb",$size/1000000).qq!</td></tr></table></center>\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[<tr class="row$r">];
+ if ($color eq "incomplete")
+ {
+ print qq[<td align="right">&nbsp;</td>];
+ print '<td></td>';
+ print qq[<td align="left" nowrap>&nbsp;<i>$$f{filename}</i></td>];
+ print qq[<td align="left" nowrap><i>]. (verbosedate($$f{date})), qq[</i></td>];
+ print qq[<td align="right"><i>&nbsp;$$f{size}</i>&nbsp;</td>];
+ }
+ else
+ {
+ if ($f->{filename} =~ /^temp_/)
+ { print qq[<td align="right">&nbsp;</td>]; }
+ else
+ { print qq[<td align="right"><input type="checkbox" name="import$i" value="$$f{filename}"></td>]; }
+ if ($f->{filename} =~ /jpg|gif|png$/)
+ {
+ #print "<td><img src='/bucky/data/incoming/$$f{filename}' width=150></td>";
+ print '<td></td>';
+ }
+ else
+ {
+ print '<td></td>';
+ }
+ print qq[<td align="left" nowrap>&nbsp;];
+ print qq[<a href="/bucky/data/incoming/$$f{filename}" target="_blank">$$f{filename}</a></td>];
+ print qq[<td align="left" nowrap><span class="$color">]. (verbosedate($$f{date})), qq[</span></td>];
+ print qq[<td align="right">&nbsp;$$f{size}&nbsp;</td>];
+ }
+
+ print qq[</tr>\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(<b>$newuser->{username}</b> has created an account via invite.\n\n) .
+ qq(<b>real name:</b> $newuser->{realname}\n\n) .
+ qq(<b>email:</b> $newuser->{email}\n\n) .
+ qq(<b>invited by:</b> $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(<hr noshade color="$BUCKY_COLOR_HR" style="padding: 0px; margin: 2px;"><br><br><br><center><div class=message>);
+ print "Your $BUCKY_NAME account has created!<p>";
+ print "Please <b>log in</b> for the first time.\n";
+ print qq(<hr noshade color="$BUCKY_COLOR_HR">\n\n);
+ login_form();
+ print qq(</div></center>\n\n);
+ footer();
+ }
+
+sub request_success
+ {
+ header("account requested!");
+ print qq(<hr noshade color="$BUCKY_COLOR_HR">\n\n);
+ print "Your request for a $BUCKY_NAME account has been submitted and will be acted upon shortly.<p>";
+ print qq(<big><a href="/">back to $BUCKY_NAME</a></big>);
+ footer();
+ }
+
+#############################
+
+sub registration_form
+ {
+ my ($invite) = @_;
+ my $invited = defined($invite) && $invite != -1;
+
+ if ($invited)
+ { header("create an account"); }
+ else
+ { header("request an account"); }
+
+ print <<adduserform;
+<hr noshade color="$BUCKY_COLOR_HR" style="padding: 0px; margin: 2px;"><br>
+<table width=100%><tr><td align="center">
+<img src="/bucky/newme.jpg" style="border: 2px solid #000; margin-bottom: 3px;"><br><!-- <small>~ OUR FOUNDER ~</small> -->
+<small><span style="color: #dfd6cd;">may i note here . . . that i test this with firefox</span><br></small>
+<table><tr><td class="message" nowrap style="width: 300px;">
+<b>welcome to $BUCKY_NAME!</b>
+<hr noshade color="$BUCKY_COLOR_HR">
+<div align="right" nowrap style="width: 250px;">
+
+<form action="$BUCKY/invite" method="post">
+adduserform
+
+ print qq(<input type="hidden" name="debug" value="1">\n) if ($DEBUG);
+
+ if ($invited)
+ {
+ print qq(<input type="hidden" name="c" value="validate">\n);
+ print qq(<input type="hidden" name="hash" value="$invite->{hash}">\n);
+ }
+ else
+ {
+ print qq(<input type="hidden" name="c" value="request">\n);
+ }
+
+ print <<adduserfoot;
+username <small>(lowercase)</small>: <input type="text" name="username" value="" size=10 maxlength=9><br>
+password: <input type="password" name="pw1" value="" size=13 maxlength=20><br>
+again! <input type="password" name="pw2" value="" size=13 maxlength=20><br>
+real name: <input type="text" name="realname" value="" size=20><br>
+email address: <input type="text" name="email" value="" size=20><br>
+</div>
+adduserfoot
+
+ print <<snark;
+oh <b>h</b>e<b>l</b>l<b>o</b> <b>t</b>h<b>e</b>r<b>e</b> duder, please say hello<br>
+<textarea name="grass" rows="5" style="width: 86%; padding: 0px 1px 1px 1px; font-family: trebuchet ms, sans serif; font-size: 11px;"></textarea>
+snark
+
+ print <<addusereof;
+<div align="center">
+<p>
+
+<input type="submit" value="SUBMIT" class="clicky">
+
+</form>
+</div>
+</td></tr></table>
+</td></tr></table>
+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:<p>";
+ print "<ul>\n";
+ foreach my $e (@error)
+ {
+ print "<li> $e\n";
+ }
+ print "</ul>\n";
+ print qq(Please <a href="javascript:history.go(-1)">go back and fix it</a> . . .<p>);
+ footer();
+ exit(1);
+ }
+
+#############################
+
+sub invite_result_box
+ {
+ my ($command, $hash, $result) = @_;
+ print qq(<div class="message">);
+ if ($command eq "new")
+ {
+ if ($result)
+ {
+ print qq(<b>invite created!</b><p>);
+ print qq(give the url to your friend!);
+ }
+ else
+ {
+ print qq(you were <b>unable</b> to make a new invite!<p>);
+ print qq(maybe you have been inviting too many people?!);
+ }
+ }
+ else
+ {
+ print qq(<b>$command</b> );
+ print $result ? "succeeded!" : "failed!";
+ }
+ print qq(</div>\n);
+ }
+
+sub invite_create_box
+ {
+ print qq(<div class="message">);
+ print qq(<b>invite</b> whomever..\n<hr noshade color="$BUCKY_COLOR_HR">\n);
+ print qq(only invite goodfellows,<br>my fellow ).$BUCKY_DUDER_NOUN.qq(s.<p>);
+ print qq(<form action="$BUCKY/invite" method="post">\n);
+ print qq(<input type="hidden" name="debug" value="1">\n) if ($DEBUG);
+ print qq(<input type="hidden" name="c" value="new">\n);
+ # keyword_pulldown();
+ print qq(<input type="submit" value="G E N E R A T E" class="clicky">\n);
+ print qq(</form>);
+ print qq(</div>\n);
+ }
+
+#############################
+
+sub display_personal_invites
+ {
+ my $user_invites = get_invites_by_user($USER->{username});
+ return if ($user_invites == -1);
+ print "<big><b>Your invites:</b></big><p>";
+ display_invites_table($user_invites);
+ }
+
+sub display_approve_list
+ {
+ my $invites = get_active_invites();
+ print "<big><b>Active invites and requests:</b></big><p>";
+ display_invites_table($invites);
+ }
+
+{
+my %invites_seen;
+sub display_invites_table
+ {
+ my ($invites) = @_;
+ my $r = 0;
+ print qq(<table border=0 cellpadding=0 cellspacing=0 class="main" width=600>\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(</table>);
+ }
+}
+
+sub display_single_invite
+ {
+ my ($i, $r) = @_;
+
+ print qq(<tr class="row$r">);
+
+ print qq(<td align=center style="border-right: 1px dashed #bbb; width: 80px;">);
+ print qq(<b>) if ($i->{state} == 2);
+ print $BUCKY_INVITE_STATES[$i->{state}];
+ print qq(</b>) if ($i->{state} == 2);
+ print qq(</td>);
+
+ if ($i->{hash})
+ { display_invite_row($i); }
+ else
+ { display_approve_row($i); }
+ print qq(</tr>\n);
+ }
+
+sub display_invite_row
+ {
+ my ($i) = @_;
+
+ if ($i->{state} > 0)
+ {
+ print qq(<td>);
+ print qq(<table cellpadding=0 cellspacing=0 border=0 width=100%);
+
+ print qq(<tr>);
+ print qq(<td align=center colspan=4>);
+ print qq(<a href="$BUCKY/invite?i=$i->{hash}">https://$BUCKY_HOST$BUCKY/invite/$i->{hash}</a>);
+ print qq(</td>);
+ print qq(</tr>);
+
+ print qq(<tr>);
+ print qq(<td align=center>);
+ print qq(<small>invited by ).profile_link($i->{attest}).qq(</small>);
+ print qq(</td>);
+ print qq(<td align=right>);
+ print qq(<small>expires in</small>);
+ print qq(</td>);
+ print qq(<td align=left>);
+ print get_age($i->{expired});
+ print qq(</td>);
+ print qq(<td align=right>);
+ print invite_snuff_link("renew", $i->{id}) . qq( &middot; );
+ print invite_snuff_link("cancel", $i->{id});
+ print qq(</td>);
+ print qq(</tr>);
+
+ print qq(</table>);
+ print qq(</td>);
+ }
+ elsif ($i->{state} == $BUCKY_INVITE_REDEEMED)
+ {
+ print qq(<td>);
+ print qq(<table cellpadding=0 cellspacing=0 border=0 width=100%);
+ print qq(<tr>);
+ print qq(<td align=center width=50%>);
+ print qq(<small>invited by ).profile_link($i->{attest}).qq(</small>);
+ print qq(</td>);
+ print qq(<td align=center width=50%>);
+ print qq(new user: );
+ print profile_link($i->{username});
+ print qq(</td>);
+ print qq(</tr>);
+ print qq(</table>);
+ print qq(</td>);
+ }
+ else
+ {
+ print qq(<td>&nbsp;</td>);
+ }
+ }
+
+# 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(<td>);
+ print qq(<table cellpadding=0 cellspacing=0 border=0 width=100%);
+
+ print qq(<tr><td align=right width=100><b>username:&nbsp;</b></td><td align=left colspan=2>$i->{username}</td></tr>);
+ print qq(<tr><td align=right width=100><b>realname:&nbsp;</b></td><td align=left colspan=2>$i->{realname}</td></tr>);
+ print qq(<tr><td align=right width=100><b>email:&nbsp;</b></td><td align=left colspan=2>$i->{email}</td></tr>);
+
+ print qq(<tr>);
+ print qq(<td>&nbsp;</td>);
+ print qq(<td align=left colspan=2>$i->{grass}</td>);
+ print qq(</tr>);
+
+ if ($i->{state} > 0)
+ {
+ print qq(<tr>);
+ print qq(<td align=right>);
+ print qq(<small>expires in</small>);
+ print qq(</td>);
+ print qq(<td align=left>);
+ print get_age($i->{expired});
+ print qq(</td>);
+
+ print qq(<td align=right>);
+ print invite_snuff_link("approve", $i->{id}) . qq( &middot; );
+ print invite_snuff_link("reject", $i->{id});
+ print qq(</td>);
+ print qq(</tr>);
+ }
+
+ print qq(</table>);
+ print qq(</td>);
+ }
+
+sub invite_snuff_link
+ {
+ my ($c, $id) = @_;
+ return qq(<a href="$BUCKY/invite?c=$c&id=$id">$c</a>);
+ }
+
+#############################
+
+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}<br>\n"; }
+ print "keyword ==> $kn<br>\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!<select name="keyword">!;
+ print qq!<option value="NONE"!;
+ print " selected" if ($selected eq "NONE");
+ print qq!>(none)</option>!;
+ print qq!<option disabled> . . . . . . . . . . </option>!;
+
+ foreach my $k (sort { lc($a) cmp lc($b) } keys %$keywords)
+ {
+ my $kh = $keywords->{$k};
+ $sees_private_keys++ if (check_op($kh));
+ next unless ($kh->{public} == 1);
+ print qq!<option value="$k"!;
+ print qq! selected! if ($k eq $selected);
+ print qq!>$k</option>!;
+ }
+
+ if (! $sees_private_keys)
+ {
+ print qq!</select>\n!;
+ return;
+ }
+
+# return unless ($sees_private_keys);
+
+ print qq!<option disabled> . . . . . . . . . . </option>!;
+ 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!<option value="$k"!;
+ print qq! selected! if ($k eq $selected);
+ print qq!>$k</option>!;
+ }
+ print qq!</select>\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;
+<form action="$BUCKY/index" method="post" enctype="multipart/form-data">
+<input type=hidden name="c" value="$command">
+kf
+ print qq!<input type=hidden name="debug" value="1">\n! if ($DEBUG);
+ print <<kf;
+<table border=0 cellpadding=0 cellspacing=0>
+<tr>
+<td style="text-align: right; vertical-align: middle;"><b>category</b></td>
+<td style="text-align: left; vertical-align: middle; padding-left: 10px;">
+kf
+ if ($keyword eq "new")
+ {
+ $verb = "CREATE";
+ print qq!<input type="text" name="keyword" value="" maxlength=15>!;
+ }
+ else
+ {
+ print qq!<b>$keyword</b>!;
+ print qq!<input type="hidden" name="keyword" value="$keyword">\n!;
+ }
+ print <<kf;
+</td>
+</tr>
+kf
+ if ($t != -1)
+ {
+ print <<pub;
+<tr>
+<td style="text-align: right; vertical-align: middle;">initial post</td>
+<td style="text-align: left; vertical-align: middle; padding-left: 10px;"><input type="hidden" name="thread" value="$t->{id}"><a href="$BUCKY/details/$t->{id}">$t->{title}</a></td>
+</tr>
+pub
+ }
+
+ $checked = ($k->{public} == 1) ? " checked" : "";
+ print <<pub;
+<tr>
+<td style="text-align: right; vertical-align: middle;">color</td>
+<td style="text-align: left; vertical-align: middle; padding-left: 10px;">
+pub
+ my $rcolor = get_color(-1, $k);
+ color_dropdown($rcolor, 0);
+ print <<kf;
+</td>
+</tr>
+<tr>
+<td style="text-align: right; vertical-align: middle;">anyone can post</td>
+<td style="text-align: left; vertical-align: middle; padding-left: 10px;"><input type="checkbox" name="public" value="1"$checked></td>
+</tr>
+kf
+
+ if ($k->{public} != 1 || $t != -1)
+ {
+ print <<kf;
+<tr>
+<td style="text-align: right; vertical-align: top;">operators</td>
+<td style="text-align: left; vertical-align: middle; padding-left: 10px;">
+kf
+ print qq!<center>!;
+ print qq!<span style="font-family: georgia, garamond, serif; font-size: 12px;">\n!;
+ print qq!<nobr><small><B>--- if "anyone can post" is unchecked ---</b><br>users checked off below will <b>share control</b> of this category,<br>and will be able to add new posts to it,<br>alter privacy/color settings, etc.</small></nobr><br>\n!;
+ print qq!</span>!;
+ 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!</center>!;
+
+ print <<kf;
+</td>
+</tr>
+kf
+ }
+
+ print <<kf;
+<tr>
+<td style="text-align: right; vertical-align: middle;">&nbsp;</td>
+<td style="text-align: left; vertical-align: middle; padding-left: 10px;"><input type="submit" class="clicky" value="$verb CATEGORY"></td>
+</tr>
+
+</table>
+</form>
+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} [<b>now</b>]" 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!<center>!;
+ print qq!<table width=400 border=0 cellpadding=0 cellspacing=0>!;
+ print qq!<tr><td class="bluebox">!;
+
+ print qq(<table width=100% border=0 cellpadding=0 cellspacing=0>);
+ print qq(<tr>);
+ if ($image != -1)
+ {
+ print qq(<td rowspan=2 align="left" valign="middle" width=).($AVATAR_MED_WIDTH+10).qq(>);
+ print qq(<a href="$BUCKY/profile/$message->{sender}">);
+ print qq(<img src="$image" width="$AVATAR_MED_WIDTH" height="$AVATAR_MED_WIDTH" border=1">);
+ print qq(</a>);
+ print qq(</td>);
+ }
+
+ print qq!<td align=left valign=bottom>!;
+ print qq!<b><big>$message->{subject}</big></b>!;
+ print qq!</td></tr>!;
+ print qq!<tr><td align=left valign=top>!;
+ print qq!<small>!;
+ print qq!sent by <a href="$BUCKY/profile/$message->{sender}">$message->{sender}</a> !;
+ print qq!on </small>!.(verbosedate($message->{date}));
+# print qq! <small>(!.get_age($message->{date}).qq! ago)</small>!;
+ print qq!</td></tr>!;
+
+ print qq!<tr><td colspan=2>!;
+ print qq!<hr noshade color="$BUCKY_COLOR_HR">!;
+ print qq!</td></tr>!;
+
+ print qq!<tr><td align=left valign=top height=310 colspan=2 style="padding: 0px 20px 0px 20px;">\n!;
+ print linebr($message->{body});
+ print qq!</td></tr>!;
+
+ print qq!<tr><td colspan=2>!;
+ print qq!<hr noshade color="$BUCKY_COLOR_HR">!;
+ print qq!</td></tr>!;
+
+ print qq!<tr><td align=right colspan=2>!;
+ print qq!<small>!;
+ if ($message->{mbox} =~ /drafts/)
+ {
+ print qq{[<a href="$BUCKY/message?c=r&id=$message->{id}">edit</a>] };
+ }
+ else
+ {
+ print qq{[<a href="$BUCKY/message?c=r&id=$message->{id}">reply</a>] };
+ }
+ print qq![<a href="$BUCKY/message?c=d&id=$message->{id}">delete</a>]!;
+ print qq!</small>!;
+ print qq!</td></tr>!;
+ print qq!</td></tr></table>!;
+ print qq!</center>!;
+ }
+
+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!<p>\n\n!;
+ }
+
+ if ($messages == -1)
+ {
+ print qq[<br><span style="margin-left: 50px;"><b><big>No messages in this mailbox!</big></b></span>];
+ return;
+ }
+
+ print qq!<table border=0 cellpadding=0 cellspacing=0 class="threadmain" width=750>!;
+
+ foreach my $message (@$messages)
+ {
+ display_message_row($message, $box, $r);
+ $r = $r ? 0 : 1;
+ }
+
+ print "</table>\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[<tr>];
+
+ print qq[<td align="right" valign="middle" nowrap>&nbsp;];
+ print "<small>";
+ if ($m->{sender} eq "system")
+ {
+ print qq(system);
+ }
+ elsif ($m->{sender} eq $USER->{username})
+ {
+ print qq[to <a href="$BUCKY/profile/$m->{recipient}" class="quietlink">$m->{recipient}</a>];
+ }
+ else
+ {
+ print qq[<a href="$BUCKY/profile/$$m{sender}" class="quietlink">$$m{sender}</a>];
+ }
+ print qq[&nbsp;&middot;&nbsp;];
+ print "</small>";
+ print "</td>";
+
+ print qq[<td align="left" valign="middle" nowrap class="plain$r" width=300 nowrap>];
+ print qq[<span class="threadname" style="white-space:nowrap;">];
+ if ($$m{unread})
+ { print qq[<b><a href="$BUCKY/inbox/$m->{id}">$m->{subject}</a></b>]; }
+ else
+ { print qq[<a href="$BUCKY/inbox/$m->{id}">$m->{subject}</a>]; }
+ print qq[</span>];
+ print "</td>";
+
+ my ($tddate, $tdtime) = verbosedatetime($m->{date});
+ print qq[<td align="right" valign="middle" nowrap style="padding-right: 0px; margin-right: 0px;">];
+ print qq[<span class="$color">$tddate&nbsp;</span>];
+ print "</td>";
+ print qq[<td align="left" valign="middle" nowrap style="padding-left: 0px; margin-left: 0px; padding-top: 2px;">];
+ print qq[<span class="$color"><small>$tdtime</small></span>];
+ print "</td>";
+
+ print qq[<td align="right" valign="middle" nowrap style="padding-right: 10px; margin-left: 0px; padding-top: 2px;">];
+ print qq[<small>].hushsize($m->{size},.0000001,1).qq[</small>];
+ print "</td>";
+
+ print qq[<td align=left valign=middle><small>];
+ if ($box =~ /drafts/)
+ {
+ print qq{[<a href="$BUCKY/message?c=r&id=$m->{id}">edit</a>] };
+ }
+ else
+ {
+ print qq{[<a href="$BUCKY/message?c=r&id=$m->{id}">reply</a>] };
+ }
+ print qq{[<a href="$BUCKY/message?c=d&id=$m->{id}">delete</a>]};
+ print qq[</small></td>];
+
+ print qq[</tr>\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}<br>owner: $k->{owner}<br>" if ($DEBUG);
+ print "ops: $k->{ops}<br>" if ($DEBUG);
+ print "public: $k->{public}<br>" 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}<br>owner: $k->{owner}<br>" if ($DEBUG);
+ print "ops: $k->{ops}<br>" if ($DEBUG);
+ print "public: $k->{public}<br>" 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!<table border=1 cellpadding=3 cellspacing=0>!;
+
+ 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[<tr>\n] if ($j == 0);
+ print qq[<td class="row$r" nobreak><nobr>];
+ print qq[<input type="checkbox" name="user$i" value="$duder->{username}"];
+ print " checked" if ($checked);
+ print qq[>&nbsp;<a href="$BUCKY/profile/$duder->{username}" class="quietlink">$duder->{username}</a>];
+ print qq[</nobr></td>\n];
+ print qq[</tr>\n] if ($j == 3);
+
+ $r = $r ? 0 : 1;
+ $r = $j == 3 ? int(!$r) : $r;
+ $j = $j == 3 ? 0 : $j+1;
+ $i++;
+ $checked = 0;
+ }
+
+ print "</table>\n";
+ }
+
+sub update_whitelist
+ {
+ my $whitelist = make_whitelist();
+ if ($whitelist eq " ")
+ { print "whitelist cleared<br>"; }
+ else
+ { print "new whitelist: $whitelist<br>"; }
+ 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!<table border=0 cellpadding=0 cellspacing=0 width="100%">!;
+ print qq!<tr>!;
+ print qq!<td style="width: 300px; padding: 5px; vertical-align: top;">\n!;
+
+ print qq!<img src="$image"><br>! if ($image != -1);
+
+ print qq(<table border=0 cellpadding=0 cellspacing=0>);
+ profile_row("name", $$profile{realname});
+ my $email = $$profile{email};
+ $email =~ s/\@/&nbsp;<i>at<\/i>&nbsp;/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&nbsp;seen", "<b>active&nbsp;now</b>"); }
+ else
+ { profile_row("last&nbsp;seen", verbosedate($$profile{lastseen})); }
+ if (($USER->{username} ne $uname) && $loggedin)
+ {
+ profile_row("&middot; &middot; &middot; &middot;",
+ qq[<a href="$BUCKY/message/$uname">send $uname a message</a>]);
+ }
+ print "</table>";
+
+ if ($files != -1)
+ {
+ user_image_gallery({ files => $files, vertical => 1, count => 8 });
+ }
+
+ print qq(</td>);
+
+ print qq(<td style="padding: 10px; vertical-align: top; text-align: center;">\n);
+
+ if ($threads != -1)
+ {
+ print qq!<table border=0 cellpadding=0 cellspacing=0 class="threadmain" width="100%">!;
+ print qq(<tr><td colspan=255><big>&nbsp;threads by $uname</big></td></tr>);
+ print qq(<tr><td colspan=255><hr noshade color="$BUCKY_COLOR_HR" style="padding: 0px; margin: 2px;"></td></tr>);
+ thread_box({ threads => $threads, kw => 'USER', dosum => 0, dohead => 0 });
+ if ($files != -1)
+ {
+ print qq(<tr><td colspan=255><big>&nbsp;</big></td></tr>);
+ print qq(<tr><td colspan=255><big>&nbsp;files by $uname</big></td></tr>);
+ print qq(<tr><td colspan=255><hr noshade color="$BUCKY_COLOR_HR" style="padding: 0px; margin: 2px;"></td></tr>);
+ file_list($files, 0, 1, 0);
+ }
+ print "</table>\n";
+ print "<p>\n\n";
+ }
+
+ print qq(</td></tr>);
+
+ print qq(</table>);
+
+ footer();
+ }
+
+sub profile_row
+ {
+ my ($k, $v) = @_;
+ print "<tr><td align=right valign=top nobreak><small>$k&nbsp;&middot;&nbsp;</small></td><td align=left valign=top>$v</td></tr>";
+ }
+
+# 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...<br>";
+ system($MV_PATH, "$data_path/profile/$username.jpg", $data_path."/profile/".$username."-old.jpg");
+ }
+
+ $messages .= "updating profile pic for $username to $filename...<br>";
+ 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 "<small>" if ($DEBUG);
+
+ $RADIO_STATUS_ENABLED = 1;
+ if ( ! $RADIO_STATUS_ENABLED || poll_radio_status() == -1)
+ { return -1; }
+
+ print "\nRadio is up!<br>\n" if ($DEBUG);
+
+ if (poll_cache_age($RADIO_INFO_PATH) > 60)
+ {
+ print "Polling radio...<br>\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 "</small>" if ($DEBUG);
+
+ return $radio;
+ }
+
+sub poll_cache_age
+ {
+ my $file = shift;
+ my $ret = time - (stat($file))[9];
+ print "Age of $file: $ret seconds...<br>\n" if ($DEBUG);
+ return $ret;
+ }
+
+sub poll_radio_status
+ {
+ my $status;
+ print "Polling radio status...<br>\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=<F>;
+ 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 <FORTUNES>;
+ 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\n<tt>ENTERING DEBUG MODE . . .</tt><p>"; }
+
+$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<br>\n" if ($DEBUG);
+ print "view: $object<br>\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 "<br>HELLO $user->{username}<br>" 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("<center>error: $reason</center>");
+ print qq(<center>);
+ print qq(<div align="center" style="max-width: 390px;">);
+ print qq(<hr noshade color="$BUCKY_COLOR_HR">);
+ my $filename = lc($f->{filename});
+ print qq!<img src="/bucky/error.jpg" class="thumb"></a><br>\n!;
+ print "<p>sorry, there was an <b>error:</b><p><big>$reason</big><p>";
+ print qq!<a href="javascript:history.go(-1)"><big><b>go back</b></big></a> | <a href="$BUCKY/index">home</a>\n!;
+ print qq(</div>);
+ print qq(</center>);
+ }
+ else
+ {
+ header("error: $reason");
+ print "there was an <b>error:</b><p>$reason<p>";
+ }
+ 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;
+<table width=100% border=0 cellpadding=0 cellspacing=5>
+<tr>
+adminhead
+ if ($t->{files} > 0)
+ {
+ print qq(<td colspan=2 align=left style="padding-left: 10px;">\n);
+ }
+ else
+ {
+ print qq(<td align=left style="padding-left: 10px;">\n);
+ }
+ print <<adminhead;
+<div style="float: right; text-align: center;">
+<br>
+<a href="$BUCKY/details/$id"><u><big><b>exit</b> settings screen</big></u></a><br><br><br>
+adminhead
+ ($many, $flagged) = find_jpeg($files, $t->{flagged});
+ print qq!</div>!;
+
+ thread_display_settings($id, $t, $k);
+ keyword_display_settings($id, $t, $k);
+ print q{ </td>};
+
+ if ($t->{files} > 0)
+ {
+ print q{ <td align=center valign=top>};
+ file_display_settings($id, $t);
+ print q{ </td>};
+ }
+ print q{</tr>};
+ print q{<tr><td colspan=2 align=right>};
+ thread_delete_box($id);
+ print q{</td></tr>};
+ print q{</table>};
+ }
+
+sub thread_display_settings
+ {
+ my ($id, $t, $k) = @_;
+
+ my $rcolor = get_color($t, $k);
+
+ print qq!<div style="text-align: center; width: 350px;">!;
+ print qq!<center>!;
+ print <<keywordhead;
+<big><b>display</b> settings</big>
+<hr noshade color="$BUCKY_COLOR_HR">
+keywordhead
+ print qq!<div style="text-align: left; width: 250px;">!;
+ print qq!<form action="$BUCKY/maintain" name="display" method="post" enctype="multipart/form-data">\n!;
+ print qq{<input type=hidden name="debug" value="1">\n} if ($DEBUG);
+ print qq{<input type=hidden name="id" value="$id">\n};
+ print qq{<input type=hidden name="c" value="display">\n};
+
+ print qq!<table border=0 cellpadding=0 cellspacing=0>!;
+ print qq!<tr>!;
+ print qq!<td align="right">!;
+ print qq(title:&nbsp;);
+ print qq!</td>!;
+ print qq!<td align="left">!;
+ print qq(<input type=text name="title" value="$t->{title}" size=30 maxlength=48> );
+ print qq!</td>!;
+ print qq!</tr>!;
+ print qq!<tr>!;
+ print qq!<td align="right">!;
+ print qq(color:&nbsp;);
+ print qq!</td>!;
+ print qq!<td align="left">!;
+ color_dropdown($rcolor, 0);
+ print qq!</td>!;
+ print qq!</tr>!;
+
+ print qq!<tr>!;
+ print qq!<td>&nbsp;</td>!;
+ print qq!<td align="left">!;
+
+ print qq!<table border=0 cellpadding=0 cellspacing=0>!;
+ print qq!<tr>!;
+ onecheckbox("shorturl", "shorten urls", $t->{display});
+ print qq!</tr>!;
+ print qq!<tr>!;
+ onecheckbox("editable", "comments editable by ops", $t->{display});
+ print qq!</tr>!;
+ print qq!<tr>!;
+ onecheckbox("opset", "post settings available to ops", $t->{display});
+ print qq!</tr><tr>!;
+ onecheckbox("no-zip-button", "no zip button", $t->{display});
+ print qq!</tr>!;
+
+ if ($t->{keyword} ne undef)
+ {
+ onecheckbox("hidekws", "hide keyword list", $t->{display});
+ }
+
+ if ($t->{files} > 5)
+ {
+ print qq!<table border=0 cellpadding=0 cellspacing=0>!;
+ print qq!<tr>!;
+ my $ffl = check_key($t->{display}, "ffl");
+ my $nfl = check_key($t->{display}, "nfl");
+ oneradiobutton("filelist", 2, "full file list", $ffl);
+ print qq!</tr><tr>!;
+ oneradiobutton("filelist", 1, "trim if many images", (!$nfl && !$ffl));
+ print qq!</tr><tr>!;
+ oneradiobutton("filelist", 0, "no file list", $nfl);
+ print qq!</tr>!;
+ print qq!</table>!;
+ }
+ print qq!</table>!;
+ print qq!</td>!;
+ print qq!</tr>!;
+ print qq!</table>!;
+
+ print qq!<hr noshade color="$BUCKY_COLOR_HR" size=1>!;
+ print qq!<table cellpadding=0 cellspacing=0 border=0>!;
+ 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! <span class="older">duder$ps</span>!));
+ if ($t->{zipped} == -1)
+ {
+ my $zipfile = retrieve_zip_mechanism($t);
+ if ($zipfile == 1)
+ { print_garrow("zipfile?", qq(<b>in progress</b>)); }
+ }
+ 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,&nbsp;<small>complete&nbsp;as&nbsp;of&nbsp;).(verbosedatetime($zip->{date}))[0].qq(<br><u>freshen</u> | <u>flush</u></small>));
+ }
+ print qq!</table>!;
+
+ print qq!</div>!;
+ print qq!</center>!;
+ print qq!</div>!;
+
+ print qq!</td>!;
+ print qq!</tr>!;
+
+ print <<keywordhead;
+<div style="width: 350px;">
+<center>
+<big><b>category</b> settings</big>
+<hr noshade color="$BUCKY_COLOR_HR">
+keywordhead
+
+# no keyword set
+ if ($t->{keyword} eq undef)
+ {
+ print qq!<form action="$BUCKY/index" method="post" name="keyword" enctype="multipart/form-data">\n!;
+ print qq{<input type=hidden name="debug" value="1">\n} if ($DEBUG);
+ print qq{<input type=hidden name="thread" value="$id">\n};
+ print qq{<input type=hidden name="c" value="assign">\n};
+ print qq!<table border=0 cellpadding=0 cellspacing=0>!;
+ print qq!<tr><td align="center" valign="middle">SELECT ONE:&nbsp; !;
+ keyword_pulldown($t->{keyword});
+ print <<kwform;
+<input type="submit" value="SET CATEGORY" class="clicky">
+</form>
+</td>
+</tr>
+<tr>
+<td align="center" valign="middle">
+or<br><a href="$BUCKY/index?thread=$t->{id}&keyword=new"><big>make <b>new</b> category</big></a>
+</td>
+</tr>
+</table>
+kwform
+ }
+ else
+ {
+ print qq{current category: <b>$k->{keyword}</b>};
+
+ print qq!&nbsp;&middot;&nbsp;<a href="$BUCKY/index?c=detach&thread=$t->{id}!;
+ print qq!&debug=1! if ($DEBUG);
+ print qq!"><small>detach</small></a>!;
+
+ if ($k->{owner} eq $USER->{username} || check_op($k) || $USER->{ulevel} == 3)
+ {
+ print qq!&nbsp;&middot;&nbsp;<a href="$BUCKY/index?c=edit&keyword=$t->{keyword}!;
+ print qq!&debug=1! if ($DEBUG);
+ print qq!"><small>settings</small></a>!;
+ }
+ }
+ print <<kwform;
+<br>
+<br>
+<big><b>privacy</b> settings</big>
+<hr noshade color="$BUCKY_COLOR_HR">
+kwform
+
+ print qq!<table border=0 cellpadding=0 cellspacing=0>!;
+ print qq!<tr>!;
+ print qq!<td valign="middle" align=right>viewable by &nbsp;&middot;</td>!;
+ print qq!<td valign="middle" align=left>!;
+ privacy_select("private", $t->{private});
+ print qq!</td></tr></table>!;
+ if ($t->{private} > 1)
+ {
+ print qq!<span style="font-family: georgia, garamond, serif; font-size: 12px;">\n!;
+ print qq!<nobr><small>users checked off below will be able to <b>read</b> and <b>update</b> this post!;
+ if ($k != -1 && $k->{public} != 1)
+ {
+ print qq!,<br>but cannot see the rest of the keyword!;
+ }
+ print qq!.</small></nobr>\n!;
+ print qq!</span>!;
+ user_checkerboard($t->{allowed}, undef, $t->{username});
+ }
+ print <<privend;
+<input type="submit" value="UPDATE PRPOST SETTINGS" class="clicky">
+</form>
+</small>
+</center>
+</div>
+privend
+ }
+
+sub file_display_settings
+ {
+ my ($id, $t) = @_;
+ print <<dirtop;
+<div style="width: 500px; text-align: center;">
+<big><b>file</b> settings</big><br>
+<hr noshade color="$BUCKY_COLOR_HR">
+dirtop
+
+ print qq!<form name="filez" action="$BUCKY/maintain" method="post" enctype="multipart/form-data">!;
+ print qq{<input type=hidden name="c" value="f">\n};
+ print qq{<input type=hidden name="id" value="$id">\n};
+ print qq{<input type=hidden name="debug" value="1">\n} if ($DEBUG);
+ print <<actionform;
+<script type="text/javascript">
+<!--
+function toggle()
+ {
+ var e = document.filez.elements.length;
+ for (var i = 0; i < e; i++)
+ {
+ var y = "document.filez[i].type";
+ type = eval(y);
+
+ var n = "document.filez[i]";
+ box = eval(n);
+
+ if (type == "checkbox")
+ {
+ if (box.checked == false)
+ { box.checked = true; }
+ else
+ { box.checked = false; }
+ }
+ }
+ }
+-->
+</script>
+
+ <input type=button value="toggle checked" onClick="JavaScript:toggle()"> &middot;
+ <select name="verb">
+ <option value="flag" selected>Check off main image...</option>
+ <option value="rm">Delete checked files (no undo)</option>
+<!-- <option value="move">Move checked files...</option> -->
+ </select>
+ <input type="submit" value="UPDATE FILES" class="clicky">
+actionform
+ file_list($files, -1, 1);
+ print <<end;
+</form>
+</div>
+end
+ }
+
+sub thread_delete_box
+ {
+ my ($id) = @_;
+ print <<formend;
+<tr>
+<td align="right" colspan=2 nowrap>
+<form action="$BUCKY/maintain" name="delete" method="post" enctype="multipart/form-data">
+<input type=hidden name="id" value="$id">
+<input type=hidden name="c" value="clobber">
+<input type="submit" value="EMERGENCY DELETE BUTTON" class="clicky" style="margin-right: 15px;">
+</form>
+</span>
+</td>
+</tr>
+</table>
+formend
+ }
+
+#############################################
+
+sub print_garrow
+ {
+ my ($a, $b) = @_;
+ $a =~ s/\s/&nbsp;/g;
+ print qq!<tr><td style="text-align: right; vertical-align: middle;"><big>$a:</big></td><td style="text-align: left; vertical-align: middle; padding: 5px;">$b</a></td></tr>\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<br>\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<br>\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<br>\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, "<a href=\"$BUCKY/$BUCKY_LEXICON_TAG/$tag\" class=\"quietlink\">$tag</a>" );
+ }
+ my $return_string = join(', ', @$tags_links) if ref($tags);
+ if (defined($limit) && ($limit < 0) )
+ { $return_string .= " <a href=\"$BUCKY/details/$thread_id\" class=\"quietlink\">...</a>"; }
+ 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<br>\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<br>\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} . "<br>\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(<tr><td><img src="/blank.gif" height=5></td></tr>);
+ }
+# print qq(<tr><td><img src="/blank.gif" height=2></td></tr>);
+ }
+
+print qq(<tr><td colspan=666>);
+ index_photostream();
+print qq(</td></tr>);
+
+ 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(<tr><td><img src="/blank.gif" height=1></td></tr>);
+ }
+
+ thread_box({ threads => $organized{"unsorted"}, dosum => 0, dohead => 1 }) if ($BUCKY_CONFIG->{UNSORTED_POSITION} eq "bottom");
+
+ if ($i >= $limit)
+ {
+ print qq(<tr><td align="right" colspan=7 style="padding-top: 15px;"><big>);
+ print qq(<a href="$BUCKY/index?limit=10000">show all &gt;&gt;</a></big></td></tr>);
+ }
+ }
+
+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(<tr><td align="right" valign="bottom"><big>);
+ print qq[<span style="font-weight: bold;">];
+ print qq[tag: ];
+ print qq(</span></a>);
+ print qq(</big>);
+ print qq(</td><td align="left" valign="bottom" colspan=4>);
+ print qq(<big>);
+ print qq[<span style="font-weight: bold;">];
+ print qq($tag->{tag});
+ print qq(</span>);
+ print qq(</big>);
+ print qq(</td></tr>);
+ }
+ if ($dohead && $latest)
+ {
+ print qq(<tr><td align="right" valign="bottom"><big>);
+ print qq[<span style="font-weight: bold;">];
+ print qq(<i>the&nbsp;latest</i>&nbsp;</span></a>);
+ print qq(</big>);
+ print qq(&middot;);
+ print qq(</td><td align="left" valign="bottom" colspan=4>);
+ print qq(welcome back to $BUCKY_NAME!! <a href="$BUCKY/post">Start a new thread...</a></td></tr>);
+ print_boxtop(1);
+ }
+ elsif ($dohead && (!defined($kw) || $kw == -1))
+ {
+ my $unsorted_keyword = get_random_line("keywords");
+ print qq(<tr><td align="right" valign="bottom"><big>);
+ print qq[<a href="$BUCKY/$BUCKY_LEXICON_KEYWORD/unsorted" class="quietlink">];
+ print qq[<span style="font-weight: bold;">];
+ print $unsorted_keyword;
+ print qq(</span></a>);
+ print qq(</big><small>&nbsp;&middot;&nbsp;</small>);
+ print qq(</td><td align="left" valign="bottom" colspan=4>);
+ print qq(<small>);
+ print qq(<a href="$BUCKY/$BUCKY_LEXICON_KEYWORD/unsorted">show all</a>);
+ print qq( &middot; <a href="$BUCKY/post">post</a>);
+ print qq( &middot; <a href="$BUCKY/import">ftp</a>);
+ print qq(</small>);
+ print qq(</td></tr>);
+ }
+ elsif ($user)
+ {
+ # this is all broken for some reason, is rewritten somewhere...!
+ print_boxtop(1);
+ }
+ elsif ($dohead)
+ {
+ $polite_keyword = $th->{keyword};
+ $polite_keyword =~ s/ /&nbsp;/g;
+ print qq(<tr><td align="right" valign="bottom"><big>);
+ print qq[<a href="$BUCKY/$BUCKY_LEXICON_KEYWORD/$th->{keyword}" class="quietlink">];
+ print qq[<span style="font-weight: bold;">];
+ print $polite_keyword;
+ print qq(</span></a>);
+ print qq(</big><small>&nbsp;&middot;&nbsp;</small>);
+ print qq(</td><td align="left" valign="bottom" colspan=4>);
+ print qq(<small>);
+ if ($kw->{public} == 1 || $isop)
+ {
+ # print qq(<a href="$BUCKY/index?keyword=$th->{keyword}">show all</a>);
+ # print qq( &middot; );
+
+ print qq(<a href="$BUCKY/post/$th->{keyword}">post</a>) if ($USER != -1);
+
+ # 20070903 - marc - no more ftp
+ print qq( &middot; <a href="$BUCKY/import?keyword=$th->{keyword}">ftp</a>);
+ }
+ if ($isop || $USER->{ulevel} == 3)
+ {
+ print qq( &middot; );
+ print qq(<a href="$BUCKY/$BUCKY_LEXICON_KEYWORD/$th->{keyword}?c=edit">settings</a>);
+ }
+ print qq(</small>);
+ print qq(</td></tr>);
+ }
+ $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(<tr><td colspan=2 align=right><small><b>$line</b> thread$s);
+ print qq(, ).hushsize($sum,1.7).qq(</small></td></tr>);
+ }
+ }
+ }
+
+sub print_boxtop
+ {
+ print qq!<tr><td></td><td style="border-bottom: 1px solid #b6aeab;"><img src="/blank.gif" width=1 height=1></td></tr>!;
+ }
+
+sub print_boxbottom
+ {
+ print qq!<tr><td></td><td style="border-top: 1px solid #b6aeab;"><img src="/blank.gif" width=1 height=2></td></tr>!;
+ }
+
+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!<div align="left">Displaying post $t->{id} -- $t->{title}</div>\n!;
+ }
+
+ print qq[<tr>];
+
+ print qq[<td align="right" valign="middle" nowrap>];
+ print "<small>";
+ print qq[<a href="$BUCKY/profile/$t->{username}" class="quietlink">$t->{username}</a>&nbsp;];
+
+ if ($t->{private} == 2)
+ { print qq[.:]; }
+ elsif ($t->{private} == 1)
+ { print qq[:]; }
+ else
+ { print qq[&middot;]; }
+ print "&nbsp;</small>";
+ print "</td>";
+
+ if ($box > 0)
+ {
+ $rcolor = "tan" if ($rcolor eq "plain");
+ print qq(<td align="left" valign="middle" nowrap class="$rcolor$r" style="border-left: 1px solid #b6aeab; border-right: 1px solid #b6aeab;">);
+ }
+ else
+ {
+ print qq[<td align="left" valign="middle" nowrap class="$rcolor$r">];
+ }
+ my $thread_link_class;
+ if ($t->{date} > (time - 209828) && $t->{date} > 1168910000)
+ { $thread_link_class = "threadname newthread"; }
+ else
+ { $thread_link_class = "threadname"; }
+
+ print qq(<a class="$thread_link_class" style="display: block;" href="$BUCKY/).details_link().qq(/$t->{id});
+ print get_revision($t) if ($USER != -1);
+ print qq(">);
+ print qq($t->{title});
+ print qq(</a>);
+ print "</td>";
+
+ my ($age) = get_age($t->{date});
+
+ print qq(<td align="right" valign="middle" nowrap>);
+ print "<small>";
+ print qq(<span class="$color">&nbsp;&nbsp;$age&nbsp;</span>);
+ print "</small>";
+ print "</td>";
+
+# my ($tddate, $tdtime) = verbosedatetime($t->{date});
+# print qq[<td align="right" valign="middle" nowrap style="padding-right: 0px; margin-right: 0px;">];
+# print qq[<span class="$color">&nbsp;$tddate&nbsp;</span>];
+# print "</td>";
+# if ($0 !~ /(details|profile)/)
+# {
+# print qq[<td align="left" valign="middle" nowrap style="padding-left: 0px; margin-left: 0px; padding-top: 2px;">];
+# print qq[<span class="$color"><small>$tdtime</small></span>];
+# print "</td>";
+# }
+
+ print qq[<td align="right" valign="middle" nowrap>];
+ print "<small>&nbsp;";
+ if ($t->{viewed} > 0)
+ { print hushview($t->{viewed}, "v") . "</small></td>"; }
+ else
+ { print "</small></td>"; }
+ # decrement comments count here so we treat the first comment" as the body of the post
+ if (($t->{comments} - 1) > 0)
+ { print "<td align=right valign=middle nowrap><small>&nbsp;".hushnull($t->{comments} - 1, "c") . "</small></td>"; }
+ else
+ { print "<td align=right valign=middle nowrap><small>&nbsp;</small></td>"; }
+
+# print qq[<a href="$BUCKY/index?keyword=$th->{keyword}" class="quietlink">];
+# if (!ref($t->{tags}))
+# { print "<td><small>&nbsp;</small></td>"; }
+# else
+# { print "<td align=left valign=middle nowrap><span class=\"quiet\"><small>&nbsp;&nbsp;". tags_stringify_links ( $t, 3 ). "</small></span></td>"; }
+# if ($t->{files} > 0)
+# { print "<td align=right valign=middle nowrap><small>" .hushnull($t->{files}, "f") . "</small></td>"; }
+# else
+# { print "<td><small>&nbsp;</small></td>"; }
+
+# print "</td>";
+
+ print qq[<td align="right" valign="middle" nowrap>];
+ if ($t->{files} > 0)
+ {
+ print "<small>&nbsp;".hushsize($t->{size},1.2,$old),qq[</small></td>];
+ if ($0 !~ /(details|profile)/)
+ {
+ print qq[<td align="left"><small><span class="old">in</span>&nbsp;];
+ print hushnull($t->{files}, "f");
+ print "</small>";
+ }
+ }
+ print "</td>";
+
+ print qq[</tr>\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;
+