diff options
| author | Jules Laplace <carbon@melanarchy.org> | 2013-08-02 17:14:41 -0500 |
|---|---|---|
| committer | Jules Laplace <carbon@melanarchy.org> | 2013-08-02 17:14:41 -0500 |
| commit | e9192b3d42660a5781101df4357d276318151e8a (patch) | |
| tree | 059eb6ace6147cf9559af74ed1ab5e221c80e280 /lib | |
| parent | 79670053c7247d3a49b607960efd284e93f057e5 (diff) | |
cgi-bin & lib
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Bucky1.pm | 53 | ||||
| -rw-r--r-- | lib/RGB.pm | 151 | ||||
| -rw-r--r-- | lib/boxes.pm | 165 | ||||
| -rw-r--r-- | lib/color.pm | 117 | ||||
| -rw-r--r-- | lib/comments.pm | 287 | ||||
| -rw-r--r-- | lib/constants.pm | 82 | ||||
| -rw-r--r-- | lib/cookies.pm | 55 | ||||
| -rw-r--r-- | lib/db.pm | 2400 | ||||
| -rw-r--r-- | lib/files.pm | 241 | ||||
| -rw-r--r-- | lib/format.pm | 414 | ||||
| -rw-r--r-- | lib/forms.pm | 854 | ||||
| -rw-r--r-- | lib/getargs.pm | 134 | ||||
| -rw-r--r-- | lib/headers.pm | 347 | ||||
| -rw-r--r-- | lib/images.pm | 509 | ||||
| -rw-r--r-- | lib/import.pm | 204 | ||||
| -rw-r--r-- | lib/invite.pm | 485 | ||||
| -rw-r--r-- | lib/keywords.pm | 187 | ||||
| -rw-r--r-- | lib/lastlog.pm | 29 | ||||
| -rw-r--r-- | lib/message.pm | 195 | ||||
| -rw-r--r-- | lib/privacy.pm | 133 | ||||
| -rw-r--r-- | lib/profile.pm | 127 | ||||
| -rw-r--r-- | lib/radio.pm | 100 | ||||
| -rw-r--r-- | lib/rand.pm | 20 | ||||
| -rw-r--r-- | lib/randbg.pm | 26 | ||||
| -rw-r--r-- | lib/session.pm | 262 | ||||
| -rw-r--r-- | lib/settings.pm | 315 | ||||
| -rw-r--r-- | lib/tags.pm | 147 | ||||
| -rw-r--r-- | lib/threads.pm | 411 |
28 files changed, 8450 insertions, 0 deletions
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>~>{ <a href="$BUCKY/details/1">GLIMPSE THE PAST</a> }<~</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 .= " 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) : " "; + $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 </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 .= " ago" unless $age eq "now"; + my $z_user = $c->{username}; + my $z_profile = qq($BUCKY/profile/$z_user); + my $z_comment = linebr($c->{comment}, $args->{shorturl}); + my $z_width = $AVATAR_MED_WIDTH; + my $z_image = get_profile_image($c->{username}, $AVATAR_MED_PREFIX); + my $z_options = ($USER != -1) ? display_comment_options($args) : " "; + $z_options .= " ($z_id)" if $DEBUG; + + print qq(<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;"> ); + 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 to post ></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> <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> </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 = " am"; } + elsif ($h == 12) + { $meridian = " pm"; } + elsif ($h > 12) + { $h -= 12; $meridian = " pm"; } + else + { $meridian = " 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 = " am"; } + elsif ($h == 12) + { $meridian = " pm"; } + elsif ($h > 12) + { $h -= 12; $meridian = " pm"; } + else + { $meridian = " am"; } + return ((sprintf("%d-%s-%d", $d, $months[$n], ($y+1900))), (sprintf("%2d:%02d%s", $h, $m, $meridian))); + } + +sub plaindate + { + my ($date) = @_; + $date = when_is_it($date); + my ($m,$h,$d,$n,$y) = (localtime $date)[1..5]; + my $meridian; + if ($h == 0) + { $h = 12; $meridian = " am"; } + elsif ($h == 12) + { $meridian = " pm"; } + elsif ($h > 12) + { $h -= 12; $meridian = " pm"; } + else + { $meridian = " am"; } + return sprintf("%2d-%s-%d at %d:%02d%s", $d, $months[$n], ($y+1900), $h, $m, $meridian); + } + +sub commatize + { + my $number = shift; + my $txt; + my @txt; + my $i; + my $counter = 0; + if ($number > 1024) + { + $number /= 1024; + unshift @txt, (($number*10) % 10); + unshift @txt, "."; + } + + do + { + $i = $number % 10; + $number = int($number / 10); + if ($number && !(++$counter % 3)) + { $i = ' '.$i; } + unshift @txt, $i; + } + while($number); + + $txt = join "", @txt; + return $txt; + } + +sub carbondate + { + my ($date, $nobold) = @_; + my $span = (time - $date); + + my $boldnew = (!defined($nobold) || !($nobold)) ? 1 : 0; + + if ($boldnew && $span < 86400) # modified today + { $color = "new"; } + elsif ($span < 604800) # modifed this week + { $color = "recent"; } + elsif ($span < 1209600) # modifed 2 weeks ago + { $color = "med"; } + elsif ($span < 3024000) # modifed 5 weeks ago + { $color = "old"; } + elsif ($span < 12315200) # modifed 6 months ago + { $color = "older"; } + else + { $color = "quiet"; } + + return $color; + } + +sub pretty_date + { + my ($timeinsecs, $nobold) = @_; + my $date = verbosedate($timeinsecs); + my $color = carbondate($timeinsecs, $nobold); + + return qq(<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! v.</span>!; } + elsif ($n < 500) + { return qq!<span class="quiet">$txt!.qq! v.</span>!; } + elsif ($n < 1000) + { return qq!<span class="old">$txt!.qq! v.</span>!; } + elsif ($n < 5000) + { return qq!<span class="med">$txt!.qq! kv.</span>!; } + elsif ($nobold || $n < 10000) + { return qq!<span class="recent">$txt!.qq! kv.</span>!; } + else + { return qq!<span class="new">$txt!.qq! 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! kb.</span>!; } + elsif ($n < (20000000/$bias)) + { return qq!<span class="quiet">$txt!.qq! mb.</span>!; } + elsif ($n < (50000000/$bias)) + { return qq!<span class="old">$txt!.qq! mb.</span>!; } + elsif ($n < (80000000/$bias)) + { return qq!<span class="med">$txt!.qq! mb.</span>!; } + elsif ($nobold || $n < (170000000/$bias)) + { return qq!<span class="recent">$txt!.qq! mb.</span>!; } + else + { return qq!<span class="new">$txt!.qq! 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 .= " $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/( )/ /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 + { ' ' } +sub middot + { ' · ' } + +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? </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: "; + 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 post form</a> |</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> </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 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/&/&/g; + $comment =~ s/>/>/g; + $comment =~ s/</</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 form</a></small> +</td></tr> +FORMEND + print "</form>"; + } + +############################################# + +sub print_garrow + { + my ($a, $b) = @_; + $a =~ s/\s/ /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"> $gloss </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"> $gloss </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: ); + 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: ); + print qq!</td>!; + print qq!<td align="left">!; + color_dropdown($rcolor, 0); + print qq!</td>!; + print qq!</tr>!; + + print qq!<tr>!; + print qq!<td> </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, <small>complete as of ).(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 & 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: !; + 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! · <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! · <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 ·</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()"> · + <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> </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!, ! . 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"> </td> + <td class="head" align="left" nowrap> <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"> <b>Size</b> </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"> </td>]; + print '<td></td>'; + print qq[<td align="left" nowrap> <i>$$f{filename}</i></td>]; + print qq[<td align="left" nowrap><i>]. (verbosedate($$f{date})), qq[</i></td>]; + print qq[<td align="right"><i> $$f{size}</i> </td>]; + } + else + { + if ($f->{filename} =~ /^temp_/) + { print qq[<td align="right"> </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> ]; + 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"> $$f{size} </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( · ); + 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> </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: </b></td><td align=left colspan=2>$i->{username}</td></tr>); + print qq(<tr><td align=right width=100><b>realname: </b></td><td align=left colspan=2>$i->{realname}</td></tr>); + print qq(<tr><td align=right width=100><b>email: </b></td><td align=left colspan=2>$i->{email}</td></tr>); + + print qq(<tr>); + print qq(<td> </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( · ); + 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;"> </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> ]; + 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[ · ]; + 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 </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[> <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/\@/ <i>at<\/i> /i; + profile_row("email", $email) if ($loggedin); + profile_row("aim", $$profile{aim}) if ($$profile{aim} && $loggedin); + profile_row("phone", $$profile{phone}) if ($$profile{phone} && $loggedin); + profile_row("location", $$profile{location}) if ($$profile{location}); + my %tzs = ( -5 => eastern, -6 => central, -8 => pacific, 0 => englandish); + profile_row("timezone", $tzs{$profile->{timezone}}) if (exists $tzs{$profile->{timezone}}); + if ((time - $$profile{lastseen}) < 60) + { profile_row("last seen", "<b>active now</b>"); } + else + { profile_row("last seen", verbosedate($$profile{lastseen})); } + if (($USER->{username} ne $uname) && $loggedin) + { + profile_row("· · · ·", + 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> 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> </big></td></tr>); + print qq(<tr><td colspan=255><big> 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 · </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: ); + 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: ); + print qq!</td>!; + print qq!<td align="left">!; + color_dropdown($rcolor, 0); + print qq!</td>!; + print qq!</tr>!; + + print qq!<tr>!; + print qq!<td> </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, <small>complete as of ).(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: !; + 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! · <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! · <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 ·</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()"> · + <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/ /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 >></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 latest</i> </span></a>); + print qq(</big>); + print qq(·); + 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> · </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( · <a href="$BUCKY/post">post</a>); + print qq( · <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/ / /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> · </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( · ); + + print qq(<a href="$BUCKY/post/$th->{keyword}">post</a>) if ($USER != -1); + + # 20070903 - marc - no more ftp + print qq( · <a href="$BUCKY/import?keyword=$th->{keyword}">ftp</a>); + } + if ($isop || $USER->{ulevel} == 3) + { + print qq( · ); + 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> ]; + + if ($t->{private} == 2) + { print qq[.:]; } + elsif ($t->{private} == 1) + { print qq[:]; } + else + { print qq[·]; } + print " </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"> $age </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"> $tddate </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> "; + 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> ".hushnull($t->{comments} - 1, "c") . "</small></td>"; } + else + { print "<td align=right valign=middle nowrap><small> </small></td>"; } + +# print qq[<a href="$BUCKY/index?keyword=$th->{keyword}" class="quietlink">]; +# if (!ref($t->{tags})) +# { print "<td><small> </small></td>"; } +# else +# { print "<td align=left valign=middle nowrap><span class=\"quiet\"><small> ". 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> </small></td>"; } + +# print "</td>"; + + print qq[<td align="right" valign="middle" nowrap>]; + if ($t->{files} > 0) + { + print "<small> ".hushsize($t->{size},1.2,$old),qq[</small></td>]; + if ($0 !~ /(details|profile)/) + { + print qq[<td align="left"><small><span class="old">in</span> ]; + 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; + |
