# Selima Website Content Management System
# Reports.pm: The base accounting report.

#  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-24

package Selima::List::Accounting::Reports;
use 5.008;
use strict;
use warnings;
use base qw(Selima::List);

use Time::Local qw(timelocal);

use Selima::AddGet;
use Selima::CommText;
use Selima::ChkFunc;
use Selima::DataVars qw($DBH :input :requri);
use Selima::Format;
use Selima::LogIn;
use Selima::MarkAbbr;
use Selima::ShortCut;

# new: Initialize the handler
sub new : method {
    local ($_, %_);
    my ($self, $class, $sql, $sth);
    ($class, @_) = @_;
    $self = $class->SUPER::new(@_);
    # The page title
    $self->{"title"} = C_("View the Accounting Reports");
    # Known columns that should not be displayed (has a special purpose)
    push @{$self->{"COLS_NO_DISPLAY"}}, qw(_subj _date _trx);
    # Known columns that should not be sorted with
    # List sorting is disabled here at all
    push @{$self->{"COLS_NO_SORT_BY"}}, qw(date month trxno subj summary
        income expense debit credit balance note);
    # The list type
    $self->{"type"} = $self->{"FORM"}->param("list");
    # The date range
    $self->{"range"} = $self->{"FORM"}->param("r");
    # The onload event handler
    $self->{"onload"} = "acctRepQueryDisableNoUseRanges();";
    # Should we return the data as CSV
    $self->{"iscsv"} = 0;
    $self->{"iscsv"} = 1
        if defined($_ = $self->{"FORM"}->param("format")) && $_ eq "csv";
    # If the database is empty
    $sql = "SELECT sn FROM accttrx LIMIT 1;\n";
    $sth = $DBH->prepare($sql);
    $sth->execute;
    $self->{"nodata"} = ($sth->rows == 0);
    # The full period - used in all reports
    if (!$self->{"nodata"}) {
        # The earliest start date
        $sql = "SELECT date FROM accttrx ORDER BY date LIMIT 1;\n";
        $sth = $DBH->prepare($sql);
        $sth->execute;
        @_ = localtime ${$sth->fetchrow_hashref}{"date"};
        $self->{"startdate"} = sprintf "%04d-%02d-%02d",
            $_[5] + 1900, $_[4] + 1, $_[3];
        # The latest end date
        $sql = "SELECT date FROM accttrx ORDER BY date DESC LIMIT 1;\n";
        $sth = $DBH->prepare($sql);
        $sth->execute;
        @_ = localtime ${$sth->fetchrow_hashref}{"date"};
        $self->{"enddate"} = sprintf "%04d-%02d-%02d",
            $_[5] + 1900, $_[4] + 1, $_[3];
    }
    # Column labels
    $self->col_labels(
        "month"     => C_("Month"),
        "subj"      => C_("Accounting subject"),
        "summary"   => C_("Summary"),
        "debit"     => C_("Debit"),
        "credit"    => C_("Credit"),
        "income"    => C_("Income"),
        "expense"   => C_("Expense"),
        "balance"   => C_("Balance"),
    );
    return $self;
}

# fetch: Fetch the current list
sub fetch : method {
    return if !defined $_[0]->{"type"};
    # Run the parent method
    return $_[0]->SUPER::fetch;
}

# colval: Output a list column value
sub colval : method {
    local ($_, %_);
    my ($self, $col, %row);
    ($self, $col, %row) = @_;
    
    # Null/no value
    return h(t_notset()) if !defined $row{$col};
    
    # The debit and the credit
    if (    $col eq "debit" || $col eq "credit"
            || $col eq "income" || $col eq "expense") {
        return "" if $row{$col} == 0;
        return "<div class=\"amount\">"
            . h_abbr(fmtntamount $row{$col}) . "</div>";
    }
    
    # Run the parent method
    return $self->SUPER::colval($col, %row);
}

