# Selima Website Content Management System
# Accounting.pm: The accounting subroutines.

#  Copyright (c) 2007-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: 2007-09-20

package Selima::Accounting;
use 5.008;
use strict;
use warnings;
use base qw(Exporter);
use vars qw(@EXPORT @EXPORT_OK);
BEGIN {
@EXPORT = qw();
push @EXPORT, qw(acctsubj_title acctsubj_code acctsubj_sn);
push @EXPORT, qw(acctsubj_recent_options accttrx_id accttrxid_compose);
push @EXPORT, qw(accttrx_maxord);
push @EXPORT, qw(ACCTSUBJ_CASH ACCTSUBJ_INCOME_ACUM ACCTSUBJ_INCOME_CUR);
@EXPORT_OK = @EXPORT;
# Prototype declaration
sub acctsubj_title($);
sub acctsubj_code($);
sub acctsubj_sn($);
sub acctsubj_recent_options($);
sub accttrx_id($);
sub accttrxid_compose($$);
sub accttrx_maxord(;$$);
}

use Selima::Cache qw(:account);
use Selima::ChkFunc;
use Selima::CommText;
use Selima::DataVars qw($DBH :l10n :lninfo);
use Selima::EchoForm;
use Selima::GetLang;
use Selima::LnInfo;

# Certain subjects
use constant ACCTSUBJ_CASH => 1111;         # 1111 庫存現金
use constant ACCTSUBJ_INCOME_ACUM => 3351;  # 3351 累積盈虧
use constant ACCTSUBJ_INCOME_CUR => 3353;   # 3353 本期損益

# acctsubj_title: Obtain an accounting subject title
sub acctsubj_title($) {
    local ($_, %_);
    my ($sn, $sql, $sth, $col);
    $sn = $_[0];
    # Bounce if there is any problem with $sn
    return t_notset if !defined $sn;
    # Return the cache
    return $Account_acctsubj_title{$sn} if exists $Account_acctsubj_title{$sn};
    
    # Check the serial number first
    return ($Account_acctsubj_title{$sn} = t_na)
        if !check_sn $sn;
    
    # Query
    # Unilingual
    if (@ALL_LINGUAS == 1) {
        $col = "acctsubj_codetitle($sn) AS title";
    # Multilingual
    } else {
        $_ = getlang;
        $col = "acctsubj_codetitle('$_', $sn) AS title";
    }
    $sql = "SELECT $col;\n";
    $sth = $DBH->prepare($sql);
    $sth->execute;
    
    # Not found
    return ($Account_acctsubj_title{$sn} = t_na)
        unless $sth->rows == 1;
    
    # Found
    return ($Account_acctsubj_title{$sn} = ${$sth->fetch}[0]);
}

# acctsubj_code: Obtain an accounting subject code
sub acctsubj_code($) {
    local ($_, %_);
    my ($sn, $sql, $sth, $col);
    $sn = $_[0];
    # Bounce if there is any problem with $sn
    return t_notset if !defined $sn;
    # Return the cache
    return $Account_acctsubj_code{$sn} if exists $Account_acctsubj_code{$sn};
    
    # Check the serial number first
    return ($Account_acctsubj_code{$sn} = t_na)
        if !check_sn $sn;
    
    # Query
    $sql = "SELECT code FROM acctsubj WHERE sn=$sn;\n";
    $sth = $DBH->prepare($sql);
    $sth->execute;
    
    # Not found
    return ($Account_acctsubj_code{$sn} = t_na)
        unless $sth->rows == 1;
    
    # Found
    return ($Account_acctsubj_code{$sn} = ${$sth->fetch}[0]);
}

# acctsubj_sn: Obtain an accounting subject S/N
sub acctsubj_sn($) {
    local ($_, %_);
    my ($code, $sql, $sth, $col);
    $code = $_[0];
    # Bounce if there is any problem with $code
    return t_notset if !defined $code;
    # Return the cache
    return $Account_acctsubj_sn{$code} if exists $Account_acctsubj_sn{$code};
    
    # Query
    $sql = "SELECT sn FROM acctsubj"
        . " WHERE code=" . $DBH->quote($code) . ";\n";
    $sth = $DBH->prepare($sql);
    $sth->execute;
    
    # Not found
    return ($Account_acctsubj_sn{$code} = t_na)
        unless $sth->rows == 1;
    
    # Found
    return ($Account_acctsubj_sn{$code} = ${$sth->fetch}[0]);
}

