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