# pre_filter: Set the pre-defined filter
sub pre_filter : method {
    local ($_, %_);
    my ($self, $form, @conds, $year, $month, $day, $from, $to);
    my ($sql, $sth, $startdate);
    $self = $_[0];
    $form = $self->{"FORM"};
    
    # No need to run if there is no data at all
    return undef if $self->{"nodata"};
    
    @conds = qw();
    # The active range that is affecting this list
    $self->{"actrange"} = undef;
    # Range specified
    if (defined $self->{"range"}) {
        # By month
        if ($self->{"range"} eq "m") {
            # Trim the value
            if (defined($_ = $form->param("m"))) {
                s/^\s+//;
                s/\s+$//;
                $form->param("m", $_);
            }
            if (!defined $form->param("m") || $form->param("m") eq "") {
                $self->{"error"} = {"msg"=>N_("Please specify a month.")}
                     if !defined $self->{"error"};
            } elsif (   $form->param("m") !~ /^(\d{4})-(\d{2})$/
                        || !check_date($year = $1, $month = $2, 1)) {
                $self->{"error"} = {"msg"=>N_("Please specify a valid month in YYYY-MM format.")}
                     if !defined $self->{"error"};
            } else {
                $from = sprintf "%04d-%02d-%02d", $year, $month, 1;
                $self->{"startdate"} = $from
                    if ($self->{"startdate"} cmp $from) < 0;
                # The next month
                $month++;
                if ($month > 12) {
                    $year++;
                    $month = 1;
                }
                # The previous day before the first day of next month
                #  - The last day of this month
                $_ = timelocal(0, 0, 0, 1, $month - 1, $year - 1900);
                $_ -= 86400;
                @_ = localtime $_;
                $to = sprintf "%04d-%02d-%02d",
                    $_[5] + 1900, $_[4] + 1, $_[3];
                $self->{"enddate"} = $to
                    if ($self->{"enddate"} cmp $to) > 0;
                push @conds, "date>=" . $DBH->quote($self->{"startdate"});
                push @conds, "date<=" . $DBH->quote($self->{"enddate"});
                $self->{"actrange"} = "r=m&m=" . $form->param("m");
            }
        
        # By year
        } elsif ($self->{"range"} eq "y") {
            # Trim the value
            if (defined($_ = $form->param("y"))) {
                s/^\s+//;
                s/\s+$//;
                $form->param("y", $_);
            }
            if (!defined $form->param("y") || $form->param("y") eq "") {
                $self->{"error"} = {"msg"=>N_("Please specify a year.")}
                     if !defined $self->{"error"};
            } elsif (   ($_ = $form->param("y")) !~ /^\d{4}$/
                        || !check_date($_, 1, 1)) {
                $self->{"error"} = {"msg"=>N_("Please specify a valid year in YYYY format.")}
                     if !defined $self->{"error"};
            } else {
                $from = sprintf "%04d-%02d-%02d", $_, 1, 1;
                $self->{"startdate"} = $from
                    if ($self->{"startdate"} cmp $from) < 0;
                $to = sprintf "%04d-%02d-%02d", $_, 12, 31;
                $self->{"enddate"} = $to
                    if ($self->{"enddate"} cmp $to) > 0;
                push @conds, "date>=" . $DBH->quote($self->{"startdate"});
                push @conds, "date<=" . $DBH->quote($self->{"enddate"});
                $self->{"actrange"} = "r=y&y=" . $form->param("y");
            }
        
        # Specified reange
        } elsif ($self->{"range"} eq "s") {
            my @actrange;
            @actrange = qw();
            # Trim the value
            if (defined($_ = $form->param("f"))) {
                s/^\s+//;
                s/\s+$//;
                $form->param("f", $_);
            }
            if (defined($_ = $form->param("t"))) {
                s/^\s+//;
                s/\s+$//;
                $form->param("t", $_);
            }
            # The start day
            if (!defined $form->param("f") || $form->param("f") eq "") {
                $self->{"error"} = {"msg"=>N_("Please specify the start date.")}
                     if !defined $self->{"error"};
            } elsif (   $form->param("f") !~ /^(\d{4})-(\d{2})-(\d{2})$/
                        || !check_date($year = $1, $month = $2, $day =$3)) {
                $self->{"error"} = {"msg"=>N_("Please specify a valid start date in YYYY-MM-DD format.")}
                     if !defined $self->{"error"};
            } else {
                $from = sprintf "%04d-%02d-%02d", $year, $month, $day;
                $self->{"startdate"} = $from
                    if ($self->{"startdate"} cmp $from) < 0;
                push @conds, "date>=" . $DBH->quote($self->{"startdate"});
                push @actrange, "f=" . $form->param("f");
            }
            # The end day
            if (!defined $form->param("t") || $form->param("t") eq "") {
                $self->{"error"} = {"msg"=>N_("Please specify the end date.")};
            } elsif (   $form->param("t") !~ /^(\d{4})-(\d{2})-(\d{2})$/
                        || !check_date($year = $1, $month = $2, $day =$3)) {
                $self->{"error"} = {"msg"=>N_("Please specify a valid end date in YYYY-MM-DD format.")}
                     if !defined $self->{"error"};
            } else {
                $to = sprintf "%04d-%02d-%02d", $year, $month, $day;
                $self->{"enddate"} = $to
                    if ($self->{"enddate"} cmp $to) > 0;
                push @conds, "date<=" . $DBH->quote($self->{"enddate"});
                push @actrange, "t=" . $form->param("t");
            }
            if (@actrange > 0) {
                unshift @actrange, "r=s";
                $self->{"actrange"} = join "&", @actrange;
            }
        
        # All
        } elsif ($self->{"range"} eq "a") {
            # No condition is applied here
            $self->{"actrange"} = "r=a";
        
        # Else
        } else {
            $self->{"error"} = {"msg"=>N_("This option is invalid.  Please select a proper date range.")}
                if !defined $self->{"error"};
        }
    }
    # Range not set - default to the current month
    if (!defined $self->{"actrange"}) {
        ($year, $month) = (localtime)[5,4];
        $year += 1900;
        $month++;
        $from = sprintf "%04d-%02d-%02d", $year, $month, 1;
        $self->{"startdate"} = $from
            if ($self->{"startdate"} cmp $from) < 0;
        $self->{"actrange"} = "r=m&m=" . sprintf("%04d-%02d", $year, $month);
        $month++;
        if ($month > 12) {
            $year++;
            $month = 1;
        }
        # The previous day before the first day of next month
        #  - The last day of this month
        $_ = timelocal(0, 0, 0, 1, $month - 1, $year - 1900);
        $_ -= 86400;
        @_ = localtime $_;
        $to = sprintf "%04d-%02d-%02d",
            $_[5] + 1900, $_[4] + 1, $_[3];
        $self->{"enddate"} = $to
            if ($self->{"enddate"} cmp $to) > 0;
        push @conds, "date>=" . $DBH->quote($self->{"startdate"});
        push @conds, "date<=" . $DBH->quote($self->{"enddate"});
    }
    # Th end date should not be before the first date
    $self->{"enddate"} = $self->{"startdate"}
        if  exists $self->{"startdate"} && exists $self->{"enddate"}
            && ($self->{"startdate"} cmp $self->{"enddate"}) > 0;
    return undef if @conds == 0;
    return join " AND ", @conds;
}

