cgi-bin & lib

1 files changed, 414 insertions, 0 deletions

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 = "&nbsp;am"; }
+	elsif ($h == 12)
+		{ $meridian = "&nbsp;pm"; }
+	elsif ($h > 12)
+		{ $h -= 12; $meridian = "&nbsp;pm"; }
+	else
+		{ $meridian = "&nbsp;am"; }
+	return ((sprintf("%d-%s-%d", $d, $months[$n], ($y+1900))), (sprintf("%2d:%02d%s", $h, $m, $meridian)));
+	}
+
+sub plaindate
+        {
+	my ($date) = @_;
+	$date = when_is_it($date);
+	my ($m,$h,$d,$n,$y) = (localtime $date)[1..5];
+	my $meridian;
+	if ($h == 0)
+		{ $h = 12; $meridian = " am"; }
+	elsif ($h == 12)
+		{ $meridian = " pm"; }
+	elsif ($h > 12)
+		{ $h -= 12; $meridian = " pm"; }
+	else
+		{ $meridian = " am"; }
+	return sprintf("%2d-%s-%d at %d:%02d%s", $d, $months[$n], ($y+1900), $h, $m, $meridian);
+        }
+
+sub commatize
+	{
+	my $number = shift;
+	my $txt;
+	my @txt;
+	my $i;
+	my $counter = 0;
+	if ($number > 1024)
+		{
+		$number /= 1024;
+		unshift @txt, (($number*10) % 10);
+		unshift @txt, ".";
+		}
+
+	do
+		{
+		$i = $number % 10;
+		$number = int($number / 10);
+		if ($number && !(++$counter % 3))
+			{ $i = ' '.$i; }
+		unshift @txt, $i;
+		}
+		while($number);
+
+	$txt = join "", @txt;
+	return $txt;
+	}
+
+sub carbondate
+	{
+	my ($date, $nobold) = @_;
+	my $span = (time - $date);
+
+	my $boldnew = (!defined($nobold) || !($nobold)) ? 1 : 0;
+
+	if ($boldnew && $span < 86400) # modified today
+		{ $color = "new"; }
+	elsif ($span < 604800) # modifed this week
+		{ $color = "recent"; }
+	elsif ($span < 1209600) # modifed 2 weeks ago
+		{ $color = "med"; }
+	elsif ($span < 3024000) # modifed 5 weeks ago
+		{ $color = "old"; }
+	elsif ($span < 12315200) # modifed 6 months ago
+		{ $color = "older"; }
+	else
+		{ $color = "quiet"; }
+
+	return $color;
+	}
+
+sub pretty_date
+	{
+	my ($timeinsecs, $nobold) = @_;
+	my $date = verbosedate($timeinsecs);
+	my $color = carbondate($timeinsecs, $nobold);
+
+	return qq(<span class="$color">$date</span>);
+	}
+
+sub extend_span
+	{
+	my ($os, $od) = @_;
+	if ($os eq "now")
+		{ $os = time; }
+	my $span = $os - $od; 
+	if ($DEBUG)
+		{
+		print qq(\nSTART: $os<br>END: $od<br>SPAN: $span<br>);
+		print qq(DAYS: ).int($span / (60*60*24)).qq(<br>\n);
+		}
+	return ($od, int($od-($span*2.6)));
+	}
+
+sub hushview
+	{
+	my ($n, $bias, $nobold) = @_;
+	$bias = 1 unless ($bias);
+	my $txt = commatize($n);
+	if ($n < 30)
+		{ $n = 0 if (!$n); return qq!<span class="quiet">$n!.qq! v.</span>!; }
+	if ($n < 200)
+		{ return qq!<span class="quiet">$txt!.qq!&nbsp;v.</span>!; }
+	elsif ($n < 500)
+		{ return qq!<span class="quiet">$txt!.qq!&nbsp;v.</span>!; }
+	elsif ($n < 1000)
+		{ return qq!<span class="old">$txt!.qq!&nbsp;v.</span>!; }
+	elsif ($n < 5000)
+		{ return qq!<span class="med">$txt!.qq!&nbsp;kv.</span>!; }
+	elsif ($nobold || $n < 10000)
+		{ return qq!<span class="recent">$txt!.qq!&nbsp;kv.</span>!; }
+	else
+		{ return qq!<span class="new">$txt!.qq!&nbsp;kv.</span>!; }
+	}
+
+sub hushsize
+	{
+	my ($n, $bias, $nobold) = @_;
+	$bias = 1 unless ($bias);
+	my $txt = commatize($n / 1024);
+	if ($n < 1024)
+		{ $n = 0 if (!$n); return qq!<span class="quiet">$n!.qq! b.</span>!; }
+	if ($n < 1024*1024)
+		{ return qq!<span class="quiet">$txt!.qq!&nbsp;kb.</span>!; }
+	elsif ($n < (20000000/$bias))
+		{ return qq!<span class="quiet">$txt!.qq!&nbsp;mb.</span>!; }
+	elsif ($n < (50000000/$bias))
+		{ return qq!<span class="old">$txt!.qq!&nbsp;mb.</span>!; }
+	elsif ($n < (80000000/$bias))
+		{ return qq!<span class="med">$txt!.qq!&nbsp;mb.</span>!; }
+	elsif ($nobold || $n < (170000000/$bias))
+		{ return qq!<span class="recent">$txt!.qq!&nbsp;mb.</span>!; }
+	else
+		{ return qq!<span class="new">$txt!.qq!&nbsp;mb.</span>!; }
+	}
+
+sub hushnull
+	{
+	my ($n, $unit, $nobold) = @_;
+	my $out = '';
+
+	if ($n < 3)
+		{ $out .= qq!<span class="quiet">$n!; }
+	elsif ($n < 6)
+		{ $out .= qq!<span class="older">$n!; }
+	elsif ($n < 10)
+		{ $out .= qq!<span class="old">$n!; }
+	elsif ($n < 16)
+		{ $out .= qq!<span class="med">$n!; }
+	elsif ($nobold || $n < 21)
+		{ $out .= qq!<span class="recent">$n!; }
+	else
+		{ $out .= qq!<span class="new">$n!; }
+	$out .= "&nbsp;$unit." if ($unit);
+	$out .= "</span>";
+	return $out;
+	}
+
+sub courtesy_s
+	{
+	my ($v) = @_;
+	if ($v == 1)
+		{ return ""; }
+	else
+		{ return "s"; }
+	}
+
+sub linebr
+	{
+	my ($text, $short) = @_;
+	chomp $text;
+	unless ($text =~ /(<a href=|<img)/)
+		{
+		if ($short)
+			{
+			$text = tidy_urls($text);
+			}
+		else
+			{
+	        $text =~ s/(https?:\/\/\S+) ?/ <a href="$1" target="_blank">$1<\/a> /g;
+			}
+		}
+	$text =~ s/\s((dj )?phatty)/ <a href="\/phatty\/" target="_blank">$1<\/a>/i;
+	$text =~ s/(  )/&nbsp; /g;
+	$text =~ s/\r?\n/<br>/g;
+	# avoid stuffing tables, lists with br's
+	$text =~ s/tr><br>/tr>/g;
+	$text =~ s/td><br>/td>/g;
+	$text =~ s/ul><br>/ul>/g;
+	$text =~ s/ol><br>/ol>/g;
+	return $text;
+	}
+
+sub tidy_urls
+	{
+	my ($line) = @_;
+	if ($line =~ /https?:\/\//)
+		{
+		my ($pre, $post) = split /http/, $line, 2;
+		my ($url, $space, $rest) = split /(\s)/, $post, 2;
+		# splitting on regex with parens produces
+		# a bonus secret list element -- whatever (it) matched
+		if (($url =~ /gif$/i || $url =~ /png$/i || $url =~ /jpg$/i) && ($pre !~ /<img/))
+			{
+			if ($url =~ /\.thumb/)
+				{
+				$line = qq($pre<a href="http$url" target="_blank"><img src="http$url" border="0" width="100%"></a>$space);
+				}
+			else
+				{
+				my $thumb_url = $url; # lc($url);
+				# $thumb_url =~ s/(data\/\d+\/)/$1.thumb\/b./;
+				$line = qq($pre<a href="http$url" target="_blank"><img src="http$thumb_url" border="0" width="100%"></a>$space);
+				}
+			}
+		else
+			{
+			my $curl = $url;
+			$curl =~ s!^s?://(www.)?!!i;
+			$curl =~ s!^([-A-Za-z0-9\.]+)/.*!$1!; # get domain-part of url
+			$line = qq($pre<a href="http$url" target="_blank">[$curl]</a>$space);
+			}
+		$line .= tidy_urls($rest);
+		}
+	return $line;
+	}
+
+sub nbsp
+	{ '&nbsp;' }
+sub middot
+	{ '&nbsp;&middot;&nbsp;' }
+
+sub profile_link
+    {
+    my ($username) = @_;
+    my $link =
+#        qq(<a href="$BUCKY/profile?username=$username">) .
+        qq(<a href="$BUCKY/profile/$username">) .
+        $username .
+    	qq(</a>);
+    return $link;
+    }
+sub message_link
+    {
+    my ($username) = @_;
+    my $link =
+#        qq(<a href="$BUCKY/message?username=$username">) .
+        qq(<a href="$BUCKY/message/$username">) .
+        $username .
+    	qq(</a>);
+    return $link;
+    }
+
+sub details_link
+	{
+	my ($t) = @_;
+    if ($t != -1 && $BUCKY_KEYWORD_IN_DETAILS_URL)
+        { return $t->{keyword}; }
+    else
+        { return $BUCKY_LEXICON_DETAILS; }
+	}
+
+sub get_revision
+	{
+	my ($thread) = @_;
+	return "" if ($thread->{revision} == 0);
+	my $rev = $thread->{revision};
+	my $number = 0;
+	my $digits = "";
+	my @letters = qw(z a b c d f g h j k l m n p q r s t v w x y);
+	do
+		{
+		$number = $rev % 21;
+		$rev = int($rev / 21);
+		$digits = $letters[$number].$digits;
+		}
+		while($rev != 0);
+	return $digits;
+	}
+
+sub get_age
+        {
+        my ($t) = @_;
+        my $age = abs( time - $t );
+        my $m;
+
+        use integer;
+
+		# now
+		if ($age < 5)
+			{ return "now"; }
+
+        # seconds
+        if ($age < 60)
+            { return sprintf ("%ds", $age); }
+
+        # minutes
+        $age /= 60;
+        if ($age < 60)
+            { return sprintf ("%dm", $age); }
+
+        # hours
+        $m = $age % 60;
+        $age /= 60;
+        if ((int($m) > 0) && ($age < 2))
+            { return sprintf ("%dh%dm", $age, $m); }
+        elsif ($age < 24)
+            { return sprintf ("%dh", $age); }
+
+        # days
+        $age /= 24;
+        if ($age < 7)
+            { return sprintf ("%dd", $age); }
+
+        # weeks
+        my $d = $age % 7;
+        $age /= 7;
+        if ($age < 12)
+            { return sprintf ("%dw", $age); }
+
+        # months
+        my $m = $age / 4;
+        my $w = $age % 4;
+        $age /= 4;
+        $age /= 12;
+        if ($m < 12)
+            {
+            return sprintf ("%dm", $m);
+            }
+
+		# years
+        return sprintf("%dy", $age);
+
+#        # hours
+#        $m = $age % 60;
+#        $age /= 60;
+#        if ((int($m) > 0) && ($age < 2))
+#            { return sprintf ("%dh%dm", $age, $m); }
+#        elsif ($age < 24)
+#            { return sprintf ("%dh", $age); }
+#
+#        # days
+#        $age /= 24;
+#        if ($age < 30)
+#            { return sprintf ("%dd", $age); }
+#
+#        # months
+#        my $m = $age / 30;
+#        if ($age < 365)
+#            { return sprintf ("%dmo", $m); }
+#
+#        # years
+#        $m = $age % 365;
+#        $m /= 30;
+#        $age /= 365;
+#        if ($m > 0)
+#          { return sprintf("%dy%dm", $age, $m); }
+#        else
+#          { return sprintf("%dy", $age); }
+        }
+
+1;
+