Initial commit.
This commit is contained in:
372
lib/perl5/Selima/List/Accounting/Reports/BlncShet.pm
Normal file
372
lib/perl5/Selima/List/Accounting/Reports/BlncShet.pm
Normal file
@@ -0,0 +1,372 @@
|
||||
# Selima Website Content Management System
|
||||
# BlncShet.pm: The balance sheet 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-10-03
|
||||
|
||||
package Selima::List::Accounting::Reports::BlncShet;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List::Accounting::Reports);
|
||||
|
||||
use Selima::Accounting;
|
||||
use Selima::CommText;
|
||||
use Selima::DataVars qw($DBH :l10n :lninfo :output :requri);
|
||||
use Selima::Format;
|
||||
use Selima::GetLang;
|
||||
use Selima::LnInfo;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = C_("Balance Sheet");
|
||||
# The list type
|
||||
$self->{"type"} = "blncshet";
|
||||
# The default number of rows per page
|
||||
$self->{"DEFAULT_LIST_SIZE"} = undef;
|
||||
# Known columns that should not be sorted with
|
||||
# List sorting is disabled here at all
|
||||
push @{$self->{"COLS_NO_SORT_BY"}}, qw(subjd amountd subjc amountc);
|
||||
$self->{"noselect"} = 1;
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"subjd" => C_("Assets accounting subject"),
|
||||
"amountd" => C_("Assets amount"),
|
||||
"subjc" => C_("Liabilities accounting subject"),
|
||||
"amountc" => C_("Liabilities amount"),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# fetch: Fetch the current list
|
||||
sub fetch : method {
|
||||
local ($_, %_);
|
||||
my ($self, @cols, $title, $sth, $sql, $error);
|
||||
my (@subjs, %recs, @debits, @credits, $sumdebit, $sumcredit);
|
||||
$self = $_[0];
|
||||
|
||||
# Fetched before
|
||||
return $self->{"error"} if $self->{"fetched"};
|
||||
$self->{"fetched"} = 1;
|
||||
|
||||
# Initialize the error status
|
||||
$self->{"error"} = undef;
|
||||
$self->{"total"} = undef;
|
||||
|
||||
# No need to run if there is no data at all
|
||||
if (exists $self->{"nodata"} && $self->{"nodata"}) {
|
||||
$self->{"total"} = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
# Construct the SQL query statement
|
||||
# Obtain the period once
|
||||
$self->sql_filter;
|
||||
@cols = qw();
|
||||
if (@ALL_LINGUAS == 1) {
|
||||
$title = "acctsubj.title";
|
||||
} else {
|
||||
my ($lndb, $lndbdef);
|
||||
$lndb = getlang LN_DATABASE;
|
||||
if (getlang eq $DEFAULT_LANG) {
|
||||
$title = "acctsubj.title_$lndb";
|
||||
} else {
|
||||
$lndbdef = ln $DEFAULT_LANG, LN_DATABASE;
|
||||
$title = "COALESCE(acctsubj.title_$lndb, acctsubj.title_$lndbdef)";
|
||||
}
|
||||
}
|
||||
push @cols, $DBH->strcat("acctsubj.code", "' '", $title) . " AS subj";
|
||||
push @cols, "sum(CASE WHEN acctrecs.credit THEN acctrecs.amount ELSE -acctrecs.amount END)"
|
||||
. " AS balance";
|
||||
$sql = "SELECT " . join(", ", @cols)
|
||||
. " FROM acctrecs"
|
||||
. " LEFT JOIN acctsubj ON acctrecs.subj=acctsubj.sn"
|
||||
. " LEFT JOIN accttrx ON acctrecs.trx=accttrx.sn"
|
||||
. " WHERE date<=" . $DBH->quote($self->{"enddate"})
|
||||
. " AND (acctsubj.code LIKE '1%'"
|
||||
. " OR acctsubj.code LIKE '2%'"
|
||||
. " OR acctsubj.code LIKE '3%')"
|
||||
. " GROUP BY acctsubj.code, $title"
|
||||
. " ORDER BY acctsubj.code;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
@subjs = qw();
|
||||
push @subjs, $_
|
||||
while defined($_ = $sth->fetchrow_hashref);
|
||||
undef $sth;
|
||||
@subjs = grep $$_{"balance"} != 0, @subjs;
|
||||
|
||||
# Obtain the carry-over record of assets/liabilities
|
||||
$_ = "sum(CASE WHEN acctrecs.credit THEN -acctrecs.amount ELSE acctrecs.amount END)"
|
||||
. " AS balance";
|
||||
$sql = "SELECT $_ FROM acctrecs"
|
||||
. " LEFT JOIN acctsubj ON acctrecs.subj=acctsubj.sn"
|
||||
. " LEFT JOIN accttrx ON acctrecs.trx=accttrx.sn"
|
||||
. " WHERE (acctsubj.code LIKE '1%'"
|
||||
. " OR acctsubj.code LIKE '2%'"
|
||||
. " OR acctsubj.code LIKE '3%')"
|
||||
. " AND accttrx.date<" . $DBH->quote($self->{"startdate"}) . ";\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$_ = $sth->fetchrow_hashref;
|
||||
undef $sth;
|
||||
push @subjs, {
|
||||
"subj" => acctsubj_title(acctsubj_sn(ACCTSUBJ_INCOME_ACUM)),
|
||||
"balance" => $$_{"balance"},
|
||||
} if defined $$_{"balance"};
|
||||
|
||||
# Obtain the net income or loss for current period
|
||||
$self->sql_filter;
|
||||
$_ = "sum(CASE WHEN acctrecs.credit THEN acctrecs.amount ELSE -acctrecs.amount END)"
|
||||
. " AS balance";
|
||||
$sql = "SELECT $_ FROM acctrecs"
|
||||
. " LEFT JOIN acctsubj ON acctrecs.subj=acctsubj.sn"
|
||||
. " LEFT JOIN accttrx ON acctrecs.trx=accttrx.sn"
|
||||
. " WHERE date>=" . $DBH->quote($self->{"startdate"})
|
||||
. " AND date<=" . $DBH->quote($self->{"enddate"})
|
||||
. " AND NOT (acctsubj.code LIKE '1%'"
|
||||
. " OR acctsubj.code LIKE '2%'"
|
||||
. " OR acctsubj.code LIKE '3%');\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$_ = $sth->fetchrow_hashref;
|
||||
undef $sth;
|
||||
push @subjs, {
|
||||
"subj" => acctsubj_title(acctsubj_sn(ACCTSUBJ_INCOME_CUR)),
|
||||
"balance" => $$_{"balance"},
|
||||
} if defined $$_{"balance"};
|
||||
|
||||
# Add each major category
|
||||
%recs = qw();
|
||||
($sumdebit, $sumcredit) = (0, 0);
|
||||
foreach my $majsubj ((1, 2, 3)) {
|
||||
my $sum;
|
||||
$recs{$majsubj} = [];
|
||||
push @{$recs{$majsubj}}, {
|
||||
"subj" => acctsubj_title(acctsubj_sn($majsubj)),
|
||||
"amount" => "",
|
||||
};
|
||||
$sum = 0;
|
||||
%_ = map { substr($$_{"subj"}, 0, 2) => 1 }
|
||||
grep $$_{"subj"} =~ /^$majsubj/, @subjs;
|
||||
foreach my $minsubj (sort keys %_) {
|
||||
push @{$recs{$majsubj}}, {
|
||||
"subj" => acctsubj_title(acctsubj_sn($minsubj)),
|
||||
"amount" => "",
|
||||
} if $minsubj !~ /^(?:12|15|22)$/;
|
||||
foreach (sort { $$a{"subj"} cmp $$b{"subj"} } grep $$_{"subj"} =~ /^$minsubj/, @subjs) {
|
||||
push @{$recs{$majsubj}}, {
|
||||
"subj" => $$_{"subj"},
|
||||
"amount" => $$_{"balance"},
|
||||
};
|
||||
$sum += $$_{"balance"};
|
||||
}
|
||||
}
|
||||
push @{$recs{$majsubj}}, {
|
||||
"subj" => C_("Total"),
|
||||
"amount" => $sum,
|
||||
};
|
||||
if ($majsubj == 1) {
|
||||
$sumdebit += $sum;
|
||||
} else {
|
||||
$sumcredit += $sum;
|
||||
}
|
||||
}
|
||||
@debits = @{$recs{1}};
|
||||
@credits = (@{$recs{2}}, { "subj" => "", "amount" => "" }, @{$recs{3}});
|
||||
|
||||
# Supply blank records
|
||||
while (@debits != @credits) {
|
||||
if (@debits < @credits) {
|
||||
push @debits, { "subj" => "", "amount" => "" };
|
||||
} else {
|
||||
push @credits, { "subj" => "", "amount" => "" };
|
||||
}
|
||||
}
|
||||
|
||||
# Supply the total record
|
||||
push @debits, {
|
||||
"subj" => C_("Total"),
|
||||
"amount" => $sumdebit,
|
||||
};
|
||||
push @credits, {
|
||||
"subj" => C_("Total"),
|
||||
"amount" => $sumcredit,
|
||||
};
|
||||
|
||||
# Invert the amount of the debit records
|
||||
foreach (@debits) {
|
||||
$$_{"amount"} *= -1 if $$_{"amount"} ne "";
|
||||
}
|
||||
|
||||
# Join the debit and credit records into the balance sheet
|
||||
$self->{"current"} = [];
|
||||
for ($_ = 0; $_ < @debits; $_++) {
|
||||
push @{$self->{"current"}}, {
|
||||
"subjd" => ${$debits[$_]}{"subj"},
|
||||
"amountd" => ${$debits[$_]}{"amount"},
|
||||
"subjc" => ${$credits[$_]}{"subj"},
|
||||
"amountc" => ${$credits[$_]}{"amount"},
|
||||
};
|
||||
}
|
||||
|
||||
# The number of rows per page
|
||||
$self->{"pagesize"} = $self->{"DEFAULT_LIST_SIZE"};
|
||||
# Paging not in use
|
||||
$self->{"total"} = scalar(@{$self->{"current"}});
|
||||
$self->{"lastpage"} = 1;
|
||||
$self->{"startno"} = 0;
|
||||
$self->{"endno"} = $self->{"total"} - 1;
|
||||
# If endno is -1 (when total is 0), set to 0
|
||||
$self->{"endno"} = 0 if $self->{"endno"} < 0;
|
||||
|
||||
# Set the columns to be displayed
|
||||
$self->{"cols"} = [qw(subjd amountd subjc amountc)];
|
||||
$self->{"listcols"} = [qw(subjd amountd subjc amountc)];
|
||||
|
||||
# Done
|
||||
return $self->{"error"};
|
||||
}
|
||||
|
||||
# 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 "subjd" || $col eq "subjc") {
|
||||
if ($row{$col} =~ /^\d\d /) {
|
||||
return "<div class=\"subjlv2\">"
|
||||
. h_abbr($row{$col}) . "</div>";
|
||||
} elsif ($row{$col} =~ /^\d\d\d/) {
|
||||
return "<div class=\"subjlastlv\">"
|
||||
. h_abbr($row{$col}) . "</div>";
|
||||
} else {
|
||||
return h_abbr($row{$col});
|
||||
}
|
||||
}
|
||||
|
||||
# The amount
|
||||
if ($col eq "amountd" || $col eq "amountc") {
|
||||
return "" if $row{$col} eq "";
|
||||
if ($row{$col} < 0) {
|
||||
return "<div class=\"amount\"><span class=\"neg\">("
|
||||
. h_abbr(fmtntamount -$row{$col}) . ")</span></div>";
|
||||
} else {
|
||||
return "<div class=\"amount\">"
|
||||
. h_abbr(fmtntamount $row{$col}) . "</div>";
|
||||
}
|
||||
}
|
||||
|
||||
# Run the parent method
|
||||
return $self->SUPER::colval($col, %row);
|
||||
}
|
||||
|
||||
# html_data_download: Display the data download link
|
||||
sub html_data_download : method {
|
||||
local ($_, %_);
|
||||
my ($self, $url, $title);
|
||||
$self = $_[0];
|
||||
# No data
|
||||
return if $self->{"total"} == 0;
|
||||
# Construct the URL
|
||||
@_ = qw();
|
||||
push @_, "list=blncshet";
|
||||
push @_, $self->{"actrange"};
|
||||
push @_, "format=csv";
|
||||
$url = $REQUEST_FILE . "?" . join "&", @_;
|
||||
$title = h_abbr(C_("Download the data as a CSV file."));
|
||||
print << "EOT";
|
||||
<p><a href="$url">$title</a></p>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_csv: Return the data as CSV
|
||||
sub html_csv : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Output a header to suggest for download instead of display
|
||||
$HTTP_HEADERS{"Content-Disposition"} =
|
||||
"attachment; filename=balance_sheet.csv";
|
||||
$CONTENT_TYPE = "text/csv; charset=" . getlang LN_CHARSET;
|
||||
# The header column
|
||||
@_ = map((exists ${$self->{"col_labels"}}{$_}? ${$self->{"col_labels"}}{$_}: $_),
|
||||
@{$self->{"listcols"}});
|
||||
s/"/""/g foreach @_; # "
|
||||
print join(",", map "\"$_\"", @_) . "\n";
|
||||
# The data
|
||||
foreach my $current (@{$self->{"current"}}) {
|
||||
@_ = map $$current{$_}, @{$self->{"listcols"}};
|
||||
foreach (@_) {
|
||||
$_ = "" if !defined $_;
|
||||
s/"/""/g; # "
|
||||
}
|
||||
print join(",", map "\"$_\"", @_) . "\n";
|
||||
}
|
||||
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
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# html_listprefform: Display a form to change the list preference
|
||||
# Make it a null function
|
||||
sub html_listprefform : method {}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my ($self, $total);
|
||||
$self = $_[0];
|
||||
|
||||
$total = $self->{"total"};
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message if $self->{"total"} == 0;
|
||||
return C_("[*,_1,accounting subject].", $self->{"total"} - 1);
|
||||
}
|
||||
|
||||
return 1;
|
||||
440
lib/perl5/Selima/List/Accounting/Reports/Cash.pm
Normal file
440
lib/perl5/Selima/List/Accounting/Reports/Cash.pm
Normal file
@@ -0,0 +1,440 @@
|
||||
# Selima Website Content Management System
|
||||
# Cash.pm: The cash 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::Cash;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List::Accounting::Reports);
|
||||
|
||||
use POSIX qw(floor);
|
||||
use Text::Capitalize qw(capitalize_title);
|
||||
use URI::Escape qw(uri_escape);
|
||||
|
||||
use Selima::Accounting;
|
||||
use Selima::CommText;
|
||||
use Selima::DataVars qw($DBH :l10n :lninfo :output :requri);
|
||||
use Selima::Format;
|
||||
use Selima::GetLang;
|
||||
use Selima::LnInfo;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
use Selima::UserPref;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The list type
|
||||
$self->{"type"} = "cash";
|
||||
if (@ALL_LINGUAS == 1) {
|
||||
$self->{"view"} = "acctrep_cash_list";
|
||||
} else {
|
||||
$self->{"view"} = "acctrep_cash_list_" . getlang(LN_DATABASE);
|
||||
}
|
||||
# The subject
|
||||
$self->{"subj"} = $self->{"FORM"}->param("subj");
|
||||
$self->{"subj"} = "" if !defined $self->{"subj"};
|
||||
# The page title
|
||||
$_ = $self->{"subj"} eq ""?
|
||||
C_("current assets and liabilities"):
|
||||
acctsubj_title(acctsubj_sn($self->{"subj"}));
|
||||
s/^\d+ //;
|
||||
$self->{"title"} = capitalize_title(C_("Cash book - [_1]", $_));
|
||||
$self->{"title"} =~ s/ - /\x{2014}/;
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# fetch: Fetch the current list
|
||||
sub fetch : method {
|
||||
local ($_, %_);
|
||||
my ($self, $cols, $table, $where, $orderby, $limit, $sth, $sql, $error);
|
||||
my ($balance, $brought, $sumincome, $sumexpense);
|
||||
$self = $_[0];
|
||||
|
||||
# Fetched before
|
||||
return $self->{"error"} if $self->{"fetched"};
|
||||
$self->{"fetched"} = 1;
|
||||
|
||||
# Initialize the error status
|
||||
$self->{"error"} = undef;
|
||||
$self->{"total"} = undef;
|
||||
|
||||
# No need to run if there is no data at all
|
||||
if ($self->{"nodata"}) {
|
||||
$self->{"total"} = 0;
|
||||
return $self->{"error"};
|
||||
}
|
||||
|
||||
# See if we need to use views or not.
|
||||
# Views make things much faster and easier, but some DBMS has no views.
|
||||
# *MySQL has no views*
|
||||
if ($self->{"useview"}) {
|
||||
($cols, $table, $where, $orderby, $limit) = $self->select_with_view;
|
||||
} else {
|
||||
($cols, $table, $where, $orderby, $limit) = $self->select_without_view;
|
||||
}
|
||||
|
||||
# Find the balance before our date range
|
||||
$_ = "sum(CASE WHEN acctrecs.credit THEN -amount ELSE amount END) AS sum";
|
||||
if ($self->{"subj"} eq "") {
|
||||
$sql = "SELECT $_ FROM acctrecs"
|
||||
. " LEFT JOIN acctsubj ON acctrecs.subj=acctsubj.sn"
|
||||
. " LEFT JOIN accttrx ON acctrecs.trx=accttrx.sn"
|
||||
. " WHERE (acctsubj.code LIKE '11%'"
|
||||
. " OR acctsubj.code LIKE '12%'"
|
||||
. " OR acctsubj.code LIKE '21%'"
|
||||
. " OR acctsubj.code LIKE '22%')"
|
||||
. " AND accttrx.date<" . $DBH->quote($self->{"startdate"}) . ";\n";
|
||||
} else {
|
||||
$sql = "SELECT $_ FROM acctrecs"
|
||||
. " LEFT JOIN acctsubj ON acctrecs.subj=acctsubj.sn"
|
||||
. " LEFT JOIN accttrx ON acctrecs.trx=accttrx.sn"
|
||||
. " WHERE acctsubj.code LIKE '" . $self->{"subj"} . "%'"
|
||||
. " AND accttrx.date<" . $DBH->quote($self->{"startdate"}) . ";\n";
|
||||
}
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$balance = ${$sth->fetch}[0];
|
||||
|
||||
# Fetch everything
|
||||
$self->{"select"} = sprintf "SELECT %s FROM %s%s%s%s;\n",
|
||||
$cols, $table, $where, $orderby, $limit;
|
||||
$sql = $self->{"select"};
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
|
||||
$self->{"current"} = [];
|
||||
push @{$self->{"current"}}, $_
|
||||
while defined($_ = $sth->fetchrow_hashref);
|
||||
undef $sth;
|
||||
|
||||
# Brought-forward record
|
||||
undef $brought;
|
||||
$brought = {
|
||||
"_sel" => 0,
|
||||
"_selurl" => undef,
|
||||
"date" => $self->{"startdate"},
|
||||
"subj" => acctsubj_title(acctsubj_sn(ACCTSUBJ_INCOME_ACUM)),
|
||||
"summary" => undef,
|
||||
"income" => $balance > 0? $balance: 0,
|
||||
"expense" => $balance < 0? -$balance: 0,
|
||||
"balance" => $balance,
|
||||
} if defined $balance;
|
||||
# Do calculation on each record
|
||||
$balance = 0 if !defined $balance;
|
||||
($sumincome, $sumexpense) = (0, 0);
|
||||
for (my $i = 0; $i < @{$self->{"current"}}; $i++) {
|
||||
$_ = ${$self->{"current"}}[$i];
|
||||
$balance = $balance + $$_{"income"} - $$_{"expense"};
|
||||
$sumincome += $$_{"income"};
|
||||
$sumexpense += $$_{"expense"};
|
||||
$$_{"balance"} = $balance;
|
||||
}
|
||||
# Prepend the brought-forward record
|
||||
unshift @{$self->{"current"}}, $brought if defined $brought;
|
||||
# Append the total record
|
||||
push @{$self->{"current"}}, {
|
||||
"_sel" => 0,
|
||||
"_selurl" => undef,
|
||||
"date" => $self->{"enddate"},
|
||||
"subj" => $self->{"subj"} eq ""?
|
||||
C_("current assets and liabilities"):
|
||||
acctsubj_title(acctsubj_sn($self->{"subj"})),
|
||||
"summary" => C_("Total"),
|
||||
"income" => $sumincome,
|
||||
"expense" => $sumexpense,
|
||||
"balance" => $balance,
|
||||
};
|
||||
|
||||
# The number of rows per page
|
||||
$_ = userpref("listsize", ref $self);
|
||||
$self->{"pagesize"} = defined $_? $_: $self->{"DEFAULT_LIST_SIZE"};
|
||||
# Paging not in use
|
||||
if (!defined $self->{"pagesize"}) {
|
||||
$self->{"total"} = scalar(@{$self->{"current"}});
|
||||
$self->{"lastpage"} = 1;
|
||||
$self->{"startno"} = 0;
|
||||
$self->{"endno"} = $self->{"total"} - 1;
|
||||
# If endno is -1 (when total is 0), set to 0
|
||||
$self->{"endno"} = 0 if $self->{"endno"} < 0;
|
||||
|
||||
# Done
|
||||
return $self->{"error"};
|
||||
}
|
||||
|
||||
# Obtain the total number
|
||||
$self->{"total"} = scalar @{$self->{"current"}};
|
||||
$self->{"lastpage"} = floor(($self->{"total"} - 1) / $self->{"pagesize"}) + 1;
|
||||
# If last page is 0 (when total is 0), set to page 1
|
||||
$self->{"lastpage"} = 1 if $self->{"lastpage"} < 1;
|
||||
|
||||
# Check the page number
|
||||
# Show the last page by default, but not reverse the number colume
|
||||
$_ = $self->{"reverse"};
|
||||
$self->{"reverse"} = 1;
|
||||
$error = $self->check_pageno;
|
||||
$self->{"reverse"} = $_;
|
||||
$self->{"error"} = $error if defined $error && !defined $self->{"error"};
|
||||
|
||||
# Calculate the start and end record number
|
||||
$self->{"startno"} = ($self->{"pageno"} - 1) * $self->{"pagesize"};
|
||||
$self->{"endno"} = $self->{"pageno"} * $self->{"pagesize"} - 1;
|
||||
# If there is not enough remaining records, set to the last one
|
||||
$self->{"endno"} = $self->{"total"} - 1
|
||||
if $self->{"endno"} > $self->{"total"} - 1;
|
||||
# If the last record is -1 (when total is 0), set to 0
|
||||
$self->{"endno"} = 0 if $self->{"endno"} < 0;
|
||||
|
||||
# Obtain everything in this page
|
||||
$self->{"current"} = [ @{$self->{"current"}}[$self->{"startno"}...$self->{"endno"}] ]
|
||||
if !$self->{"iscsv"};
|
||||
|
||||
# Set the columns to be displayed
|
||||
$self->{"listcols"} = [qw(date subj summary income expense balance)];
|
||||
# Done
|
||||
return $self->{"error"};
|
||||
}
|
||||
|
||||
# page_param: Obtain page parameters
|
||||
sub page_param : method {
|
||||
local ($_, %_);
|
||||
my ($self, $rev, $r);
|
||||
$self = $_[0];
|
||||
$rev = $self->{"reverse"};
|
||||
$self->{"reverse"} = 1;
|
||||
# Run the parent method
|
||||
$r = $self->SUPER::page_param;
|
||||
$self->{"reverse"} = $rev;
|
||||
return $r;
|
||||
}
|
||||
|
||||
# colval: Output a list column value
|
||||
sub colval : method {
|
||||
local ($_, %_);
|
||||
my ($self, $col, %row);
|
||||
($self, $col, %row) = @_;
|
||||
|
||||
# Display nothing instead of "not set" for empty summaries
|
||||
return "" if $col =~ /^(?:date|summary)$/ && !defined $row{$col};
|
||||
|
||||
# Null/no value
|
||||
return h(t_notset()) if !defined $row{$col};
|
||||
|
||||
# The balance
|
||||
if ($col eq "balance") {
|
||||
return "" if $row{$col} eq "";
|
||||
if ($row{$col} > 0) {
|
||||
return "<div class=\"amount\">"
|
||||
. h_abbr(fmtntamount $row{$col}) . "</div>";
|
||||
} elsif ($row{$col} < 0) {
|
||||
return "<div class=\"amount\"><span class=\"neg\">-"
|
||||
. h_abbr(fmtntamount -$row{$col}) . "</span></div>";
|
||||
} else {
|
||||
return "<div class=\"amount\">-</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, @conds);
|
||||
$self = $_[0];
|
||||
@conds = qw();
|
||||
if ($self->{"subj"} eq "") {
|
||||
push @conds, "_subj NOT LIKE '11%'";
|
||||
push @conds, "_subj NOT LIKE '12%'";
|
||||
push @conds, "_subj NOT LIKE '21%'";
|
||||
push @conds, "_subj NOT LIKE '22%'";
|
||||
@_ = qw();
|
||||
push @_, "accttrx_has_subj(_trx, '11')";
|
||||
push @_, "accttrx_has_subj(_trx, '12')";
|
||||
push @_, "accttrx_has_subj(_trx, '21')";
|
||||
push @_, "accttrx_has_subj(_trx, '22')";
|
||||
push @conds, "(" . join(" OR ", @_) . ")";
|
||||
} else {
|
||||
push @conds, "_subj NOT LIKE '" . $self->{"subj"} . "%'";
|
||||
push @conds, "accttrx_has_subj(_trx, '" . $self->{"subj"} . "')";
|
||||
}
|
||||
push @conds, $_ if defined($_ = $self->SUPER::pre_filter);
|
||||
return undef if @conds == 0;
|
||||
return join " AND ", @conds;
|
||||
}
|
||||
|
||||
# html_select_subject: Display the subject search box
|
||||
sub html_select_subject : method {
|
||||
local ($_, %_);
|
||||
my ($self, $label, @subjs);
|
||||
my ($sql, $sth, $count, $row, $thiscol, $defcol);
|
||||
$self = $_[0];
|
||||
|
||||
# The subject
|
||||
$label = h_abbr(C_("Accounting subject:"));
|
||||
# Obtain all the cash subjects
|
||||
$sql = "SELECT acctsubj.code FROM acctrecs"
|
||||
. " LEFT JOIN acctsubj ON acctrecs.subj=acctsubj.sn"
|
||||
. " WHERE acctsubj.code LIKE '11%'"
|
||||
. " OR acctsubj.code LIKE '12%'"
|
||||
. " OR acctsubj.code LIKE '21%'"
|
||||
. " OR acctsubj.code LIKE '22%'"
|
||||
. " GROUP BY acctsubj.code;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$count = $sth->rows;
|
||||
for (my $i = 0, @_ = qw(); $i < $count; $i++) {
|
||||
$row = $sth->fetchrow_hashref;
|
||||
push @_, $$row{"code"};
|
||||
}
|
||||
undef $sth;
|
||||
%_ = map { $_ => 1 } @_;
|
||||
# Add all of their parents
|
||||
foreach (keys %_) {
|
||||
$_{$_} = 1 while s/.$//;
|
||||
}
|
||||
delete $_{""};
|
||||
delete $_{"1"};
|
||||
delete $_{"11"};
|
||||
delete $_{"12"};
|
||||
delete $_{"2"};
|
||||
delete $_{"21"};
|
||||
delete $_{"22"};
|
||||
@_ = qw();
|
||||
push @_, "code AS value";
|
||||
if (@ALL_LINGUAS == 1) {
|
||||
push @_, $DBH->strcat("code", "' '", "title")
|
||||
. " AS content";
|
||||
} else {
|
||||
$thiscol = "title_" . getlang LN_DATABASE;
|
||||
if (getlang eq $DEFAULT_LANG) {
|
||||
push @_, $DBH->strcat("code", "' '", $thiscol)
|
||||
. " AS content";
|
||||
} else {
|
||||
$defcol = "title_" . ln($DEFAULT_LANG, LN_DATABASE);
|
||||
push @_, $DBH->strcat("code", "' '", "COALESCE($thiscol, $defcol)")
|
||||
. " AS content";
|
||||
}
|
||||
}
|
||||
$sql = "SELECT " . join(", ", @_) . " FROM acctsubj"
|
||||
. " WHERE " . join(" OR ", map "code=" . $DBH->quote($_), sort keys %_)
|
||||
. " ORDER BY code;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$count = $sth->rows;
|
||||
for (my $i = 0, @subjs = qw(); $i < $count; $i++) {
|
||||
push @subjs, {%{$sth->fetchrow_hashref}};
|
||||
}
|
||||
undef $sth;
|
||||
unshift @subjs, { "value" => "", "content" => C_("current assets and liabilities"), };
|
||||
|
||||
# Display the form
|
||||
print << "EOT";
|
||||
<p>$label
|
||||
<select name="subj">
|
||||
EOT
|
||||
foreach (@subjs) {
|
||||
my ($val, $content, $selected);
|
||||
$val = h($$_{"value"});
|
||||
$content = h($$_{"content"});
|
||||
$selected = defined $self->{"subj"} && $self->{"subj"} eq $$_{"value"}?
|
||||
" selected=\"selected\"": "";
|
||||
print << "EOT";
|
||||
<option value="$val"$selected>$content</option>
|
||||
EOT
|
||||
}
|
||||
print << "EOT";
|
||||
</select>
|
||||
</p>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_data_download: Display the data download link
|
||||
sub html_data_download : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $url, $title);
|
||||
$self = $_[0];
|
||||
$form = $self->{"FORM"};
|
||||
# No data
|
||||
return if $self->{"total"} == 0;
|
||||
# Construct the URL
|
||||
@_ = qw();
|
||||
push @_, "list=cash";
|
||||
push @_, "subj=" . uri_escape($self->{"subj"});
|
||||
push @_, $self->{"actrange"};
|
||||
push @_, "format=csv";
|
||||
$url = $REQUEST_FILE . "?" . join "&", @_;
|
||||
$title = h_abbr(C_("Download the data as a CSV file."));
|
||||
print << "EOT";
|
||||
<p><a href="$url">$title</a></p>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_csv: Return the data as CSV
|
||||
sub html_csv : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Output a header to suggest for download instead of display
|
||||
$HTTP_HEADERS{"Content-Disposition"} =
|
||||
"attachment; filename=cash_details.csv";
|
||||
$CONTENT_TYPE = "text/csv; charset=" . getlang LN_CHARSET;
|
||||
# The header column
|
||||
@_ = map((exists ${$self->{"col_labels"}}{$_}? ${$self->{"col_labels"}}{$_}: $_),
|
||||
@{$self->{"listcols"}});
|
||||
s/"/""/g foreach @_; # "
|
||||
print join(",", map "\"$_\"", @_) . "\n";
|
||||
# The data
|
||||
foreach my $current (@{$self->{"current"}}) {
|
||||
@_ = map $$current{$_}, @{$self->{"listcols"}};
|
||||
foreach (@_) {
|
||||
$_ = "" if !defined $_;
|
||||
s/"/""/g; # "
|
||||
}
|
||||
print join(",", map "\"$_\"", @_) . "\n";
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# html_pagebar: Display a page navigation bar
|
||||
sub html_pagebar : method {
|
||||
local ($_, %_);
|
||||
my ($self, $rev, $r);
|
||||
$self = $_[0];
|
||||
$rev = $self->{"reverse"};
|
||||
$self->{"reverse"} = 1;
|
||||
# Run the parent method
|
||||
$r = $self->SUPER::html_pagebar;
|
||||
$self->{"reverse"} = $rev;
|
||||
return $r;
|
||||
}
|
||||
|
||||
return 1;
|
||||
477
lib/perl5/Selima/List/Accounting/Reports/Cash/Summary.pm
Normal file
477
lib/perl5/Selima/List/Accounting/Reports/Cash/Summary.pm
Normal file
@@ -0,0 +1,477 @@
|
||||
# Selima Website Content Management System
|
||||
# Summary.pm: The cash summary 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-27
|
||||
|
||||
package Selima::List::Accounting::Reports::Cash::Summary;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List::Accounting::Reports);
|
||||
|
||||
use POSIX qw(floor);
|
||||
use Text::Capitalize qw(capitalize_title);
|
||||
use URI::Escape qw(uri_escape);
|
||||
|
||||
use Selima::Accounting;
|
||||
use Selima::CommText;
|
||||
use Selima::DataVars qw($DBH :env :l10n :lninfo :output :requri);
|
||||
use Selima::Format;
|
||||
use Selima::GetLang;
|
||||
use Selima::LnInfo;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
use Selima::UserPref;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class, @cols, $sql);
|
||||
($class, @_) = @_;
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The list type
|
||||
$self->{"type"} = "cashsum";
|
||||
# The subject
|
||||
$self->{"subj"} = $self->{"FORM"}->param("subj");
|
||||
$self->{"subj"} = "" if !defined $self->{"subj"};
|
||||
# The page title
|
||||
$_ = $self->{"subj"} eq ""?
|
||||
C_("current assets and liabilities"):
|
||||
acctsubj_title(acctsubj_sn($self->{"subj"}));
|
||||
s/^\d+ //;
|
||||
$self->{"title"} = capitalize_title(C_("Cash Book Summary - [_1]", $_));
|
||||
$self->{"title"} =~ s/ - /\x{2014}/;
|
||||
|
||||
# Construct the view
|
||||
$self->{"view"} = "acctrep_cash_summary_list";
|
||||
$self->{"noselect"} = 1;
|
||||
@_ = qw();
|
||||
push @_, "list=cash";
|
||||
push @_, "subj=" . uri_escape($self->{"subj"});
|
||||
push @_, "r=m";
|
||||
push @_, "m=";
|
||||
$_ = $REQUEST_FILE . "?" . join "&", @_;
|
||||
|
||||
if ($self->{"subj"} eq "") {
|
||||
@cols = qw();
|
||||
push @cols, $DBH->strcat($DBH->quote($_),
|
||||
"lpad(cast(extract(year FROM date) AS text), 4, '0')",
|
||||
"'-'", "lpad(cast(extract(month FROM date) AS text), 2, '0')") . " AS _viewurl";
|
||||
push @cols, $DBH->strcat("lpad(cast(extract(year FROM date) AS text), 4, '0')",
|
||||
"'-'", "lpad(cast(extract(month FROM date) AS text), 2, '0')") . " AS month";
|
||||
@_ = qw();
|
||||
push @_, "acctsum_debit(cast(extract(year FROM date) AS integer),"
|
||||
. " cast(extract(month FROM date) AS integer), '11')";
|
||||
push @_, "acctsum_debit(cast(extract(year FROM date) AS integer),"
|
||||
. " cast(extract(month FROM date) AS integer), '12')";
|
||||
push @_, "acctsum_debit(cast(extract(year FROM date) AS integer),"
|
||||
. " cast(extract(month FROM date) AS integer), '21')";
|
||||
push @_, "acctsum_debit(cast(extract(year FROM date) AS integer),"
|
||||
. " cast(extract(month FROM date) AS integer), '22')";
|
||||
push @cols, join(" + ", @_) . " AS income";
|
||||
@_ = qw();
|
||||
push @_, "acctsum_credit(cast(extract(year FROM date) AS integer),"
|
||||
. " cast(extract(month FROM date) AS integer), '11')";
|
||||
push @_, "acctsum_credit(cast(extract(year FROM date) AS integer),"
|
||||
. " cast(extract(month FROM date) AS integer), '12')";
|
||||
push @_, "acctsum_credit(cast(extract(year FROM date) AS integer),"
|
||||
. " cast(extract(month FROM date) AS integer), '21')";
|
||||
push @_, "acctsum_credit(cast(extract(year FROM date) AS integer),"
|
||||
. " cast(extract(month FROM date) AS integer), '22')";
|
||||
push @cols, join(" + ", @_) . " AS expense";
|
||||
@_ = qw();
|
||||
push @_, "acctsum_balance(cast(extract(year FROM date) AS integer),"
|
||||
. " cast(extract(month FROM date) AS integer), '11')";
|
||||
push @_, "acctsum_balance(cast(extract(year FROM date) AS integer),"
|
||||
. " cast(extract(month FROM date) AS integer), '12')";
|
||||
push @_, "acctsum_balance(cast(extract(year FROM date) AS integer),"
|
||||
. " cast(extract(month FROM date) AS integer), '21')";
|
||||
push @_, "acctsum_balance(cast(extract(year FROM date) AS integer),"
|
||||
. " cast(extract(month FROM date) AS integer), '22')";
|
||||
push @cols, join(" + ", @_) . " AS balance";
|
||||
$sql = "CREATE TEMPORARY VIEW " . $self->{"view"} . " AS"
|
||||
. " SELECT " . join(", ", @cols)
|
||||
. " FROM accttrx"
|
||||
. " GROUP BY extract(year FROM date), extract(month FROM date)"
|
||||
. " ORDER BY extract(year FROM date), extract(month FROM date);\n";
|
||||
} else {
|
||||
@cols = qw();
|
||||
push @cols, $DBH->strcat($DBH->quote($_),
|
||||
"lpad(cast(extract(year FROM date) AS text), 4, '0')",
|
||||
"'-'", "lpad(extract(cast(month FROM date) AS text), 2, '0')") . " AS _viewurl";
|
||||
push @cols, $DBH->strcat("lpad(cast(extract(year FROM date) AS text), 4, '0')",
|
||||
"'-'", "lpad(cast(extract(month FROM date) AS text), 2, '0')") . " AS month";
|
||||
push @cols, "acctsum_debit(cast(extract(year FROM date) AS integer),"
|
||||
. " cast(extract(month FROM date) AS integer), "
|
||||
. " " . $DBH->quote($self->{"subj"}) . ") AS income";
|
||||
push @cols, "acctsum_credit(cast(extract(year FROM date) AS integer),"
|
||||
. " cast(extract(month FROM date) AS integer),"
|
||||
. " " . $DBH->quote($self->{"subj"}) . ") AS expense";
|
||||
push @cols, "acctsum_balance(cast(extract(year FROM date) AS integer),"
|
||||
. " cast(extract(month FROM date) AS integer), "
|
||||
. " " . $DBH->quote($self->{"subj"}) . ") AS balance";
|
||||
$sql = "CREATE TEMPORARY VIEW " . $self->{"view"} . " AS"
|
||||
. " SELECT " . join(", ", @cols)
|
||||
. " FROM accttrx"
|
||||
. " GROUP BY extract(year FROM date), extract(month FROM date)"
|
||||
. " ORDER BY extract(year FROM date), extract(month FROM date);\n";
|
||||
}
|
||||
$DBH->do($sql);
|
||||
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# fetch: Fetch the current list
|
||||
sub fetch : method {
|
||||
local ($_, %_);
|
||||
my ($self, $cols, $table, $where, $orderby, $limit, $sth, $sql, $error);
|
||||
my ($sumincome, $sumexpense);
|
||||
$self = $_[0];
|
||||
|
||||
# Fetched before
|
||||
return $self->{"error"} if $self->{"fetched"};
|
||||
$self->{"fetched"} = 1;
|
||||
|
||||
# Initialize the error status
|
||||
$self->{"error"} = undef;
|
||||
$self->{"total"} = undef;
|
||||
|
||||
# No need to run if there is no data at all
|
||||
if (exists $self->{"nodata"} && $self->{"nodata"}) {
|
||||
$self->{"total"} = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
# See if we need to use views or not.
|
||||
# Views make things much faster and easier, but some DBMS has no views.
|
||||
# *MySQL has no views*
|
||||
if ($self->{"useview"}) {
|
||||
($cols, $table, $where, $orderby, $limit) = $self->select_with_view;
|
||||
} else {
|
||||
($cols, $table, $where, $orderby, $limit) = $self->select_without_view;
|
||||
}
|
||||
|
||||
# Fetch everything
|
||||
$self->{"select"} = sprintf "SELECT %s FROM %s%s%s%s;\n",
|
||||
$cols, $table, $where, $orderby, $limit;
|
||||
$sql = $self->{"select"};
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
|
||||
$self->{"current"} = [];
|
||||
push @{$self->{"current"}}, $_
|
||||
while defined($_ = $sth->fetchrow_hashref);
|
||||
undef $sth;
|
||||
|
||||
# Do calculation on each record
|
||||
($sumincome, $sumexpense) = (0, 0);
|
||||
foreach (@{$self->{"current"}}) {
|
||||
$sumincome += $$_{"income"};
|
||||
$sumexpense += $$_{"expense"};
|
||||
}
|
||||
# Remove the starting and ending empty records
|
||||
@_ = @{$self->{"current"}};
|
||||
shift @_ while @_ > 0 && ${$_[0]}{"income"} == 0 && ${$_[0]}{"expense"} == 0;
|
||||
pop @_ while @_ > 0 && ${$_[$#_]}{"income"} == 0 && ${$_[$#_]}{"expense"} == 0;
|
||||
$self->{"current"} = [@_];
|
||||
# Append the total record
|
||||
if (@{$self->{"current"}} > 0) {
|
||||
@_ = qw();
|
||||
push @_, "list=cash";
|
||||
push @_, "subj=" . uri_escape($self->{"subj"});
|
||||
push @_, "r=a";
|
||||
push @{$self->{"current"}}, {
|
||||
"_viewurl" => $REQUEST_FILE . "?" . join("&", @_),
|
||||
"month" => C_("Total"),
|
||||
"income" => $sumincome,
|
||||
"expense" => $sumexpense,
|
||||
"balance" => ${(reverse @{$self->{"current"}})[0]}{"balance"},
|
||||
};
|
||||
}
|
||||
|
||||
# The number of rows per page
|
||||
$_ = userpref("listsize", ref $self);
|
||||
$self->{"pagesize"} = defined $_? $_: $self->{"DEFAULT_LIST_SIZE"};
|
||||
# Paging not in use
|
||||
if (!defined $self->{"pagesize"}) {
|
||||
$self->{"total"} = scalar(@{$self->{"current"}});
|
||||
$self->{"lastpage"} = 1;
|
||||
$self->{"startno"} = 0;
|
||||
$self->{"endno"} = $self->{"total"} - 1;
|
||||
# If endno is -1 (when total is 0), set to 0
|
||||
$self->{"endno"} = 0 if $self->{"endno"} < 0;
|
||||
|
||||
# Done
|
||||
return $self->{"error"};
|
||||
}
|
||||
|
||||
# Obtain the total number
|
||||
$self->{"total"} = scalar @{$self->{"current"}};
|
||||
$self->{"lastpage"} = floor(($self->{"total"} - 1) / $self->{"pagesize"}) + 1;
|
||||
# If last page is 0 (when total is 0), set to page 1
|
||||
$self->{"lastpage"} = 1 if $self->{"lastpage"} < 1;
|
||||
|
||||
# Check the page number
|
||||
# Show the last page by default, but not reverse the number colume
|
||||
$_ = $self->{"reverse"};
|
||||
$self->{"reverse"} = 1;
|
||||
$error = $self->check_pageno;
|
||||
$self->{"reverse"} = $_;
|
||||
$self->{"error"} = $error if defined $error && !defined $self->{"error"};
|
||||
|
||||
# Calculate the start and end record number
|
||||
$self->{"startno"} = ($self->{"pageno"} - 1) * $self->{"pagesize"};
|
||||
$self->{"endno"} = $self->{"pageno"} * $self->{"pagesize"} - 1;
|
||||
# If there is not enough remaining records, set to the last one
|
||||
$self->{"endno"} = $self->{"total"} - 1
|
||||
if $self->{"endno"} > $self->{"total"} - 1;
|
||||
# If the last record is -1 (when total is 0), set to 0
|
||||
$self->{"endno"} = 0 if $self->{"endno"} < 0;
|
||||
|
||||
# Obtain everything in this page
|
||||
$self->{"current"} = [ @{$self->{"current"}}[$self->{"startno"}...$self->{"endno"}] ]
|
||||
if !$self->{"iscsv"};
|
||||
|
||||
# Set the columns to be displayed
|
||||
$self->{"cols"} = [qw(_viewurl month income expense balance)];
|
||||
$self->{"listcols"} = [qw(month income expense balance)];
|
||||
# Done
|
||||
return $self->{"error"};
|
||||
}
|
||||
|
||||
# page_param: Obtain page parameters
|
||||
sub page_param : method {
|
||||
local ($_, %_);
|
||||
my ($self, $rev, $r);
|
||||
$self = $_[0];
|
||||
$rev = $self->{"reverse"};
|
||||
$self->{"reverse"} = 1;
|
||||
# Run the parent method
|
||||
$r = $self->SUPER::page_param;
|
||||
$self->{"reverse"} = $rev;
|
||||
return $r;
|
||||
}
|
||||
|
||||
# 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 balance
|
||||
if ($col eq "balance") {
|
||||
if ($row{$col} > 0) {
|
||||
return "<div class=\"amount\">"
|
||||
. h_abbr(fmtntamount $row{$col}) . "</div>";
|
||||
} elsif ($row{$col} < 0) {
|
||||
return "<div class=\"amount\"><span class=\"neg\">-"
|
||||
. h_abbr(fmtntamount -$row{$col}) . "</span></div>";
|
||||
} else {
|
||||
return "<div class=\"amount\">-</div>";
|
||||
}
|
||||
}
|
||||
|
||||
# Run the parent method
|
||||
return $self->SUPER::colval($col, %row);
|
||||
}
|
||||
|
||||
# pre_filter: Set the pre-defined filter
|
||||
# Make it a null function
|
||||
sub pre_filter : method { }
|
||||
|
||||
# html_report_query: Display the report query box
|
||||
sub html_report_query : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $request_file, $label, $curlist);
|
||||
$self = $_[0];
|
||||
$form = $self->{"FORM"};
|
||||
|
||||
$request_file = h($REQUEST_FILE);
|
||||
$label = h_abbr(C_("Query"));
|
||||
|
||||
$curlist = h($self->{"type"});
|
||||
print << "EOT";
|
||||
<form 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><input type="hidden" name="charset" value="<!--selima:charset-->" /><input
|
||||
type="submit" value="$label" />
|
||||
</p>
|
||||
</div>
|
||||
</form>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_select_subject: Display the subject search box
|
||||
sub html_select_subject : method {
|
||||
local ($_, %_);
|
||||
my ($self, $label, @subjs);
|
||||
my ($sql, $sth, $count, $row, $thiscol, $defcol);
|
||||
$self = $_[0];
|
||||
|
||||
# The subject
|
||||
$label = h_abbr(C_("Accounting subject:"));
|
||||
# Obtain all the cash subjects
|
||||
$sql = "SELECT acctsubj.code FROM acctrecs"
|
||||
. " LEFT JOIN acctsubj ON acctrecs.subj=acctsubj.sn"
|
||||
. " WHERE acctsubj.code LIKE '11%'"
|
||||
. " OR acctsubj.code LIKE '12%'"
|
||||
. " OR acctsubj.code LIKE '21%'"
|
||||
. " OR acctsubj.code LIKE '22%'"
|
||||
. " GROUP BY acctsubj.code;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$count = $sth->rows;
|
||||
for (my $i = 0, @_ = qw(); $i < $count; $i++) {
|
||||
$row = $sth->fetchrow_hashref;
|
||||
push @_, $$row{"code"};
|
||||
}
|
||||
undef $sth;
|
||||
%_ = map { $_ => 1 } @_;
|
||||
# Add all of their parents
|
||||
foreach (keys %_) {
|
||||
$_{$_} = 1 while s/.$//;
|
||||
}
|
||||
delete $_{""};
|
||||
delete $_{"1"};
|
||||
delete $_{"11"};
|
||||
delete $_{"12"};
|
||||
delete $_{"2"};
|
||||
delete $_{"21"};
|
||||
delete $_{"22"};
|
||||
@_ = qw();
|
||||
push @_, "code AS value";
|
||||
if (@ALL_LINGUAS == 1) {
|
||||
push @_, $DBH->strcat("code", "' '", "title")
|
||||
. " AS content";
|
||||
} else {
|
||||
$thiscol = "title_" . getlang LN_DATABASE;
|
||||
if (getlang eq $DEFAULT_LANG) {
|
||||
push @_, $DBH->strcat("code", "' '", $thiscol)
|
||||
. " AS content";
|
||||
} else {
|
||||
$defcol = "title_" . ln($DEFAULT_LANG, LN_DATABASE);
|
||||
push @_, $DBH->strcat("code", "' '", "COALESCE($thiscol, $defcol)")
|
||||
. " AS content";
|
||||
}
|
||||
}
|
||||
$sql = "SELECT " . join(", ", @_) . " FROM acctsubj"
|
||||
. " WHERE " . join(" OR ", map "code=" . $DBH->quote($_), sort keys %_)
|
||||
. " ORDER BY code;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$count = $sth->rows;
|
||||
for (my $i = 0, @subjs = qw(); $i < $count; $i++) {
|
||||
push @subjs, {%{$sth->fetchrow_hashref}};
|
||||
}
|
||||
undef $sth;
|
||||
unshift @subjs, { "value" => "", "content" => C_("current assets and liabilities"), };
|
||||
|
||||
# Display the form
|
||||
print << "EOT";
|
||||
<p>$label
|
||||
<select name="subj">
|
||||
EOT
|
||||
foreach (@subjs) {
|
||||
my ($val, $content, $selected);
|
||||
$val = h($$_{"value"});
|
||||
$content = h($$_{"content"});
|
||||
$selected = defined $self->{"subj"} && $self->{"subj"} eq $$_{"value"}?
|
||||
" selected=\"selected\"": "";
|
||||
print << "EOT";
|
||||
<option value="$val"$selected>$content</option>
|
||||
EOT
|
||||
}
|
||||
print << "EOT";
|
||||
</select>
|
||||
</p>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_data_download: Display the data download link
|
||||
sub html_data_download : method {
|
||||
local ($_, %_);
|
||||
my ($self, $url, $title);
|
||||
$self = $_[0];
|
||||
# No data
|
||||
return if $self->{"total"} == 0;
|
||||
# Construct the URL
|
||||
@_ = qw();
|
||||
push @_, "list=cashsum";
|
||||
push @_, "subj=" . uri_escape($self->{"subj"});
|
||||
push @_, "format=csv";
|
||||
$url = $REQUEST_FILE . "?" . join "&", @_;
|
||||
$title = h_abbr(C_("Download the data as a CSV file."));
|
||||
print << "EOT";
|
||||
<p><a href="$url">$title</a></p>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_csv: Return the data as CSV
|
||||
sub html_csv : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Output a header to suggest for download instead of display
|
||||
$HTTP_HEADERS{"Content-Disposition"} =
|
||||
"attachment; filename=cash_summary.csv";
|
||||
$CONTENT_TYPE = "text/csv; charset=" . getlang LN_CHARSET;
|
||||
# The header column
|
||||
@_ = map((exists ${$self->{"col_labels"}}{$_}? ${$self->{"col_labels"}}{$_}: $_),
|
||||
@{$self->{"listcols"}});
|
||||
s/"/""/g foreach @_; # "
|
||||
print join(",", map "\"$_\"", @_) . "\n";
|
||||
# The data
|
||||
foreach my $current (@{$self->{"current"}}) {
|
||||
print join(",", map $$current{$_}, @{$self->{"listcols"}}) . "\n";
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# html_pagebar: Display a page navigation bar
|
||||
sub html_pagebar : method {
|
||||
local ($_, %_);
|
||||
my ($self, $rev, $r);
|
||||
$self = $_[0];
|
||||
$rev = $self->{"reverse"};
|
||||
$self->{"reverse"} = 1;
|
||||
# Run the parent method
|
||||
$r = $self->SUPER::html_pagebar;
|
||||
$self->{"reverse"} = $rev;
|
||||
return $r;
|
||||
}
|
||||
|
||||
return 1;
|
||||
366
lib/perl5/Selima/List/Accounting/Reports/IncmStat.pm
Normal file
366
lib/perl5/Selima/List/Accounting/Reports/IncmStat.pm
Normal file
@@ -0,0 +1,366 @@
|
||||
# Selima Website Content Management System
|
||||
# IncmStat.pm: The income statement 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-10-03
|
||||
|
||||
package Selima::List::Accounting::Reports::IncmStat;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List::Accounting::Reports);
|
||||
|
||||
use Selima::Accounting;
|
||||
use Selima::CommText;
|
||||
use Selima::DataVars qw($DBH :l10n :lninfo :output :requri);
|
||||
use Selima::Format;
|
||||
use Selima::GetLang;
|
||||
use Selima::LnInfo;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = C_("Income Statement");
|
||||
# The list type
|
||||
$self->{"type"} = "incmstat";
|
||||
# The default number of rows per page
|
||||
$self->{"DEFAULT_LIST_SIZE"} = undef;
|
||||
# Known columns that should not be sorted with
|
||||
# List sorting is disabled here at all
|
||||
push @{$self->{"COLS_NO_SORT_BY"}}, qw(amount1 amount2);
|
||||
$self->{"noselect"} = 1;
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"amount1" => C_("Amount"),
|
||||
"amount2" => C_("Amount"),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# fetch: Fetch the current list
|
||||
sub fetch : method {
|
||||
local ($_, %_);
|
||||
my ($self, @cols, $title, $sth, $sql, $error);
|
||||
my (@subjs, $sum, $balance);
|
||||
$self = $_[0];
|
||||
|
||||
# Fetched before
|
||||
return $self->{"error"} if $self->{"fetched"};
|
||||
$self->{"fetched"} = 1;
|
||||
|
||||
# Initialize the error status
|
||||
$self->{"error"} = undef;
|
||||
$self->{"total"} = undef;
|
||||
|
||||
# No need to run if there is no data at all
|
||||
if (exists $self->{"nodata"} && $self->{"nodata"}) {
|
||||
$self->{"total"} = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
# Construct the SQL query statement
|
||||
# Obtain the period once
|
||||
$self->sql_filter;
|
||||
@cols = qw();
|
||||
if (@ALL_LINGUAS == 1) {
|
||||
$title = "acctsubj.title";
|
||||
} else {
|
||||
my ($lndb, $lndbdef);
|
||||
$lndb = getlang LN_DATABASE;
|
||||
if (getlang eq $DEFAULT_LANG) {
|
||||
$title = "acctsubj.title_$lndb";
|
||||
} else {
|
||||
$lndbdef = ln $DEFAULT_LANG, LN_DATABASE;
|
||||
$title = "COALESCE(acctsubj.title_$lndb, acctsubj.title_$lndbdef)";
|
||||
}
|
||||
}
|
||||
push @cols, $DBH->strcat("acctsubj.code", "' '", $title) . " AS subj";
|
||||
push @cols, "sum(CASE WHEN acctrecs.credit THEN acctrecs.amount ELSE -acctrecs.amount END)"
|
||||
. " AS balance";
|
||||
$sql = "SELECT " . join(", ", @cols)
|
||||
. " FROM acctrecs"
|
||||
. " LEFT JOIN acctsubj ON acctrecs.subj=acctsubj.sn"
|
||||
. " LEFT JOIN accttrx ON acctrecs.trx=accttrx.sn"
|
||||
. " WHERE date>=" . $DBH->quote($self->{"startdate"})
|
||||
. " AND date<=" . $DBH->quote($self->{"enddate"})
|
||||
. " AND NOT (acctsubj.code LIKE '1%'"
|
||||
. " OR acctsubj.code LIKE '2%'"
|
||||
. " OR acctsubj.code LIKE '3%')"
|
||||
. " GROUP BY acctsubj.code, $title"
|
||||
. " ORDER BY acctsubj.code;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
@subjs = qw();
|
||||
push @subjs, $_
|
||||
while defined($_ = $sth->fetchrow_hashref);
|
||||
undef $sth;
|
||||
|
||||
$self->{"current"} = [];
|
||||
$balance = 0;
|
||||
foreach my $majsubj ((4, 5, 6, 7, 8, 9)) {
|
||||
push @{$self->{"current"}}, {
|
||||
"subj" => acctsubj_title(acctsubj_sn($majsubj)),
|
||||
"amount1" => "",
|
||||
"amount2" => "",
|
||||
};
|
||||
# non-operating revenue and expenses, other income (expense)
|
||||
if ($majsubj == 7) {
|
||||
# non-operating revenue
|
||||
$sum = 0;
|
||||
push @{$self->{"current"}}, {
|
||||
"subj" => acctsubj_title(acctsubj_sn(71)),
|
||||
"amount1" => "",
|
||||
"amount2" => "",
|
||||
};
|
||||
foreach (grep $$_{"subj"} =~ /^7[1234]/, @subjs) {
|
||||
push @{$self->{"current"}}, {
|
||||
"subj" => $$_{"subj"},
|
||||
"amount1" => $$_{"balance"},
|
||||
"amount2" => "",
|
||||
};
|
||||
$sum += $$_{"balance"};
|
||||
}
|
||||
push @{$self->{"current"}}, {
|
||||
"subj" => C_("Total"),
|
||||
"amount1" => "",
|
||||
"amount2" => $sum,
|
||||
};
|
||||
$balance += $sum;
|
||||
# non-operating expenses
|
||||
$sum = 0;
|
||||
push @{$self->{"current"}}, {
|
||||
"subj" => acctsubj_title(acctsubj_sn(75)),
|
||||
"amount1" => "",
|
||||
"amount2" => "",
|
||||
};
|
||||
foreach (grep $$_{"subj"} =~ /^7[5678]/, @subjs) {
|
||||
push @{$self->{"current"}}, {
|
||||
"subj" => $$_{"subj"},
|
||||
"amount1" => $$_{"balance"},
|
||||
"amount2" => "",
|
||||
};
|
||||
$sum += $$_{"balance"};
|
||||
}
|
||||
push @{$self->{"current"}}, {
|
||||
"subj" => C_("Total"),
|
||||
"amount1" => "",
|
||||
"amount2" => $sum,
|
||||
};
|
||||
$balance += $sum;
|
||||
# Other categories
|
||||
} else {
|
||||
$sum = 0;
|
||||
%_ = map { substr($$_{"subj"}, 0, 2) => 1 }
|
||||
grep $$_{"subj"} =~ /^$majsubj/, @subjs;
|
||||
foreach my $minsubj (sort keys %_) {
|
||||
push @{$self->{"current"}}, {
|
||||
"subj" => acctsubj_title(acctsubj_sn($minsubj)),
|
||||
"amount1" => "",
|
||||
"amount2" => "",
|
||||
};
|
||||
foreach (grep $$_{"subj"} =~ /^$minsubj/, @subjs) {
|
||||
push @{$self->{"current"}}, {
|
||||
"subj" => $$_{"subj"},
|
||||
"amount1" => $$_{"balance"},
|
||||
"amount2" => "",
|
||||
};
|
||||
$sum += $$_{"balance"};
|
||||
}
|
||||
}
|
||||
push @{$self->{"current"}}, {
|
||||
"subj" => C_("Total"),
|
||||
"amount1" => "",
|
||||
"amount2" => $sum,
|
||||
};
|
||||
$balance += $sum;
|
||||
}
|
||||
# 4 operating revenue
|
||||
# No balance after operating revenue
|
||||
if ($majsubj != 4) {
|
||||
# 5 operating costs
|
||||
$_ = C_("Gross income") if $majsubj == 5;
|
||||
# 6 operating expenses
|
||||
$_ = C_("Operating income") if $majsubj == 6;
|
||||
# 7 non-operating revenue and expenses, other income (expense)
|
||||
$_ = C_("Before tax income") if $majsubj == 7;
|
||||
# 8 income tax expense (or benefit)
|
||||
$_ = C_("After tax income") if $majsubj == 8;
|
||||
# 9 nonrecurring gain or loss
|
||||
$_ = acctsubj_title(acctsubj_sn(ACCTSUBJ_INCOME_CUR))
|
||||
if $majsubj == 9;
|
||||
push @{$self->{"current"}}, {
|
||||
"subj" => $_,
|
||||
"amount1" => "",
|
||||
"amount2" => $balance,
|
||||
};
|
||||
}
|
||||
# Put a blank separator record
|
||||
if ($majsubj != 9) {
|
||||
push @{$self->{"current"}}, {
|
||||
"subj" => "",
|
||||
"amount1" => "",
|
||||
"amount2" => "",
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
# The number of rows per page
|
||||
$self->{"pagesize"} = $self->{"DEFAULT_LIST_SIZE"};
|
||||
# Paging not in use
|
||||
$self->{"total"} = scalar(@{$self->{"current"}});
|
||||
$self->{"lastpage"} = 1;
|
||||
$self->{"startno"} = 0;
|
||||
$self->{"endno"} = $self->{"total"} - 1;
|
||||
# If endno is -1 (when total is 0), set to 0
|
||||
$self->{"endno"} = 0 if $self->{"endno"} < 0;
|
||||
|
||||
# Set the columns to be displayed
|
||||
$self->{"cols"} = [qw(subj amount1 amount2)];
|
||||
$self->{"listcols"} = [qw(subj amount1 amount2)];
|
||||
|
||||
# Done
|
||||
return $self->{"error"};
|
||||
}
|
||||
|
||||
# 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 "subj") {
|
||||
if ($row{$col} =~ /^\d\d /) {
|
||||
return "<div class=\"subjlv2\">"
|
||||
. h_abbr($row{$col}) . "</div>";
|
||||
} elsif ( $row{$col} =~ /^\d\d\d/
|
||||
&& substr($row{$col}, 0, 4) ne ACCTSUBJ_INCOME_CUR) {
|
||||
return "<div class=\"subjlastlv\">"
|
||||
. h_abbr($row{$col}) . "</div>";
|
||||
} else {
|
||||
return h_abbr($row{$col});
|
||||
}
|
||||
}
|
||||
|
||||
# The amount
|
||||
if ($col eq "amount1" || $col eq "amount2") {
|
||||
return "" if $row{$col} eq "";
|
||||
if ($row{$col} < 0) {
|
||||
return "<div class=\"amount\"><span class=\"neg\">("
|
||||
. h_abbr(fmtntamount -$row{$col}) . ")</span></div>";
|
||||
} else {
|
||||
return "<div class=\"amount\">"
|
||||
. h_abbr(fmtntamount $row{$col}) . "</div>";
|
||||
}
|
||||
}
|
||||
|
||||
# Run the parent method
|
||||
return $self->SUPER::colval($col, %row);
|
||||
}
|
||||
|
||||
# html_data_download: Display the data download link
|
||||
sub html_data_download : method {
|
||||
local ($_, %_);
|
||||
my ($self, $url, $title);
|
||||
$self = $_[0];
|
||||
# No data
|
||||
return if $self->{"total"} == 0;
|
||||
# Construct the URL
|
||||
@_ = qw();
|
||||
push @_, "list=incmstat";
|
||||
push @_, $self->{"actrange"};
|
||||
push @_, "format=csv";
|
||||
$url = $REQUEST_FILE . "?" . join "&", @_;
|
||||
$title = h_abbr(C_("Download the data as a CSV file."));
|
||||
print << "EOT";
|
||||
<p><a href="$url">$title</a></p>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_csv: Return the data as CSV
|
||||
sub html_csv : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Output a header to suggest for download instead of display
|
||||
$HTTP_HEADERS{"Content-Disposition"} =
|
||||
"attachment; filename=income_statement.csv";
|
||||
$CONTENT_TYPE = "text/csv; charset=" . getlang LN_CHARSET;
|
||||
# The header column
|
||||
@_ = map((exists ${$self->{"col_labels"}}{$_}? ${$self->{"col_labels"}}{$_}: $_),
|
||||
@{$self->{"listcols"}});
|
||||
s/"/""/g foreach @_; # "
|
||||
print join(",", map "\"$_\"", @_) . "\n";
|
||||
# The data
|
||||
foreach my $current (@{$self->{"current"}}) {
|
||||
@_ = map $$current{$_}, @{$self->{"listcols"}};
|
||||
foreach (@_) {
|
||||
$_ = "" if !defined $_;
|
||||
s/"/""/g; # "
|
||||
}
|
||||
print join(",", map "\"$_\"", @_) . "\n";
|
||||
}
|
||||
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
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# html_listprefform: Display a form to change the list preference
|
||||
# Make it a null function
|
||||
sub html_listprefform : method {}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my ($self, $total);
|
||||
$self = $_[0];
|
||||
|
||||
$total = $self->{"total"};
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message if $self->{"total"} == 0;
|
||||
return C_("[*,_1,accounting subject].", $self->{"total"} - 1);
|
||||
}
|
||||
|
||||
return 1;
|
||||
322
lib/perl5/Selima/List/Accounting/Reports/Journal.pm
Normal file
322
lib/perl5/Selima/List/Accounting/Reports/Journal.pm
Normal file
@@ -0,0 +1,322 @@
|
||||
# Selima Website Content Management System
|
||||
# Journal.pm: The journal 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-29
|
||||
|
||||
package Selima::List::Accounting::Reports::Journal;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List::Accounting::Reports);
|
||||
|
||||
use POSIX qw(floor);
|
||||
use URI::Escape qw(uri_escape);
|
||||
|
||||
use Selima::Accounting;
|
||||
use Selima::CommText;
|
||||
use Selima::DataVars qw($DBH :l10n :lninfo :output :requri);
|
||||
use Selima::GetLang;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
use Selima::UserPref;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = C_("Journal");
|
||||
# The list type
|
||||
$self->{"type"} = "journal";
|
||||
if (@ALL_LINGUAS == 1) {
|
||||
$self->{"view"} = "acctrep_search_list";
|
||||
} else {
|
||||
$self->{"view"} = "acctrep_search_list_" . getlang(LN_DATABASE);
|
||||
}
|
||||
# Columns should be displayed in a reversed order
|
||||
$self->{"reverse"} = 1;
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"trxno" => C_("Transaction Number"),
|
||||
"note" => C_("Note"),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# fetch: Fetch the current list
|
||||
sub fetch : method {
|
||||
local ($_, %_);
|
||||
my ($self, $cols, $table, $where, $orderby, $limit, $sth, $sql, $error);
|
||||
my (@debits, @credits);
|
||||
$self = $_[0];
|
||||
|
||||
# Fetched before
|
||||
return $self->{"error"} if $self->{"fetched"};
|
||||
$self->{"fetched"} = 1;
|
||||
|
||||
# Initialize the error status
|
||||
$self->{"error"} = undef;
|
||||
$self->{"total"} = undef;
|
||||
|
||||
# No need to run if there is no data at all
|
||||
if (exists $self->{"nodata"} && $self->{"nodata"}) {
|
||||
$self->{"total"} = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
# See if we need to use views or not.
|
||||
# Views make things much faster and easier, but some DBMS has no views.
|
||||
# *MySQL has no views*
|
||||
if ($self->{"useview"}) {
|
||||
($cols, $table, $where, $orderby, $limit) = $self->select_with_view;
|
||||
} else {
|
||||
($cols, $table, $where, $orderby, $limit) = $self->select_without_view;
|
||||
}
|
||||
|
||||
# Fetch everything
|
||||
$self->{"select"} = sprintf "SELECT %s FROM %s%s%s%s;\n",
|
||||
$cols, $table, $where, $orderby, $limit;
|
||||
$sql = $self->{"select"};
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
|
||||
$self->{"current"} = [];
|
||||
push @{$self->{"current"}}, $_
|
||||
while defined($_ = $sth->fetchrow_hashref);
|
||||
undef $sth;
|
||||
# Set the selection column
|
||||
unshift @{$self->{"cols"}}, "_sel";
|
||||
$$_{"_sel"} = 1 foreach @{$self->{"current"}};
|
||||
|
||||
# Find the carry-over balance
|
||||
@_ = qw();
|
||||
push @_, "acctsubj.code AS code";
|
||||
push @_, "sum(CASE WHEN acctrecs.credit THEN -amount ELSE amount END) AS sum";
|
||||
$sql = "SELECT " . join(", ", @_) . " FROM acctrecs"
|
||||
. " LEFT JOIN acctsubj ON acctrecs.subj=acctsubj.sn"
|
||||
. " LEFT JOIN accttrx ON acctrecs.trx=accttrx.sn"
|
||||
. " WHERE (acctsubj.code LIKE '1%'"
|
||||
. " OR acctsubj.code LIKE '2%'"
|
||||
. " OR acctsubj.code LIKE '3%')"
|
||||
. " AND acctsubj.code != " . $DBH->quote(ACCTSUBJ_INCOME_ACUM)
|
||||
. " AND accttrx.date<" . $DBH->quote($self->{"startdate"})
|
||||
. " GROUP BY acctsubj.code"
|
||||
. " ORDER BY acctsubj.code;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
for ($_ = 0, @_ = qw(); $_ < $sth->rows; $_++) {
|
||||
push @_, {%{$sth->fetchrow_hashref}};
|
||||
}
|
||||
undef $sth;
|
||||
# Create the carry-over transaction
|
||||
@debits = qw();
|
||||
@credits = qw();
|
||||
foreach (@_) {
|
||||
# Positive balance - from carry-over to account
|
||||
if ($$_{"sum"} > 0) {
|
||||
push @debits, {
|
||||
"_sel" => 0,
|
||||
"_selurl" => undef,
|
||||
"date" => $self->{"startdate"},
|
||||
"trxno" => "",
|
||||
"subj" => acctsubj_title(acctsubj_sn($$_{"code"})),
|
||||
"summary" => "",
|
||||
"debit" => $$_{"sum"},
|
||||
"credit" => 0,
|
||||
"note" => C_("Brought forward"),
|
||||
};
|
||||
push @credits, {
|
||||
"_sel" => 0,
|
||||
"_selurl" => undef,
|
||||
"date" => $self->{"startdate"},
|
||||
"trxno" => "",
|
||||
"subj" => acctsubj_title(acctsubj_sn(ACCTSUBJ_INCOME_ACUM)),
|
||||
"summary" => acctsubj_title(acctsubj_sn($$_{"code"})),
|
||||
"debit" => 0,
|
||||
"credit" => $$_{"sum"},
|
||||
"note" => C_("Brought forward"),
|
||||
};
|
||||
# Negative balance - from account to carry-over
|
||||
} elsif ($$_{"sum"} < 0) {
|
||||
push @debits, {
|
||||
"_sel" => 0,
|
||||
"_selurl" => undef,
|
||||
"date" => $self->{"startdate"},
|
||||
"trxno" => "",
|
||||
"subj" => acctsubj_title(acctsubj_sn(ACCTSUBJ_INCOME_ACUM)),
|
||||
"summary" => acctsubj_title(acctsubj_sn($$_{"code"})),
|
||||
"debit" => -$$_{"sum"},
|
||||
"credit" => 0,
|
||||
"note" => C_("Brought forward"),
|
||||
};
|
||||
push @credits, {
|
||||
"_sel" => 0,
|
||||
"_selurl" => undef,
|
||||
"date" => $self->{"startdate"},
|
||||
"trxno" => "",
|
||||
"subj" => acctsubj_title(acctsubj_sn($$_{"code"})),
|
||||
"summary" => "",
|
||||
"debit" => 0,
|
||||
"credit" => -$$_{"sum"},
|
||||
"note" => C_("Brought forward"),
|
||||
};
|
||||
}
|
||||
# Skip subjects with zero balances
|
||||
}
|
||||
$self->{"current"} = [@debits, @credits, @{$self->{"current"}}];
|
||||
|
||||
# The number of rows per page
|
||||
$_ = userpref("listsize", ref $self);
|
||||
$self->{"pagesize"} = defined $_? $_: $self->{"DEFAULT_LIST_SIZE"};
|
||||
# Paging not in use
|
||||
if (!defined $self->{"pagesize"}) {
|
||||
$self->{"total"} = scalar(@{$self->{"current"}});
|
||||
$self->{"lastpage"} = 1;
|
||||
$self->{"startno"} = 0;
|
||||
$self->{"endno"} = $self->{"total"} - 1;
|
||||
# If endno is -1 (when total is 0), set to 0
|
||||
$self->{"endno"} = 0 if $self->{"endno"} < 0;
|
||||
|
||||
# Done
|
||||
return $self->{"error"};
|
||||
}
|
||||
|
||||
# Obtain the total number
|
||||
$self->{"total"} = scalar @{$self->{"current"}};
|
||||
$self->{"lastpage"} = floor(($self->{"total"} - 1) / $self->{"pagesize"}) + 1;
|
||||
# If last page is 0 (when total is 0), set to page 1
|
||||
$self->{"lastpage"} = 1 if $self->{"lastpage"} < 1;
|
||||
|
||||
# Check the page number
|
||||
# Show the last page by default, but not reverse the number colume
|
||||
$_ = $self->{"reverse"};
|
||||
$self->{"reverse"} = 1;
|
||||
$error = $self->check_pageno;
|
||||
$self->{"reverse"} = $_;
|
||||
$self->{"error"} = $error if defined $error && !defined $self->{"error"};
|
||||
|
||||
# Calculate the start and end record number
|
||||
$self->{"startno"} = ($self->{"pageno"} - 1) * $self->{"pagesize"};
|
||||
$self->{"endno"} = $self->{"pageno"} * $self->{"pagesize"} - 1;
|
||||
# If there is not enough remaining records, set to the last one
|
||||
$self->{"endno"} = $self->{"total"} - 1
|
||||
if $self->{"endno"} > $self->{"total"} - 1;
|
||||
# If the last record is -1 (when total is 0), set to 0
|
||||
$self->{"endno"} = 0 if $self->{"endno"} < 0;
|
||||
|
||||
# Obtain everything in this page
|
||||
$self->{"current"} = [ @{$self->{"current"}}[$self->{"startno"}...$self->{"endno"}] ]
|
||||
if !$self->{"iscsv"};
|
||||
|
||||
# Set the columns to be displayed
|
||||
$self->{"listcols"} = [qw(date trxno subj summary debit credit note)];
|
||||
# Done
|
||||
return $self->{"error"};
|
||||
}
|
||||
|
||||
# colval: Output a list column value
|
||||
sub colval : method {
|
||||
local ($_, %_);
|
||||
my ($self, $col, %row);
|
||||
($self, $col, %row) = @_;
|
||||
|
||||
# The subject
|
||||
if ($col eq "subj") {
|
||||
if ($row{"credit"} > 0) {
|
||||
return "<div class=\"crdtsubj\">"
|
||||
. h_abbr($row{$col}) . "</div>";
|
||||
} else {
|
||||
return h_abbr($row{$col});
|
||||
}
|
||||
}
|
||||
|
||||
# The summary
|
||||
if ($col eq "summary") {
|
||||
return "" if !defined $row{$col};
|
||||
return h_abbr($row{$col});
|
||||
}
|
||||
|
||||
# Null/no value
|
||||
return h(t_notset()) if !defined $row{$col};
|
||||
|
||||
# Run the parent method
|
||||
return $self->SUPER::colval($col, %row);
|
||||
}
|
||||
|
||||
# html_data_download: Display the data download link
|
||||
sub html_data_download : method {
|
||||
local ($_, %_);
|
||||
my ($self, $url, $title);
|
||||
$self = $_[0];
|
||||
# No data
|
||||
return if $self->{"total"} == 0;
|
||||
# Construct the URL
|
||||
@_ = qw();
|
||||
push @_, "list=journal";
|
||||
push @_, $self->{"actrange"};
|
||||
push @_, "format=csv";
|
||||
$url = $REQUEST_FILE . "?" . join "&", @_;
|
||||
$title = h_abbr(C_("Download the data as a CSV file."));
|
||||
print << "EOT";
|
||||
<p><a href="$url">$title</a></p>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_csv: Return the data as CSV
|
||||
sub html_csv : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Output a header to suggest for download instead of display
|
||||
$HTTP_HEADERS{"Content-Disposition"} =
|
||||
"attachment; filename=journal.csv";
|
||||
$CONTENT_TYPE = "text/csv; charset=" . getlang LN_CHARSET;
|
||||
# The header column
|
||||
@_ = map((exists ${$self->{"col_labels"}}{$_}? ${$self->{"col_labels"}}{$_}: $_),
|
||||
@{$self->{"listcols"}});
|
||||
s/"/""/g foreach @_; # "
|
||||
print join(",", map "\"$_\"", @_) . "\n";
|
||||
# The data
|
||||
foreach my $current (@{$self->{"current"}}) {
|
||||
@_ = map $$current{$_}, @{$self->{"listcols"}};
|
||||
foreach (@_) {
|
||||
$_ = "" if !defined $_;
|
||||
s/"/""/g; # "
|
||||
}
|
||||
print join(",", map "\"$_\"", @_) . "\n";
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# html_list: List the items
|
||||
sub html_list : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
$self->{"reverse"} = 0;
|
||||
# Run the parent method
|
||||
$self->SUPER::html_list;
|
||||
$self->{"reverse"} = 1;
|
||||
return;
|
||||
}
|
||||
|
||||
return 1;
|
||||
412
lib/perl5/Selima/List/Accounting/Reports/Ledger.pm
Normal file
412
lib/perl5/Selima/List/Accounting/Reports/Ledger.pm
Normal file
@@ -0,0 +1,412 @@
|
||||
# Selima Website Content Management System
|
||||
# Ledger.pm: The ledger 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::Ledger;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List::Accounting::Reports);
|
||||
|
||||
use POSIX qw(floor);
|
||||
use Text::Capitalize qw(capitalize_title);
|
||||
use URI::Escape qw(uri_escape);
|
||||
|
||||
use Selima::Accounting;
|
||||
use Selima::CommText;
|
||||
use Selima::DataVars qw($DBH :l10n :lninfo :output :requri);
|
||||
use Selima::Format;
|
||||
use Selima::GetLang;
|
||||
use Selima::LnInfo;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
use Selima::UserPref;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The list type
|
||||
$self->{"type"} = "ldgr";
|
||||
if (@ALL_LINGUAS == 1) {
|
||||
$self->{"view"} = "acctrep_ledger_list";
|
||||
} else {
|
||||
$self->{"view"} = "acctrep_ledger_list_" . getlang(LN_DATABASE);
|
||||
}
|
||||
# The subject
|
||||
$self->{"subj"} = $self->{"FORM"}->param("subj");
|
||||
$self->{"subj"} = ACCTSUBJ_CASH if !defined $self->{"subj"};
|
||||
# The page title
|
||||
$_ = acctsubj_title(acctsubj_sn($self->{"subj"}));
|
||||
s/^\d+ //;
|
||||
$self->{"title"} = capitalize_title(C_("Ledger - [_1]", $_));
|
||||
$self->{"title"} =~ s/ - /\x{2014}/;
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# fetch: Fetch the current list
|
||||
sub fetch : method {
|
||||
local ($_, %_);
|
||||
my ($self, $cols, $table, $where, $orderby, $limit, $sth, $sql, $error);
|
||||
my ($balance, @carryover);
|
||||
$self = $_[0];
|
||||
|
||||
# Fetched before
|
||||
return $self->{"error"} if $self->{"fetched"};
|
||||
$self->{"fetched"} = 1;
|
||||
|
||||
# Initialize the error status
|
||||
$self->{"error"} = undef;
|
||||
$self->{"total"} = undef;
|
||||
|
||||
# No need to run if there is no data at all
|
||||
if (exists $self->{"nodata"} && $self->{"nodata"}) {
|
||||
$self->{"total"} = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
# See if we need to use views or not.
|
||||
# Views make things much faster and easier, but some DBMS has no views.
|
||||
# *MySQL has no views*
|
||||
if ($self->{"useview"}) {
|
||||
($cols, $table, $where, $orderby, $limit) = $self->select_with_view;
|
||||
} else {
|
||||
($cols, $table, $where, $orderby, $limit) = $self->select_without_view;
|
||||
}
|
||||
|
||||
# Fetch everything
|
||||
$self->{"select"} = sprintf "SELECT %s FROM %s%s%s%s;\n",
|
||||
$cols, $table, $where, $orderby, $limit;
|
||||
$sql = $self->{"select"};
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
|
||||
$self->{"current"} = [];
|
||||
push @{$self->{"current"}}, $_
|
||||
while defined($_ = $sth->fetchrow_hashref);
|
||||
undef $sth;
|
||||
|
||||
# Find the carry-over records
|
||||
if ($self->{"subj"} =~ /^[123]/) {
|
||||
@_ = qw();
|
||||
push @_, "acctsubj.code AS code";
|
||||
push @_, "sum(CASE WHEN acctrecs.credit THEN -amount ELSE amount END) AS sum";
|
||||
$sql = "SELECT " . join(", ", @_) . " FROM acctrecs"
|
||||
. " LEFT JOIN acctsubj ON acctrecs.subj=acctsubj.sn"
|
||||
. " LEFT JOIN accttrx ON acctrecs.trx=accttrx.sn"
|
||||
. " WHERE acctsubj.code LIKE " . $DBH->strcat($DBH->quote($self->{"subj"}), "'%'")
|
||||
. " AND accttrx.date<" . $DBH->quote($self->{"startdate"})
|
||||
. " GROUP BY acctsubj.code"
|
||||
. " ORDER BY acctsubj.code;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
for ($_ = 0, @_ = qw(); $_ < $sth->rows; $_++) {
|
||||
push @_, {%{$sth->fetchrow_hashref}};
|
||||
}
|
||||
undef $sth;
|
||||
# Create the carry over transaction
|
||||
@carryover = qw();
|
||||
foreach (@_) {
|
||||
# Positive balance - from carry-over to account
|
||||
if ($$_{"sum"} > 0) {
|
||||
push @carryover, {
|
||||
"_sel" => 0,
|
||||
"_selurl" => undef,
|
||||
"_subj" => $self->{"subj"},
|
||||
"_date" => $self->{"startdate"},
|
||||
"date" => $self->{"startdate"},
|
||||
"subj" => acctsubj_title(acctsubj_sn($$_{"code"})),
|
||||
"summary" => C_("Brought forward"),
|
||||
"debit" => $$_{"sum"},
|
||||
"credit" => 0,
|
||||
"balance" => 0,
|
||||
};
|
||||
# Negative balance - from account to carry-over
|
||||
} elsif ($$_{"sum"} < 0) {
|
||||
push @carryover, {
|
||||
"_sel" => 0,
|
||||
"_selurl" => undef,
|
||||
"_subj" => $self->{"subj"},
|
||||
"_date" => $self->{"startdate"},
|
||||
"date" => $self->{"startdate"},
|
||||
"subj" => acctsubj_title(acctsubj_sn($$_{"code"})),
|
||||
"summary" => C_("Brought forward"),
|
||||
"debit" => 0,
|
||||
"credit" => -$$_{"sum"},
|
||||
"balance" => 0,
|
||||
};
|
||||
}
|
||||
# Skip subjects with zero balances
|
||||
}
|
||||
$self->{"current"} = [@carryover, @{$self->{"current"}}];
|
||||
}
|
||||
|
||||
# Calculate the balance
|
||||
$balance = 0;
|
||||
foreach (@{$self->{"current"}}) {
|
||||
$balance = $balance + $$_{"debit"} - $$_{"credit"};
|
||||
$$_{"balance"} = $balance;
|
||||
}
|
||||
|
||||
# The number of rows per page
|
||||
$_ = userpref("listsize", ref $self);
|
||||
$self->{"pagesize"} = defined $_? $_: $self->{"DEFAULT_LIST_SIZE"};
|
||||
# Paging not in use
|
||||
if (!defined $self->{"pagesize"}) {
|
||||
$self->{"total"} = scalar(@{$self->{"current"}});
|
||||
$self->{"lastpage"} = 1;
|
||||
$self->{"startno"} = 0;
|
||||
$self->{"endno"} = $self->{"total"} - 1;
|
||||
# If endno is -1 (when total is 0), set to 0
|
||||
$self->{"endno"} = 0 if $self->{"endno"} < 0;
|
||||
|
||||
# Done
|
||||
return $self->{"error"};
|
||||
}
|
||||
|
||||
# Obtain the total number
|
||||
$self->{"total"} = scalar @{$self->{"current"}};
|
||||
$self->{"lastpage"} = floor(($self->{"total"} - 1) / $self->{"pagesize"}) + 1;
|
||||
# If last page is 0 (when total is 0), set to page 1
|
||||
$self->{"lastpage"} = 1 if $self->{"lastpage"} < 1;
|
||||
|
||||
# Check the page number
|
||||
# Show the last page by default, but not reverse the number colume
|
||||
$_ = $self->{"reverse"};
|
||||
$self->{"reverse"} = 1;
|
||||
$error = $self->check_pageno;
|
||||
$self->{"reverse"} = $_;
|
||||
$self->{"error"} = $error if defined $error && !defined $self->{"error"};
|
||||
|
||||
# Calculate the start and end record number
|
||||
$self->{"startno"} = ($self->{"pageno"} - 1) * $self->{"pagesize"};
|
||||
$self->{"endno"} = $self->{"pageno"} * $self->{"pagesize"} - 1;
|
||||
# If there is not enough remaining records, set to the last one
|
||||
$self->{"endno"} = $self->{"total"} - 1
|
||||
if $self->{"endno"} > $self->{"total"} - 1;
|
||||
# If the last record is -1 (when total is 0), set to 0
|
||||
$self->{"endno"} = 0 if $self->{"endno"} < 0;
|
||||
|
||||
# Obtain everything in this page
|
||||
$self->{"current"} = [ @{$self->{"current"}}[$self->{"startno"}...$self->{"endno"}] ]
|
||||
if !$self->{"iscsv"};
|
||||
|
||||
# Set the columns to be displayed
|
||||
$self->{"listcols"} = [qw(date subj summary debit credit balance)];
|
||||
# Done
|
||||
return $self->{"error"};
|
||||
}
|
||||
|
||||
# page_param: Obtain page parameters
|
||||
sub page_param : method {
|
||||
local ($_, %_);
|
||||
my ($self, $rev, $r);
|
||||
$self = $_[0];
|
||||
$rev = $self->{"reverse"};
|
||||
$self->{"reverse"} = 1;
|
||||
# Run the parent method
|
||||
$r = $self->SUPER::page_param;
|
||||
$self->{"reverse"} = $rev;
|
||||
return $r;
|
||||
}
|
||||
|
||||
# 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 balance
|
||||
if ($col eq "balance") {
|
||||
return "" if $row{$col} eq "";
|
||||
if ($row{$col} > 0) {
|
||||
return "<div class=\"amount\">" . h_abbr(C_("Debit")) . " "
|
||||
. h_abbr(fmtntamount $row{$col}) . "</div>";
|
||||
} elsif ($row{$col} < 0) {
|
||||
return "<div class=\"amount\"><span class=\"neg\">"
|
||||
. h_abbr(C_("Credit")) . " "
|
||||
. h_abbr(fmtntamount -$row{$col}) . "</span></div>";
|
||||
} else {
|
||||
return "<div class=\"amount\">-</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;
|
||||
$self = $_[0];
|
||||
@_ = qw();
|
||||
push @_, "_subj LIKE '" . $self->{"subj"} . "%'";
|
||||
push @_, $_ if defined($_ = $self->SUPER::pre_filter);
|
||||
return undef if @_ == 0;
|
||||
return join " AND ", @_;
|
||||
}
|
||||
|
||||
# html_select_subject: Display the subject search box
|
||||
sub html_select_subject : method {
|
||||
local ($_, %_);
|
||||
my ($self, $label, @subjs);
|
||||
my ($sql, $sth, $count, $row, $thiscol, $defcol);
|
||||
$self = $_[0];
|
||||
|
||||
# The subject
|
||||
$label = h_abbr(C_("Accounting subject:"));
|
||||
# Obtain all the using subjects
|
||||
$sql = "SELECT acctsubj.code FROM acctrecs"
|
||||
. " LEFT JOIN acctsubj ON acctrecs.subj=acctsubj.sn"
|
||||
. " GROUP BY acctsubj.code;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$count = $sth->rows;
|
||||
for (my $i = 0, @_ = qw(); $i < $count; $i++) {
|
||||
$row = $sth->fetchrow_hashref;
|
||||
push @_, $$row{"code"};
|
||||
}
|
||||
undef $sth;
|
||||
%_ = map { $_ => 1 } @_;
|
||||
# Add all of their parents
|
||||
foreach (keys %_) {
|
||||
$_{$_} = 1 while s/.$//;
|
||||
}
|
||||
delete $_{""};
|
||||
@_ = qw();
|
||||
push @_, "code AS value";
|
||||
if (@ALL_LINGUAS == 1) {
|
||||
push @_, $DBH->strcat("code", "' '", "title")
|
||||
. " AS content";
|
||||
} else {
|
||||
$thiscol = "title_" . getlang LN_DATABASE;
|
||||
if (getlang eq $DEFAULT_LANG) {
|
||||
push @_, $DBH->strcat("code", "' '", $thiscol)
|
||||
. " AS content";
|
||||
} else {
|
||||
$defcol = "title_" . ln($DEFAULT_LANG, LN_DATABASE);
|
||||
push @_, $DBH->strcat("code", "' '", "COALESCE($thiscol, $defcol)")
|
||||
. " AS content";
|
||||
}
|
||||
}
|
||||
$sql = "SELECT " . join(", ", @_) . " FROM acctsubj"
|
||||
. " WHERE " . join(" OR ", map "code=" . $DBH->quote($_), sort keys %_)
|
||||
. " ORDER BY code;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$count = $sth->rows;
|
||||
for (my $i = 0, @subjs = qw(); $i < $count; $i++) {
|
||||
push @subjs, {%{$sth->fetchrow_hashref}};
|
||||
}
|
||||
undef $sth;
|
||||
|
||||
# Display the form
|
||||
print << "EOT";
|
||||
<p>$label
|
||||
<select name="subj">
|
||||
EOT
|
||||
foreach (@subjs) {
|
||||
my ($val, $content, $selected);
|
||||
$val = h($$_{"value"});
|
||||
$content = h($$_{"content"});
|
||||
$selected = defined $self->{"subj"} && $self->{"subj"} eq $$_{"value"}?
|
||||
" selected=\"selected\"": "";
|
||||
print << "EOT";
|
||||
<option value="$val"$selected>$content</option>
|
||||
EOT
|
||||
}
|
||||
print << "EOT";
|
||||
</select>
|
||||
</p>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_data_download: Display the data download link
|
||||
sub html_data_download : method {
|
||||
local ($_, %_);
|
||||
my ($self, $url, $title);
|
||||
$self = $_[0];
|
||||
# No data
|
||||
return if $self->{"total"} == 0;
|
||||
# Construct the URL
|
||||
@_ = qw();
|
||||
push @_, "list=ldgr";
|
||||
push @_, "subj=" . uri_escape($self->{"subj"});
|
||||
push @_, $self->{"actrange"};
|
||||
push @_, "format=csv";
|
||||
$url = $REQUEST_FILE . "?" . join "&", @_;
|
||||
$title = h_abbr(C_("Download the data as a CSV file."));
|
||||
print << "EOT";
|
||||
<p><a href="$url">$title</a></p>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_csv: Return the data as CSV
|
||||
sub html_csv : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Output a header to suggest for download instead of display
|
||||
$HTTP_HEADERS{"Content-Disposition"} =
|
||||
"attachment; filename=ledger.csv";
|
||||
$CONTENT_TYPE = "text/csv; charset=" . getlang LN_CHARSET;
|
||||
# The header column
|
||||
@_ = map((exists ${$self->{"col_labels"}}{$_}? ${$self->{"col_labels"}}{$_}: $_),
|
||||
@{$self->{"listcols"}});
|
||||
s/"/""/g foreach @_; # "
|
||||
print join(",", map "\"$_\"", @_) . "\n";
|
||||
# The data
|
||||
foreach my $current (@{$self->{"current"}}) {
|
||||
@_ = map $$current{$_}, @{$self->{"listcols"}};
|
||||
foreach (@_) {
|
||||
$_ = "" if !defined $_;
|
||||
s/"/""/g; # "
|
||||
}
|
||||
print join(",", map "\"$_\"", @_) . "\n";
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# html_pagebar: Display a page navigation bar
|
||||
sub html_pagebar : method {
|
||||
local ($_, %_);
|
||||
my ($self, $rev, $r);
|
||||
$self = $_[0];
|
||||
$rev = $self->{"reverse"};
|
||||
$self->{"reverse"} = 1;
|
||||
# Run the parent method
|
||||
$r = $self->SUPER::html_pagebar;
|
||||
$self->{"reverse"} = $rev;
|
||||
return $r;
|
||||
}
|
||||
|
||||
return 1;
|
||||
422
lib/perl5/Selima/List/Accounting/Reports/Ledger/Summary.pm
Normal file
422
lib/perl5/Selima/List/Accounting/Reports/Ledger/Summary.pm
Normal file
@@ -0,0 +1,422 @@
|
||||
# Selima Website Content Management System
|
||||
# Summary.pm: The summary ledger 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-30
|
||||
|
||||
package Selima::List::Accounting::Reports::Ledger::Summary;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List::Accounting::Reports);
|
||||
|
||||
use POSIX qw(floor);
|
||||
use Text::Capitalize qw(capitalize_title);
|
||||
use URI::Escape qw(uri_escape);
|
||||
|
||||
use Selima::Accounting;
|
||||
use Selima::CommText;
|
||||
use Selima::DataVars qw($DBH :env :l10n :lninfo :output :requri);
|
||||
use Selima::Format;
|
||||
use Selima::GetLang;
|
||||
use Selima::LnInfo;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
use Selima::UserPref;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class, @cols, $sql);
|
||||
($class, @_) = @_;
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The list type
|
||||
$self->{"type"} = "ldgrsum";
|
||||
# The subject
|
||||
$self->{"subj"} = $self->{"FORM"}->param("subj");
|
||||
$self->{"subj"} = ACCTSUBJ_CASH if !defined $self->{"subj"};
|
||||
# The page title
|
||||
$_ = acctsubj_title(acctsubj_sn($self->{"subj"}));
|
||||
s/^\d+ //;
|
||||
$self->{"title"} = capitalize_title(C_("Ledger Summary - [_1]", $_));
|
||||
$self->{"title"} =~ s/ - /\x{2014}/;
|
||||
|
||||
# Construct the view
|
||||
$self->{"view"} = "acctrep_ledger_summary_list";
|
||||
$self->{"noselect"} = 1;
|
||||
@_ = qw();
|
||||
push @_, "list=ldgr";
|
||||
push @_, "subj=" . uri_escape($self->{"subj"});
|
||||
push @_, "r=m";
|
||||
push @_, "m=";
|
||||
$_ = $REQUEST_FILE . "?" . join "&", @_;
|
||||
|
||||
@cols = qw();
|
||||
push @cols, $DBH->strcat($DBH->quote($_),
|
||||
"lpad(cast(extract(year FROM date) AS text), 4, '0')",
|
||||
"'-'", "lpad(cast(extract(month FROM date) AS text), 2, '0')") . " AS _viewurl";
|
||||
push @cols, $DBH->strcat("lpad(cast(extract(year FROM date) AS text), 4, '0')",
|
||||
"'-'", "lpad(cast(extract(month FROM date) AS text), 2, '0')") . " AS month";
|
||||
push @cols, "acctsum_debit(cast(extract(year FROM date) AS integer),"
|
||||
. " cast(extract(month FROM date) AS integer),"
|
||||
. " " . $DBH->quote($self->{"subj"}) . ") AS debit";
|
||||
push @cols, "acctsum_credit(cast(extract(year FROM date) AS integer),"
|
||||
. " cast(extract(month FROM date) AS integer), "
|
||||
. " " . $DBH->quote($self->{"subj"}) . ") AS credit";
|
||||
push @cols, "acctsum_balance(cast(extract(year FROM date) AS integer),"
|
||||
. " cast(extract(month FROM date) AS integer), "
|
||||
. " " . $DBH->quote($self->{"subj"}) . ") AS balance";
|
||||
$sql = "CREATE TEMPORARY VIEW " . $self->{"view"} . " AS"
|
||||
. " SELECT " . join(", ", @cols)
|
||||
. " FROM accttrx"
|
||||
. " GROUP BY extract(year FROM date), extract(month FROM date)"
|
||||
. " ORDER BY extract(year FROM date), extract(month FROM date);\n";
|
||||
$DBH->do($sql);
|
||||
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# fetch: Fetch the current list
|
||||
sub fetch : method {
|
||||
local ($_, %_);
|
||||
my ($self, $cols, $table, $where, $orderby, $limit, $sth, $sql, $error);
|
||||
my ($sumdebit, $sumcredit);
|
||||
$self = $_[0];
|
||||
|
||||
# Fetched before
|
||||
return $self->{"error"} if $self->{"fetched"};
|
||||
$self->{"fetched"} = 1;
|
||||
|
||||
# Initialize the error status
|
||||
$self->{"error"} = undef;
|
||||
$self->{"total"} = undef;
|
||||
|
||||
# No need to run if there is no data at all
|
||||
if (exists $self->{"nodata"} && $self->{"nodata"}) {
|
||||
$self->{"total"} = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
# See if we need to use views or not.
|
||||
# Views make things much faster and easier, but some DBMS has no views.
|
||||
# *MySQL has no views*
|
||||
if ($self->{"useview"}) {
|
||||
($cols, $table, $where, $orderby, $limit) = $self->select_with_view;
|
||||
} else {
|
||||
($cols, $table, $where, $orderby, $limit) = $self->select_without_view;
|
||||
}
|
||||
|
||||
# Fetch everything
|
||||
$self->{"select"} = sprintf "SELECT %s FROM %s%s%s%s;\n",
|
||||
$cols, $table, $where, $orderby, $limit;
|
||||
$sql = $self->{"select"};
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
|
||||
$self->{"current"} = [];
|
||||
push @{$self->{"current"}}, $_
|
||||
while defined($_ = $sth->fetchrow_hashref);
|
||||
undef $sth;
|
||||
|
||||
# Do calculation on each record
|
||||
($sumdebit, $sumcredit) = (0, 0);
|
||||
foreach (@{$self->{"current"}}) {
|
||||
$$_{"balance"} = 0 if !defined $$_{"balance"};
|
||||
$sumdebit += $$_{"debit"};
|
||||
$sumcredit += $$_{"credit"};
|
||||
}
|
||||
# Remove the starting and ending empty records
|
||||
@_ = @{$self->{"current"}};
|
||||
shift @_ while @_ > 0 && ${$_[0]}{"credit"} == 0 && ${$_[0]}{"debit"} == 0;
|
||||
pop @_ while @_ > 0 && ${$_[$#_]}{"credit"} == 0 && ${$_[$#_]}{"debit"} == 0;
|
||||
$self->{"current"} = [@_];
|
||||
# Append the total record
|
||||
if (@{$self->{"current"}} > 0) {
|
||||
@_ = qw();
|
||||
push @_, "list=ldgr";
|
||||
push @_, "subj=" . uri_escape($self->{"subj"});
|
||||
push @_, "r=a";
|
||||
push @{$self->{"current"}}, {
|
||||
"_viewurl" => $REQUEST_FILE . "?" . join("&", @_),
|
||||
"month" => C_("Total"),
|
||||
"debit" => $sumdebit,
|
||||
"credit" => $sumcredit,
|
||||
"balance" => ${(reverse @{$self->{"current"}})[0]}{"balance"},
|
||||
};
|
||||
}
|
||||
|
||||
# The number of rows per page
|
||||
$_ = userpref("listsize", ref $self);
|
||||
$self->{"pagesize"} = defined $_? $_: $self->{"DEFAULT_LIST_SIZE"};
|
||||
# Paging not in use
|
||||
if (!defined $self->{"pagesize"}) {
|
||||
$self->{"total"} = scalar(@{$self->{"current"}});
|
||||
$self->{"lastpage"} = 1;
|
||||
$self->{"startno"} = 0;
|
||||
$self->{"endno"} = $self->{"total"} - 1;
|
||||
# If endno is -1 (when total is 0), set to 0
|
||||
$self->{"endno"} = 0 if $self->{"endno"} < 0;
|
||||
|
||||
# Done
|
||||
return $self->{"error"};
|
||||
}
|
||||
|
||||
# Obtain the total number
|
||||
$self->{"total"} = scalar @{$self->{"current"}};
|
||||
$self->{"lastpage"} = floor(($self->{"total"} - 1) / $self->{"pagesize"}) + 1;
|
||||
# If last page is 0 (when total is 0), set to page 1
|
||||
$self->{"lastpage"} = 1 if $self->{"lastpage"} < 1;
|
||||
|
||||
# Check the page number
|
||||
# Show the last page by default, but not reverse the number colume
|
||||
$_ = $self->{"reverse"};
|
||||
$self->{"reverse"} = 1;
|
||||
$error = $self->check_pageno;
|
||||
$self->{"reverse"} = $_;
|
||||
$self->{"error"} = $error if defined $error && !defined $self->{"error"};
|
||||
|
||||
# Calculate the start and end record number
|
||||
$self->{"startno"} = ($self->{"pageno"} - 1) * $self->{"pagesize"};
|
||||
$self->{"endno"} = $self->{"pageno"} * $self->{"pagesize"} - 1;
|
||||
# If there is not enough remaining records, set to the last one
|
||||
$self->{"endno"} = $self->{"total"} - 1
|
||||
if $self->{"endno"} > $self->{"total"} - 1;
|
||||
# If the last record is -1 (when total is 0), set to 0
|
||||
$self->{"endno"} = 0 if $self->{"endno"} < 0;
|
||||
|
||||
# Obtain everything in this page
|
||||
$self->{"current"} = [ @{$self->{"current"}}[$self->{"startno"}...$self->{"endno"}] ]
|
||||
if !$self->{"iscsv"};
|
||||
|
||||
# Set the columns to be displayed
|
||||
$self->{"cols"} = [qw(_viewurl month debit credit balance)];
|
||||
$self->{"listcols"} = [qw(month debit credit balance)];
|
||||
# Done
|
||||
return $self->{"error"};
|
||||
}
|
||||
|
||||
# page_param: Obtain page parameters
|
||||
sub page_param : method {
|
||||
local ($_, %_);
|
||||
my ($self, $rev, $r);
|
||||
$self = $_[0];
|
||||
$rev = $self->{"reverse"};
|
||||
$self->{"reverse"} = 1;
|
||||
# Run the parent method
|
||||
$r = $self->SUPER::page_param;
|
||||
$self->{"reverse"} = $rev;
|
||||
return $r;
|
||||
}
|
||||
|
||||
# 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 balance
|
||||
if ($col eq "balance") {
|
||||
if ($row{$col} > 0) {
|
||||
return "<div class=\"amount\">" . h_abbr(C_("Debit")) . " "
|
||||
. h_abbr(fmtntamount $row{$col}) . "</div>";
|
||||
} elsif ($row{$col} < 0) {
|
||||
return "<div class=\"amount\"><span class=\"neg\">"
|
||||
. h_abbr(C_("Credit")) . " "
|
||||
. h_abbr(fmtntamount -$row{$col}) . "</span></div>";
|
||||
} else {
|
||||
return "<div class=\"amount\">-</div>";
|
||||
}
|
||||
}
|
||||
|
||||
# Run the parent method
|
||||
return $self->SUPER::colval($col, %row);
|
||||
}
|
||||
|
||||
# pre_filter: Set the pre-defined filter
|
||||
# Make it a null function
|
||||
sub pre_filter : method { }
|
||||
|
||||
# html_report_query: Display the report query box
|
||||
sub html_report_query : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $request_file, $label, $curlist);
|
||||
$self = $_[0];
|
||||
$form = $self->{"FORM"};
|
||||
|
||||
$request_file = h($REQUEST_FILE);
|
||||
$label = h_abbr(C_("Query"));
|
||||
|
||||
$curlist = h($self->{"type"});
|
||||
print << "EOT";
|
||||
<form 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><input type="hidden" name="charset" value="<!--selima:charset-->" /><input
|
||||
type="submit" value="$label" />
|
||||
</p>
|
||||
</div>
|
||||
</form>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_select_subject: Display the subject search box
|
||||
sub html_select_subject : method {
|
||||
local ($_, %_);
|
||||
my ($self, $label, @subjs);
|
||||
my ($sql, $sth, $count, $row, $thiscol, $defcol);
|
||||
$self = $_[0];
|
||||
|
||||
# The subject
|
||||
$label = h_abbr(C_("Accounting subject:"));
|
||||
# Obtain all the using subjects
|
||||
$sql = "SELECT acctsubj.code FROM acctrecs"
|
||||
. " LEFT JOIN acctsubj ON acctrecs.subj=acctsubj.sn"
|
||||
. " GROUP BY acctsubj.code;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$count = $sth->rows;
|
||||
for (my $i = 0, @_ = qw(); $i < $count; $i++) {
|
||||
$row = $sth->fetchrow_hashref;
|
||||
push @_, $$row{"code"};
|
||||
}
|
||||
undef $sth;
|
||||
%_ = map { $_ => 1 } @_;
|
||||
# Add all of their parents
|
||||
foreach (keys %_) {
|
||||
$_{$_} = 1 while s/.$//;
|
||||
}
|
||||
delete $_{""};
|
||||
@_ = qw();
|
||||
push @_, "code AS value";
|
||||
if (@ALL_LINGUAS == 1) {
|
||||
push @_, $DBH->strcat("code", "' '", "title")
|
||||
. " AS content";
|
||||
} else {
|
||||
$thiscol = "title_" . getlang LN_DATABASE;
|
||||
if (getlang eq $DEFAULT_LANG) {
|
||||
push @_, $DBH->strcat("code", "' '", $thiscol)
|
||||
. " AS content";
|
||||
} else {
|
||||
$defcol = "title_" . ln($DEFAULT_LANG, LN_DATABASE);
|
||||
push @_, $DBH->strcat("code", "' '", "COALESCE($thiscol, $defcol)")
|
||||
. " AS content";
|
||||
}
|
||||
}
|
||||
$sql = "SELECT " . join(", ", @_) . " FROM acctsubj"
|
||||
. " WHERE " . join(" OR ", map "code=" . $DBH->quote($_), sort keys %_)
|
||||
. " ORDER BY code;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$count = $sth->rows;
|
||||
for (my $i = 0, @subjs = qw(); $i < $count; $i++) {
|
||||
push @subjs, {%{$sth->fetchrow_hashref}};
|
||||
}
|
||||
undef $sth;
|
||||
|
||||
# Display the form
|
||||
print << "EOT";
|
||||
<p>$label
|
||||
<select name="subj">
|
||||
EOT
|
||||
foreach (@subjs) {
|
||||
my ($val, $content, $selected);
|
||||
$val = h($$_{"value"});
|
||||
$content = h($$_{"content"});
|
||||
$selected = defined $self->{"subj"} && $self->{"subj"} eq $$_{"value"}?
|
||||
" selected=\"selected\"": "";
|
||||
print << "EOT";
|
||||
<option value="$val"$selected>$content</option>
|
||||
EOT
|
||||
}
|
||||
print << "EOT";
|
||||
</select>
|
||||
</p>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_data_download: Display the data download link
|
||||
sub html_data_download : method {
|
||||
local ($_, %_);
|
||||
my ($self, $url, $title);
|
||||
$self = $_[0];
|
||||
# No data
|
||||
return if $self->{"total"} == 0;
|
||||
# Construct the URL
|
||||
@_ = qw();
|
||||
push @_, "list=ldgrsum";
|
||||
push @_, "subj=" . uri_escape($self->{"subj"});
|
||||
push @_, "format=csv";
|
||||
$url = $REQUEST_FILE . "?" . join "&", @_;
|
||||
$title = h_abbr(C_("Download the data as a CSV file."));
|
||||
print << "EOT";
|
||||
<p><a href="$url">$title</a></p>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_csv: Return the data as CSV
|
||||
sub html_csv : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Output a header to suggest for download instead of display
|
||||
$HTTP_HEADERS{"Content-Disposition"} =
|
||||
"attachment; filename=ledger_summary.csv";
|
||||
$CONTENT_TYPE = "text/csv; charset=" . getlang LN_CHARSET;
|
||||
# The header column
|
||||
@_ = map((exists ${$self->{"col_labels"}}{$_}? ${$self->{"col_labels"}}{$_}: $_),
|
||||
@{$self->{"listcols"}});
|
||||
s/"/""/g foreach @_; # "
|
||||
print join(",", map "\"$_\"", @_) . "\n";
|
||||
# The data
|
||||
foreach my $current (@{$self->{"current"}}) {
|
||||
print join(",", map $$current{$_}, @{$self->{"listcols"}}) . "\n";
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# html_pagebar: Display a page navigation bar
|
||||
sub html_pagebar : method {
|
||||
local ($_, %_);
|
||||
my ($self, $rev, $r);
|
||||
$self = $_[0];
|
||||
$rev = $self->{"reverse"};
|
||||
$self->{"reverse"} = 1;
|
||||
# Run the parent method
|
||||
$r = $self->SUPER::html_pagebar;
|
||||
$self->{"reverse"} = $rev;
|
||||
return $r;
|
||||
}
|
||||
|
||||
return 1;
|
||||
120
lib/perl5/Selima/List/Accounting/Reports/Search.pm
Normal file
120
lib/perl5/Selima/List/Accounting/Reports/Search.pm
Normal file
@@ -0,0 +1,120 @@
|
||||
# Selima Website Content Management System
|
||||
# Search.pm: The accounting data search result list.
|
||||
|
||||
# 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-29
|
||||
|
||||
package Selima::List::Accounting::Reports::Search;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List::Accounting::Reports);
|
||||
|
||||
use Selima::DataVars qw(:l10n :lninfo);
|
||||
use Selima::GetLang;
|
||||
use Selima::Logging;
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
if (!defined $self->{"query"}) {
|
||||
$self->{"title"} = C_("Search the Accounting Records");
|
||||
} else {
|
||||
$self->{"title"} = C_("Search Result");
|
||||
}
|
||||
if (@ALL_LINGUAS == 1) {
|
||||
$self->{"view"} = "acctrep_search_list";
|
||||
} else {
|
||||
$self->{"view"} = "acctrep_search_list_" . getlang(LN_DATABASE);
|
||||
}
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"trxno" => C_("Transaction Number"),
|
||||
"note" => C_("Note"),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# fetch: Fetch the current list
|
||||
sub fetch : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# No search specified
|
||||
if (!defined $self->{"query"}) {
|
||||
$self->{"total"} = undef;
|
||||
return $self->{"error"};
|
||||
}
|
||||
# Check the query phrase
|
||||
# Regularize it
|
||||
$self->{"query"} =~ s/^\s*(.*?)\s*$/$1/;
|
||||
# Check if it is filled
|
||||
if ($self->{"query"} eq"") {
|
||||
$self->{"total"} = undef;
|
||||
$self->{"error"} = {"msg"=>N_("Please fill in your query.")};
|
||||
return $self->{"error"};
|
||||
}
|
||||
# Run the parent method
|
||||
$self->SUPER::fetch;
|
||||
# Set the columns to be displayed
|
||||
$self->{"listcols"} = [qw(date trxno subj summary debit credit note)];
|
||||
# Done
|
||||
return $self->{"error"};
|
||||
}
|
||||
|
||||
# check_pageno: Check the page number
|
||||
# Default to the last page
|
||||
sub check_pageno : method {
|
||||
local ($_, %_);
|
||||
my ($self, $rev);
|
||||
$self = $_[0];
|
||||
$rev = $self->{"reverse"};
|
||||
$self->{"reverse"} = 1;
|
||||
# Run the parent method
|
||||
$self->SUPER::check_pageno;
|
||||
$self->{"reverse"} = $rev;
|
||||
return;
|
||||
}
|
||||
|
||||
# pre_filter: Set the pre-defined filter
|
||||
# Make it a null function
|
||||
sub pre_filter : method { }
|
||||
|
||||
# html_report_query: Display the report query box
|
||||
# Make it a null function
|
||||
sub html_report_query : method { }
|
||||
|
||||
# html_pagebar: Display a page navigation bar
|
||||
# The first page needs a page number, because default to the last page
|
||||
sub html_pagebar : method {
|
||||
local ($_, %_);
|
||||
my ($self, $rev, $r);
|
||||
$self = $_[0];
|
||||
$rev = $self->{"reverse"};
|
||||
$self->{"reverse"} = 1;
|
||||
# Run the parent method
|
||||
$r = $self->SUPER::html_pagebar;
|
||||
$self->{"reverse"} = $rev;
|
||||
return $r;
|
||||
}
|
||||
|
||||
return 1;
|
||||
268
lib/perl5/Selima/List/Accounting/Reports/TriBlnc.pm
Normal file
268
lib/perl5/Selima/List/Accounting/Reports/TriBlnc.pm
Normal file
@@ -0,0 +1,268 @@
|
||||
# Selima Website Content Management System
|
||||
# TriBlnc.pm: The trial balance 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-29
|
||||
|
||||
package Selima::List::Accounting::Reports::TriBlnc;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List::Accounting::Reports);
|
||||
|
||||
use Selima::Accounting;
|
||||
use Selima::CommText;
|
||||
use Selima::DataVars qw($DBH :l10n :lninfo :output :requri);
|
||||
use Selima::GetLang;
|
||||
use Selima::LnInfo;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = C_("Trial Balance");
|
||||
# The list type
|
||||
$self->{"type"} = "tb";
|
||||
# The default number of rows per page
|
||||
$self->{"DEFAULT_LIST_SIZE"} = undef;
|
||||
$self->{"noselect"} = 1;
|
||||
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# fetch: Fetch the current list
|
||||
sub fetch : method {
|
||||
local ($_, %_);
|
||||
my ($self, @cols, $title, $sth, $sql, $error);
|
||||
$self = $_[0];
|
||||
|
||||
# Fetched before
|
||||
return $self->{"error"} if $self->{"fetched"};
|
||||
$self->{"fetched"} = 1;
|
||||
|
||||
# Initialize the error status
|
||||
$self->{"error"} = undef;
|
||||
$self->{"total"} = undef;
|
||||
|
||||
# Construct the SQL query statement
|
||||
# Obtain the period once
|
||||
$self->sql_filter;
|
||||
@cols = qw();
|
||||
if (@ALL_LINGUAS == 1) {
|
||||
$title = "acctsubj.title";
|
||||
} else {
|
||||
my ($lndb, $lndbdef);
|
||||
$lndb = getlang LN_DATABASE;
|
||||
if (getlang eq $DEFAULT_LANG) {
|
||||
$title = "acctsubj.title_$lndb";
|
||||
} else {
|
||||
$lndbdef = ln $DEFAULT_LANG, LN_DATABASE;
|
||||
$title = "COALESCE(acctsubj.title_$lndb, acctsubj.title_$lndbdef)";
|
||||
}
|
||||
}
|
||||
push @cols, "acctsubj.code AS code";
|
||||
push @cols, $DBH->strcat("acctsubj.code", "' '", $title) . " AS subj";
|
||||
push @cols, "sum(CASE WHEN acctrecs.credit THEN -acctrecs.amount ELSE acctrecs.amount END)"
|
||||
. " AS balance";
|
||||
$self->{"current"} = [];
|
||||
|
||||
# The real accounts
|
||||
$sql = "SELECT " . join(", ", @cols)
|
||||
. " FROM acctrecs"
|
||||
. " LEFT JOIN acctsubj ON acctrecs.subj=acctsubj.sn"
|
||||
. " LEFT JOIN accttrx ON acctrecs.trx=accttrx.sn"
|
||||
. " WHERE date<=" . $DBH->quote($self->{"enddate"})
|
||||
. " AND (acctsubj.code LIKE '1%'"
|
||||
. " OR acctsubj.code LIKE '2%'"
|
||||
. " OR acctsubj.code LIKE '3%')"
|
||||
. " GROUP BY acctsubj.code, $title"
|
||||
. " ORDER BY acctsubj.code;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
push @{$self->{"current"}}, $_
|
||||
while defined($_ = $sth->fetchrow_hashref);
|
||||
undef $sth;
|
||||
|
||||
# The nominal accounts
|
||||
$sql = "SELECT " . join(", ", @cols)
|
||||
. " FROM acctrecs"
|
||||
. " LEFT JOIN acctsubj ON acctrecs.subj=acctsubj.sn"
|
||||
. " LEFT JOIN accttrx ON acctrecs.trx=accttrx.sn"
|
||||
. " WHERE date>=" . $DBH->quote($self->{"startdate"})
|
||||
. " AND date<=" . $DBH->quote($self->{"enddate"})
|
||||
. " AND NOT (acctsubj.code LIKE '1%'"
|
||||
. " OR acctsubj.code LIKE '2%'"
|
||||
. " OR acctsubj.code LIKE '3%')"
|
||||
. " GROUP BY acctsubj.code, $title"
|
||||
. " ORDER BY acctsubj.code;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
push @{$self->{"current"}}, $_
|
||||
while defined($_ = $sth->fetchrow_hashref);
|
||||
undef $sth;
|
||||
|
||||
# Obtain the carry-over record of assets/liabilities
|
||||
$_ = "sum(CASE WHEN acctrecs.credit THEN -acctrecs.amount ELSE acctrecs.amount END)"
|
||||
. " AS balance";
|
||||
$sql = "SELECT $_ FROM acctrecs"
|
||||
. " LEFT JOIN acctsubj ON acctrecs.subj=acctsubj.sn"
|
||||
. " LEFT JOIN accttrx ON acctrecs.trx=accttrx.sn"
|
||||
. " WHERE (acctsubj.code LIKE '1%'"
|
||||
. " OR acctsubj.code LIKE '2%'"
|
||||
. " OR acctsubj.code LIKE '3%')"
|
||||
. " AND accttrx.date<" . $DBH->quote($self->{"startdate"}) . ";\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$_ = $sth->fetchrow_hashref;
|
||||
undef $sth;
|
||||
if (defined $$_{"balance"}) {
|
||||
push @{$self->{"current"}}, {
|
||||
"subj" => acctsubj_title(acctsubj_sn(ACCTSUBJ_INCOME_ACUM)),
|
||||
"balance" => -$$_{"balance"},
|
||||
};
|
||||
}
|
||||
|
||||
# Sort by the subject
|
||||
$self->{"current"} = [ sort { $$a{"subj"} cmp $$b{"subj"} } @{$self->{"current"}} ];
|
||||
|
||||
# Set the debit and credit amount
|
||||
if (@{$self->{"current"}} > 0) {
|
||||
my ($sumdebit, $sumcredit, $viewurl);
|
||||
($sumdebit, $sumcredit) = (0, 0);
|
||||
@_ = qw();
|
||||
push @_, "list=ldgr";
|
||||
push @_, "subj=%s";
|
||||
push @_, $self->{"actrange"};
|
||||
$viewurl = $REQUEST_FILE . "?" . join "&", @_;
|
||||
foreach (@{$self->{"current"}}) {
|
||||
$$_{"_viewurl"} = sprintf $viewurl, $$_{"code"};
|
||||
delete $$_{"code"};
|
||||
if ($$_{"balance"} > 0) {
|
||||
$$_{"debit"} = $$_{"balance"};
|
||||
$$_{"credit"} = 0;
|
||||
$sumdebit += $$_{"debit"};
|
||||
} elsif ($$_{"balance"} < 0) {
|
||||
$$_{"debit"} = 0;
|
||||
$$_{"credit"} = -$$_{"balance"};
|
||||
$sumcredit += $$_{"credit"};
|
||||
} else {
|
||||
$$_{"debit"} = 0;
|
||||
$$_{"credit"} = 0;
|
||||
}
|
||||
delete $_{"balance"};
|
||||
}
|
||||
# Append the total record
|
||||
if (@{$self->{"current"}} > 0) {
|
||||
push @{$self->{"current"}}, {
|
||||
"_viewurl" => undef,
|
||||
"subj" => C_("Total"),
|
||||
"debit" => $sumdebit,
|
||||
"credit" => $sumcredit,
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
# The number of rows per page
|
||||
$self->{"pagesize"} = $self->{"DEFAULT_LIST_SIZE"};
|
||||
# Paging not in use
|
||||
$self->{"total"} = scalar(@{$self->{"current"}});
|
||||
$self->{"lastpage"} = 1;
|
||||
$self->{"startno"} = 0;
|
||||
$self->{"endno"} = $self->{"total"} - 1;
|
||||
# If endno is -1 (when total is 0), set to 0
|
||||
$self->{"endno"} = 0 if $self->{"endno"} < 0;
|
||||
|
||||
# Set the columns to be displayed
|
||||
$self->{"cols"} = [qw(_viewurl subj debit credit)];
|
||||
$self->{"listcols"} = [qw(subj debit credit)];
|
||||
|
||||
# Done
|
||||
return $self->{"error"};
|
||||
}
|
||||
|
||||
# html_data_download: Display the data download link
|
||||
sub html_data_download : method {
|
||||
local ($_, %_);
|
||||
my ($self, $url, $title);
|
||||
$self = $_[0];
|
||||
# No data
|
||||
return if $self->{"total"} == 0;
|
||||
# Construct the URL
|
||||
@_ = qw();
|
||||
push @_, "list=tb";
|
||||
push @_, $self->{"actrange"};
|
||||
push @_, "format=csv";
|
||||
$url = $REQUEST_FILE . "?" . join "&", @_;
|
||||
$title = h_abbr(C_("Download the data as a CSV file."));
|
||||
print << "EOT";
|
||||
<p><a href="$url">$title</a></p>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_csv: Return the data as CSV
|
||||
sub html_csv : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Output a header to suggest for download instead of display
|
||||
$HTTP_HEADERS{"Content-Disposition"} =
|
||||
"attachment; filename=trial_balance.csv";
|
||||
$CONTENT_TYPE = "text/csv; charset=" . getlang LN_CHARSET;
|
||||
# The header column
|
||||
@_ = map((exists ${$self->{"col_labels"}}{$_}? ${$self->{"col_labels"}}{$_}: $_),
|
||||
@{$self->{"listcols"}});
|
||||
s/"/""/g foreach @_; # "
|
||||
print join(",", map "\"$_\"", @_) . "\n";
|
||||
# The data
|
||||
foreach my $current (@{$self->{"current"}}) {
|
||||
@_ = map $$current{$_}, @{$self->{"listcols"}};
|
||||
foreach (@_) {
|
||||
$_ = "" if !defined $_;
|
||||
s/"/""/g; # "
|
||||
}
|
||||
print join(",", map "\"$_\"", @_) . "\n";
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# html_listprefform: Display a form to change the list preference
|
||||
# Make it a null function
|
||||
sub html_listprefform : method {}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my ($self, $total);
|
||||
$self = $_[0];
|
||||
|
||||
$total = $self->{"total"};
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message if $self->{"total"} == 0;
|
||||
return C_("[*,_1,accounting subject].", $self->{"total"} - 1);
|
||||
}
|
||||
|
||||
return 1;
|
||||
Reference in New Issue
Block a user