# html: Output the list
sub html : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    # Fetch the current list if not fetched yet
    $self->fetch if !$self->{"fetched"};
    # Download the CSV
    return $self->html_csv if $self->{"iscsv"} && $self->can("html_csv");
    # Run the parent method
    return $self->SUPER::html;
}

# set_listpref: Set the list preference
sub set_listpref : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    $_ = new Selima::ListPref::AcctReps($self->{"FORM"});
    $_->main;
}

# html_newlink: Display a link to add a new item
sub html_newlink : method {
    local ($_, %_);
    my ($self, $urle, $urli, $urlt, $prompt);
    $self = $_[0];
    
    $urle = "accttrx.cgi?form=new&formsub=expense";
    $urli = "accttrx.cgi?form=new&formsub=income";
    $urlt = "accttrx.cgi?form=new&formsub=trans";
    $prompt = C_("<a href=\"[_1]\">Add a new cash expense transaction</a>, <a href=\"[_2]\">add a new cash income transaction</a> or <a href=\"[_3]\">add a new transfer transaction</a>.",
        h($urle), h($urli), h($urlt));
    
    print << "EOT";
<p>$prompt</p>

EOT
    return;
}

# html_lists_switch: Display the switch for different lists
sub html_lists_switch : method {
    local ($_, %_);
    my ($self, $labellist, @lists);
    $self = $_[0];
    
    # No need to run if there is no data at all
    return if $self->{"nodata"};
    
    # Switch for different lists
    $labellist = h_abbr(C_("Report type:"));
    @lists = qw();
    push @lists, {
            "type"  => "cash",
            "title" => C_("Cash book"),
        };
    push @lists, {
            "type"  => "cashsum",
            "title" => C_("Cash book summary"),
        };
    push @lists, {
            "type"  => "ldgr",
            "title" => C_("Ledger"),
        };
    push @lists, {
            "type"  => "ldgrsum",
            "title" => C_("Ledger summary"),
        };
    push @lists, {
            "type"  => "journal",
            "title" => C_("Journal"),
        };
    push @lists, {
            "type"  => "tb",
            "title" => C_("Trial balance"),
        };
    push @lists, {
            "type"  => "incmstat",
            "title" => C_("Income statement"),
        };
    push @lists, {
            "type"  => "blncshet",
            "title" => C_("Balance sheet"),
        };
    
    # Display the form
    print << "EOT";
<p>$labellist
EOT
    @_ = qw();
    foreach (@lists) {
        if (defined $self->{"type"} && $self->{"type"} eq $$_{"type"}) {
            push @_, h($$_{"title"});
        } else {
            push @_, sprintf("<a href=\"%s\">%s</a>",
                h($REQUEST_FILE . "?list=" . $$_{"type"}),
                h($$_{"title"}));
        }
    }
    print join(" |\n", @_) . "\n";
    print << "EOT";
</p>

EOT
    return;
}