# acctsubj_recent_options: Obtain a recently-used accounting subject options list
sub acctsubj_recent_options($) {
    local ($_, %_);
    my ($value, $sql, $content);
    my ($sth, $count, $row, @opts, $hascur, $optlist);
    $value = $_[0];
    
    # Obtain the recently-used options
    # Unilingual
    if (@ALL_LINGUAS == 1) {
        $content = "acctsubj_codetitle(subj) AS content";
    # Multilingual
    } else {
        $_ = getlang;
        $content = "acctsubj_codetitle('$_', subj) AS content";
    }
    $sql = "SELECT subj AS value, $content FROM acctrecs"
        . " GROUP BY subj"
        . " ORDER BY acctsubj_recent(subj) DESC;\n";
    $sth = $DBH->prepare($sql);
    $sth->execute;
    $count = $sth->rows;
    for (my $i = 0, @opts = qw(), $hascur = 0; $i < $count; $i++) {
        $row = $sth->fetchrow_hashref;
        push @opts, {
            "value"     => $$row{"value"},
            "content"   => $$row{"content"},
        };
        $hascur = 1 if defined $value && $$row{"value"} eq $value;
    }
    undef $sth;
    
    # Prepend the currently selected option if available
    if (!$hascur && defined $value && check_sn $value) {
        # Unilingual
        if (@ALL_LINGUAS == 1) {
            $content = "acctsubj_codetitle($value) AS content";
        # Multilingual
        } else {
            $_ = getlang;
            $content = "acctsubj_codetitle('$_', $value) AS content";
        }
        $sql = "SELECT $content;\n";
        $sth = $DBH->prepare($sql);
        $sth->execute;
        if ($sth->rows > 0) {
            $row = $sth->fetchrow_hashref;
            @opts = ({
                    "value"     => $value,
                    "content"   => $$row{"content"},
                }, @opts);
        }
        undef $sth;
    }
    
    # Obtain the HTML
    $optlist = opt_list_array @opts;
    
    return preselect_options $optlist, $value;
}

# accttrx_id: Obtain the accounting transaction ID.
sub accttrx_id($) {
    local ($_, %_);
    my ($sn, $sql, $sth, $col, $row);
    $sn = $_[0];
    # Bounce if there is any problem with $sn
    return t_notset if !defined $sn;
    # Return the cache
    return $Account_accttrx_id{$sn} if exists $Account_accttrx_id{$sn};
    
    # Check the serial number first
    return ($Account_accttrx_id{$sn} = t_na)
        if !check_sn $sn;
    
    # Query
    $sql = "SELECT date, ord FROM accttrx WHERE sn=$sn;\n";
    $sth = $DBH->prepare($sql);
    $sth->execute;
    
    # Not found
    return ($Account_accttrx_id{$sn} = t_na)
        unless $sth->rows == 1;
    
    # Found
    $row = $sth->fetchrow_hashref;
    return ($Account_accttrx_id{$sn} = accttrxid_compose $$row{"date"}, $$row{"ord"});
}

# accttrxid_compose: Compose the accounting transaction ID
sub accttrxid_compose($$) {
    local ($_, %_);
    my ($date, $ord);
    ($date, $ord) = @_;
    # In timestamp
    if ($date =~ /^\d+$/) {
        @_ = localtime $date;
        $_[5] += 1900;
        $_[4]++;
        return sprintf "%04d%02d%02d%02d", @_[5,4,3], $ord;
    }
    # In ISO date YYYY-MM-DD format
    return sprintf "%04d%02d%02d%02d", $1, $2, $3, $ord
        if $date =~ /^(\d{4})-(\d{2})-(\d{2})$/;
    # Invalid date
    return undef;
}

# accttrx_maxord: Obtain the default accounting transaction order
sub accttrx_maxord(;$$) {
    local ($_, %_);
    my ($date, $sn, $sql, $sth, $row);
    ($date, $sn) = @_;
    $date = time if !defined $date;
    $sn = -1 if @_ < 2;
    # In timestamp
    if ($date =~ /^\d+$/) {
        @_ = localtime $date;
        $_[5] += 1900;
        $_[4]++;
        $date = sprintf "%04d-%02d-%02d", @_[5,4,3];
    # In ISO date YYYY-MM-DD format
    } elsif ($date =~ /^(\d{4})-(\d{2})-(\d{2})$/) {
    # Invalid date
    } else {
        return 99;
    }
    # Bounce if there is any problem with $sn
    return 99 if !defined $sn;
    # Return the cache
    $Account_accttrx_id{$date} = {} if !exists $Account_accttrx_id{$date};
    return ${$Account_accttrx_id{$date}}{$sn}
        if exists ${$Account_accttrx_id{$date}}{$sn};
    
    # Check the serial number first
    return (${$Account_accttrx_id{$date}}{$sn} = 99)
        if $sn != -1 && !check_sn $sn;
    
    # Query
    @_ = qw();
    push @_, "date=" . $DBH->quote($date);
    push @_, "sn!=$sn" if $sn != -1;
    $sql = "SELECT count(*) AS count FROM accttrx"
        . " WHERE " . join(" AND ", @_) . ";\n";
    $sth = $DBH->prepare($sql);
    $sth->execute;
    
    $row = $sth->fetchrow_hashref;
    return (${$Account_accttrx_id{$date}}{$sn} = $$row{"count"} + 1);
}

return 1;