Initial commit.

lib/perl5/Selima/Format.pm

@@ -0,0 +1,197 @@
+# Selima Website Content Management System
+# Format.pm: The data formatters.
+
+#  Copyright (c) 2003-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2003-03-23
+
+package Selima::Format;
+use 5.008;
+use utf8;
+use strict;
+use warnings;
+use base qw(Exporter);
+use vars qw(@EXPORT @EXPORT_OK);
+BEGIN {
+@EXPORT = qw();
+push @EXPORT, qw(fmtno fmtsize fmtdate fmttime rdtime);
+push @EXPORT, qw(myfmtdate myfmttime fmtntamount);
+@EXPORT_OK = @EXPORT;
+# Prototype declaration
+sub fmtno($);
+sub fmtsize($);
+sub fmtdate(;$);
+sub fmttime(;$);
+sub rdtime($);
+sub myfmtdate(;$);
+sub myfmttime(;$);
+sub fmtntamount($);
+}
+
+use Time::Local qw(timelocal);
+
+use Selima::ShortCut;
+
+# fmtno: Format the number
+sub fmtno($) {
+    local ($_, %_);
+    $_ = $_[0];
+    1 while s/^(\d+)(\d{3})/$1,$2/;
+    return $_;
+}
+
+# fmtsize: Format the size
+sub fmtsize($) {
+    local ($_, %_);
+    my ($report, $size, $kb, $mb, $gb, $tb, $digits, $rounded);
+    $size = $_[0];
+    # Get the size
+    $report = C_("[#,_1] bytes", $size);
+    
+    # Try to use KB as the unit
+    $kb = $size / 1024;
+    # Bounce if there are fewer than 3 digits in the rounded result
+    return $report if sprintf("%0.0f", $kb * 100) < 100;
+    # Check the rounded result for each digit
+    for ($_ = 2; $_ >= 0; $_--) {
+        $digits = 10 ** $_;
+        $rounded = sprintf "%0.0f", $kb * $digits;
+        # There are 3 significient digits in the rounded result
+        return sprintf "%s (%." . $_ . "f KB)", $report, $rounded / $digits
+            if $rounded < 1000;
+    }
+    
+    # Try to use MB as the unit
+    $mb = $kb / 1024;
+    # Check each digit
+    for ($_ = 2; $_ >= 0; $_--) {
+        $digits = 10 ** $_;
+        $rounded = sprintf "%0.0f", $mb * $digits;
+        # There are 3 significient digits in the rounded result
+        return sprintf "%s (%." . $_ . "f MB)", $report, $rounded / $digits
+            if $rounded < 1000;
+    }
+    
+    # Try to use GB as the unit
+    $gb = $mb / 1024;
+    # Check each digit
+    for ($_ = 2; $_ >= 0; $_--) {
+        $digits = 10 ** $_;
+        $rounded = sprintf "%0.0f", $gb * $digits;
+        # There are 3 significient digits in the rounded result
+        return sprintf "%s (%." . $_ . "f GB)", $report, $rounded / $digits
+            if $rounded < 1000;
+    }
+    
+    # Try to use TB as the unit
+    $tb = $gb / 1024;
+    # Check each digit
+    for ($_ = 2; $_ >= 0; $_--) {
+        $digits = 10 ** $_;
+        $rounded = sprintf "%0.0f", $tb * $digits;
+        # There are 3 significient digits in the rounded result
+        return sprintf "%s (%." . $_ . "f TB)", $report, $rounded / $digits
+            if $rounded < 1000;
+    }
+    
+    # More than TB
+    return sprintf "%s (%0.0f TB)", $report, fmtno $tb;
+}
+
+# fmtdate: Format the date with the standard ISO format YYYY-MM-DD
+sub fmtdate(;$) {
+    @_ = defined $_[0]? localtime $_[0]: localtime;
+    return sprintf "%04d-%02d-%02d",
+        $_[5]+1900, $_[4]+1, $_[3];
+}
+
+# fmttime: Format the time with the standard ISO format YYYY-MM-DD HH:MM:SS
+sub fmttime(;$) {
+    local ($_, %_);
+    if (defined $_[0]) {
+        $_ = $_[0];
+        @_ = localtime $_;
+        $_ = $_ - int $_;
+    } else {
+        @_ = localtime;
+        $_ = 0;
+    }
+    $_[5] += 1900;
+    $_[4]++;
+    return sprintf "%04d-%02d-%02d %02d:%02d:%02d", @_[5,4,3,2,1,0]
+        if $_ == 0;
+    return sprintf "%04d-%02d-%02d %02d:%02d:%02d.%06d",
+        @_[5,4,3,2,1,0], $_ * 1000000;
+}
+
+# rdtime: Read the time with the standard ISO format YYYY-MM-DD HH:MM:SS
+sub rdtime($) {
+    # Not in a correct format
+    return 0 if $_[0] !~ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})$/;
+    return timelocal($6, $5, $4, $3, $2-1, $1-1900);
+}
+
+# myfmtdate: Format the date with my personal format 
+sub myfmtdate(;$) {
+    local ($_, %_);
+    if (defined $_[0]) {
+        # TODO:
+        # Actually the timestamp column should be changed to
+        # timestamp with time zone.  But that requires a lot of
+        # changes, and I have no time for that now.
+        # imacat <imacat@mail.imacat.idv.tw> 2013-06-27
+        #@_ = localtime $_[0];
+        @_ = gmtime $_[0];
+    } else {
+        @_ = localtime;
+    }
+    $_[5] = ($_[5]+1900) % 100;
+    $_[4]++;
+    return sprintf "%d.%d.’%02d.", $_[4], $_[3], $_[5];
+}
+
+# myfmttime: Format the time with my personal format 
+sub myfmttime(;$) {
+    local ($_, %_);
+    if (defined $_[0]) {
+        # TODO:
+        # Actually the timestamp column should be changed to
+        # timestamp with time zone.  But that requires a lot of
+        # changes, and I have no time for that now.
+        # imacat <imacat@mail.imacat.idv.tw> 2013-06-27
+        #@_ = localtime $_[0];
+        @_ = gmtime $_[0];
+    } else {
+        @_ = localtime;
+    }
+    $_[5] = ($_[5]+1900) % 100;
+    $_[4]++;
+    $_[0] = ($_[2] < 12)? "am": "pm";
+    $_[2] = ($_[2] > 12)? $_[2]-12: $_[2];
+    return sprintf "%d.%d.’%02d. %d:%02d%s.",
+        $_[4], $_[3], $_[5], $_[2], $_[1], $_[0];
+}
+
+# fmtntamount: Format an amount of money in NTD format
+sub fmtntamount($) {
+    local ($_, %_);
+    $_ = $_[0];
+    1 while s/^(\d+)(\d{3})/$1,$2/;
+    return "NT\$ $_.00";
+}
+
+no utf8;
+return 1;