# html_search: Display the search box
sub html_search : method {
    local ($_, %_);
    my ($self, $prompt, $label, $query, $request_file);
    ($self, $prompt) = @_;
    
    # No need to run if there is no data at all
    return if $self->{"nodata"};
    
    # Display the report query box
    $self->html_report_query;
    
    $prompt = C_("Search the accounting records:") if !defined $prompt;
    $prompt = h($prompt);
    $request_file = h($REQUEST_FILE);
    $query = defined $self->{"query"}? h($self->{"query"}): "";
    $label = h(C_("Search"));
    
    print << "EOT";
<form action="$request_file" method="get" accept-charset="<!--selima:charset-->">
<div class="searchbox">
<input type="hidden" name="list" value="search" />
<label for="query">$prompt</label>
<input id="query" type="text" name="query" value="$query" /><input
    type="hidden" name="charset" value="<!--selima:charset-->" /><input
    type="submit" value="$label" />
</div>
</form>

EOT
    return;
}

# html_report_query: Display the report query box
sub html_report_query : method {
    local ($_, %_);
    my ($self, $form, $request_file, $label, $curlist);
    my ($labelmonth, $labelyear, $labelspecified, $labelall);
    my ($labelfrom, $labelto, $labelrange);
    my ($valrm, $valry, $valrs, $valra);
    my ($valm, $valy, $valf, $valt);
    my ($sql, $sth, $count, $row);
    $self = $_[0];
    $form = $self->{"FORM"};
    
    $request_file = h($REQUEST_FILE);
    $label = h_abbr(C_("Query"));
    $labelrange = h_abbr(C_("Date range:"));
    $labelmonth = h_abbr(C_("By month:"));
    $labelyear = h_abbr(C_("By year:"));
    $labelspecified = h_abbr(C_("Specified date range:"));
    $labelall = h_abbr(C_("All"));
    $labelfrom = h_abbr(C_("From"));
    $labelto = h_abbr(C_("to"));
    
    # Whether each radio button is checked
    ($valrm, $valry, $valrs, $valra) = ("", "", "", "");
    if (defined $self->{"range"}) {
        $valrm = " checked=\"checked\""
            if $self->{"range"} eq "m";
        $valry = " checked=\"checked\""
            if $self->{"range"} eq "y";
        $valrs = " checked=\"checked\""
            if $self->{"range"} eq "s";
        $valra = " checked=\"checked\""
            if $self->{"range"} eq "a";
    # Default to this month
    } else {
        $valrm = " checked=\"checked\"";
    }
    # The value of each range
    @_ = localtime;
    $_[5] += 1900;
    $_[4]++;
    $valm = defined $form->param("m")? h($form->param("m")):
        sprintf("%04d-%02d", @_[5,4]);
    $valy = defined $form->param("y")? h($form->param("y")): $_[5];
    $valf = defined $form->param("f")? h($form->param("f")):
        sprintf("%04d-%02d-%02d", @_[5,4,3]);
    $valt = defined $form->param("t")? h($form->param("t")):
        sprintf("%04d-%02d-%02d", @_[5,4,3]);
    
    $curlist = h($self->{"type"});
    print << "EOT";
<form id="acctrepquery" action="$request_file" method="get" accept-charset="<!--selima:charset-->">
<div class="acctrepquery">
<div><input type="hidden" name="list" value="$curlist" /></div>

EOT
    # Display the subject selection if available
    $self->html_select_subject if $self->can("html_select_subject");
    
    print << "EOT";
<p>$labelrange
<input id="rangemonth" type="radio" name="r" value="m"$valrm onchange="acctRepQueryDisableNoUseRanges();" /><label
    for="rangemonth">$labelmonth</label><select
    name="m">
EOT
    $sql = "SELECT extract(year FROM date) AS year, extract(month FROM date) AS month FROM accttrx"
        . " GROUP BY extract(year FROM date), extract(month FROM date)"
        . " ORDER BY extract(year FROM date) DESC, extract(month FROM date) DESC;\n";
    $sth = $DBH->prepare($sql);
    $sth->execute;
    $count = $sth->rows;
    for (my $i = 0, @_ = qw(); $i < $count; $i++) {
        my ($val, $selected);
        $row = $sth->fetchrow_hashref;
        $_ = sprintf "%04d-%02d", $$row{"year"}, $$row{"month"};
        $val = h($_);
        $selected = $valm eq $_? " selected=\"selected\"": "";
        print << "EOT";
        <option value="$val"$selected>$_</option>
EOT
    }
    print << "EOT";
    </select>
<input id="rangeyear" type="radio" name="r" value="y"$valry onchange="acctRepQueryDisableNoUseRanges();" /><label
    for="rangeyear">$labelyear</label><select
    name="y">
EOT
    $sql = "SELECT extract(year FROM date) AS year FROM accttrx"
        . " GROUP BY extract(year FROM date)"
        . " ORDER BY extract(year FROM date) DESC;\n";
    $sth = $DBH->prepare($sql);
    $sth->execute;
    $count = $sth->rows;
    for (my $i = 0, @_ = qw(); $i < $count; $i++) {
        my ($val, $selected);
        $row = $sth->fetchrow_hashref;
        $_ = $$row{"year"};
        $val = h($_);
        $selected = $valy eq $_? " selected=\"selected\"": "";
    print << "EOT";
        <option value="$val"$selected>$_</option>
EOT
    }
    print << "EOT";
    </select>
<input id="rangespecified" type="radio" name="r" value="s"$valrs onchange="acctRepQueryDisableNoUseRanges();" /><label
    for="rangespecified">$labelspecified</label><label
    for="rangestart">$labelfrom</label><input
    id="rangestart" type="text" name="f" value="$valf" size="10" /><label
    for="rangeend">$labelto</label><input
    id="rangeend" type="text" name="t" value="$valt" size="10" />
<input id="rangeall" type="radio" name="r" value="a"$valra onchange="acctRepQueryDisableNoUseRanges();" /><label
    for="rangeall">$labelall</label>
</p>

<p><input type="hidden" name="charset" value="<!--selima:charset-->" /><input
    type="submit" value="$label" />
</p>
</div>
</form>

EOT
    return;
}

# html_liststat: Display the list statistics
sub html_liststat : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    # Print the current time period
    if (!$self->{"nodata"}) {
        my ($message, $from, $to);
        ($from, $to) = ($self->{"startdate"}, $self->{"enddate"});
        $message = h(C_("From [_1] to [_2].", $from, $to));
        
        print << "EOT";
<p>$message</p>

EOT
    }
    # Run the parent method
    return $self->SUPER::html_liststat;
}

# html_listprefform: Display a form to change the list preference
sub html_listprefform : method {
    local ($_, %_);
    my ($self, $submit, $referer, $request_file_h, $domain);
    my ($label, $pagesize);
    $self = $_[0];
    
    # Do not show the list
    return if !defined $self->{"total"};
    # No record to be listed
    return if $self->{"total"} == 0;
    # Return if users preferences are not available
    return if !use_users || !defined $SESSION;
    $submit = C_("Set");
    # The referer
    $referer = h(rem_get_arg $REQUEST_FULLURI, "statid");
    
    $request_file_h = h($REQUEST_FILE);
    # The domain -- my class name
    $domain = h(ref($self));
    
    print << "EOT";
<form action="$request_file_h" method="post" accept-charset="<!--selima:charset-->">
<div><input type="hidden" name="charset" value="<!--selima:charset-->" /><input
    type="hidden" name="form" value="listpref" /><input
    type="hidden" name="referer" value="$referer" /><input
    type="hidden" name="domain" value="$domain" />
EOT
    
    # The number of rows per page
    $label = h_abbr(C_("Rows per page:"));
    $pagesize = h($self->{"pagesize"});
    print << "EOT";
<label for="listsize">$label</label><input
    id="listsize" type="text" name="listsize" size="5" maxlength="5" value="$pagesize" />
EOT
    
    print << "EOT";
<input type="submit" name="confirm" value="$submit" /></div>
</form>

EOT
    
    return;
}

# liststat_message: Return the current list statistics message
sub liststat_message : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    
    # No record to list
    if ($self->{"total"} == 0) {
        # Inherit the empty list statistics message
        return $self->SUPER::liststat_message;
    # Fit in one page
    } elsif ($self->{"total"} <= $self->{"pagesize"}) {
        # Result comes from a query
        if (defined $self->{"query"}) {
            return C_("Your query found [*,_1,accounting record].", $self->{"total"});
        # List result
        } else {
            return C_("[*,_1,accounting record].", $self->{"total"});
        }
    # More than one page
    } else {
        # Result comes from a query
        if (defined $self->{"query"}) {
            return C_("Your query found [*,_1,accounting record], listing [#,_2] to [#,_3].",
                $self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
        # List result
        } else {
            return C_("[*,_1,accounting record], listing [#,_2] to [#,_3].",
                $self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
        }
    }
}

return 1;