Initial commit.
This commit is contained in:
121
lib/perl5/Selima/List/Accounting/Records.pm
Normal file
121
lib/perl5/Selima/List/Accounting/Records.pm
Normal file
@@ -0,0 +1,121 @@
|
||||
# Selima Website Content Management System
|
||||
# Records.pm: The accounting record 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-23
|
||||
|
||||
package Selima::List::Accounting::Records;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use Selima::CommText;
|
||||
use Selima::Format;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "acctrecs" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}?
|
||||
C_("Select an Accounting Record"):
|
||||
C_("Manage Accounting Records");
|
||||
# The default sort order
|
||||
$self->{"DEFAULT_SORTBY"} = "trx";
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"trx" => C_("Accounting transaction"),
|
||||
"credit" => C_("Debit/credit"),
|
||||
"subj" => C_("Accounting subject"),
|
||||
"summary" => C_("Summary"),
|
||||
"amount" => C_("Amount"),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# html_newlink: Display a link to add a new item
|
||||
sub html_newlink : method {
|
||||
local ($_, %_);
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_newlink(C_("Add a new accounting record."));
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_search(C_("Search for an accounting record:"));
|
||||
}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
|
||||
# No record to list
|
||||
if ($self->{"total"} == 0) {
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message;
|
||||
# Fit in one page
|
||||
} elsif ($self->{"total"} <= $self->{"pagesize"}) {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,accounting record].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,accounting record].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,accounting record], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,accounting record], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# 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 "amount") {
|
||||
return "<div class=\"amount\">"
|
||||
. h_abbr(fmtntamount $row{$col}) . "</div>";
|
||||
}
|
||||
|
||||
# Run the parent method
|
||||
return $self->SUPER::colval($col, %row);
|
||||
}
|
||||
|
||||
return 1;
|
||||
667
lib/perl5/Selima/List/Accounting/Reports.pm
Normal file
667
lib/perl5/Selima/List/Accounting/Reports.pm
Normal file
@@ -0,0 +1,667 @@
|
||||
# Selima Website Content Management System
|
||||
# Reports.pm: The base accounting report.
|
||||
|
||||
# Copyright (c) 2007-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2007-09-24
|
||||
|
||||
package Selima::List::Accounting::Reports;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use Time::Local qw(timelocal);
|
||||
|
||||
use Selima::AddGet;
|
||||
use Selima::CommText;
|
||||
use Selima::ChkFunc;
|
||||
use Selima::DataVars qw($DBH :input :requri);
|
||||
use Selima::Format;
|
||||
use Selima::LogIn;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class, $sql, $sth);
|
||||
($class, @_) = @_;
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = C_("View the Accounting Reports");
|
||||
# Known columns that should not be displayed (has a special purpose)
|
||||
push @{$self->{"COLS_NO_DISPLAY"}}, qw(_subj _date _trx);
|
||||
# Known columns that should not be sorted with
|
||||
# List sorting is disabled here at all
|
||||
push @{$self->{"COLS_NO_SORT_BY"}}, qw(date month trxno subj summary
|
||||
income expense debit credit balance note);
|
||||
# The list type
|
||||
$self->{"type"} = $self->{"FORM"}->param("list");
|
||||
# The date range
|
||||
$self->{"range"} = $self->{"FORM"}->param("r");
|
||||
# The onload event handler
|
||||
$self->{"onload"} = "acctRepQueryDisableNoUseRanges();";
|
||||
# Should we return the data as CSV
|
||||
$self->{"iscsv"} = 0;
|
||||
$self->{"iscsv"} = 1
|
||||
if defined($_ = $self->{"FORM"}->param("format")) && $_ eq "csv";
|
||||
# If the database is empty
|
||||
$sql = "SELECT sn FROM accttrx LIMIT 1;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$self->{"nodata"} = ($sth->rows == 0);
|
||||
# The full period - used in all reports
|
||||
if (!$self->{"nodata"}) {
|
||||
# The earliest start date
|
||||
$sql = "SELECT date FROM accttrx ORDER BY date LIMIT 1;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
@_ = localtime ${$sth->fetchrow_hashref}{"date"};
|
||||
$self->{"startdate"} = sprintf "%04d-%02d-%02d",
|
||||
$_[5] + 1900, $_[4] + 1, $_[3];
|
||||
# The latest end date
|
||||
$sql = "SELECT date FROM accttrx ORDER BY date DESC LIMIT 1;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
@_ = localtime ${$sth->fetchrow_hashref}{"date"};
|
||||
$self->{"enddate"} = sprintf "%04d-%02d-%02d",
|
||||
$_[5] + 1900, $_[4] + 1, $_[3];
|
||||
}
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"month" => C_("Month"),
|
||||
"subj" => C_("Accounting subject"),
|
||||
"summary" => C_("Summary"),
|
||||
"debit" => C_("Debit"),
|
||||
"credit" => C_("Credit"),
|
||||
"income" => C_("Income"),
|
||||
"expense" => C_("Expense"),
|
||||
"balance" => C_("Balance"),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# fetch: Fetch the current list
|
||||
sub fetch : method {
|
||||
return if !defined $_[0]->{"type"};
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::fetch;
|
||||
}
|
||||
|
||||
# colval: Output a list column value
|
||||
sub colval : method {
|
||||
local ($_, %_);
|
||||
my ($self, $col, %row);
|
||||
($self, $col, %row) = @_;
|
||||
|
||||
# Null/no value
|
||||
return h(t_notset()) if !defined $row{$col};
|
||||
|
||||
# The debit and the credit
|
||||
if ( $col eq "debit" || $col eq "credit"
|
||||
|| $col eq "income" || $col eq "expense") {
|
||||
return "" if $row{$col} == 0;
|
||||
return "<div class=\"amount\">"
|
||||
. h_abbr(fmtntamount $row{$col}) . "</div>";
|
||||
}
|
||||
|
||||
# Run the parent method
|
||||
return $self->SUPER::colval($col, %row);
|
||||
}
|
||||
|
||||
# pre_filter: Set the pre-defined filter
|
||||
sub pre_filter : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, @conds, $year, $month, $day, $from, $to);
|
||||
my ($sql, $sth, $startdate);
|
||||
$self = $_[0];
|
||||
$form = $self->{"FORM"};
|
||||
|
||||
# No need to run if there is no data at all
|
||||
return undef if $self->{"nodata"};
|
||||
|
||||
@conds = qw();
|
||||
# The active range that is affecting this list
|
||||
$self->{"actrange"} = undef;
|
||||
# Range specified
|
||||
if (defined $self->{"range"}) {
|
||||
# By month
|
||||
if ($self->{"range"} eq "m") {
|
||||
# Trim the value
|
||||
if (defined($_ = $form->param("m"))) {
|
||||
s/^\s+//;
|
||||
s/\s+$//;
|
||||
$form->param("m", $_);
|
||||
}
|
||||
if (!defined $form->param("m") || $form->param("m") eq "") {
|
||||
$self->{"error"} = {"msg"=>N_("Please specify a month.")}
|
||||
if !defined $self->{"error"};
|
||||
} elsif ( $form->param("m") !~ /^(\d{4})-(\d{2})$/
|
||||
|| !check_date($year = $1, $month = $2, 1)) {
|
||||
$self->{"error"} = {"msg"=>N_("Please specify a valid month in YYYY-MM format.")}
|
||||
if !defined $self->{"error"};
|
||||
} else {
|
||||
$from = sprintf "%04d-%02d-%02d", $year, $month, 1;
|
||||
$self->{"startdate"} = $from
|
||||
if ($self->{"startdate"} cmp $from) < 0;
|
||||
# The next month
|
||||
$month++;
|
||||
if ($month > 12) {
|
||||
$year++;
|
||||
$month = 1;
|
||||
}
|
||||
# The previous day before the first day of next month
|
||||
# - The last day of this month
|
||||
$_ = timelocal(0, 0, 0, 1, $month - 1, $year - 1900);
|
||||
$_ -= 86400;
|
||||
@_ = localtime $_;
|
||||
$to = sprintf "%04d-%02d-%02d",
|
||||
$_[5] + 1900, $_[4] + 1, $_[3];
|
||||
$self->{"enddate"} = $to
|
||||
if ($self->{"enddate"} cmp $to) > 0;
|
||||
push @conds, "date>=" . $DBH->quote($self->{"startdate"});
|
||||
push @conds, "date<=" . $DBH->quote($self->{"enddate"});
|
||||
$self->{"actrange"} = "r=m&m=" . $form->param("m");
|
||||
}
|
||||
|
||||
# By year
|
||||
} elsif ($self->{"range"} eq "y") {
|
||||
# Trim the value
|
||||
if (defined($_ = $form->param("y"))) {
|
||||
s/^\s+//;
|
||||
s/\s+$//;
|
||||
$form->param("y", $_);
|
||||
}
|
||||
if (!defined $form->param("y") || $form->param("y") eq "") {
|
||||
$self->{"error"} = {"msg"=>N_("Please specify a year.")}
|
||||
if !defined $self->{"error"};
|
||||
} elsif ( ($_ = $form->param("y")) !~ /^\d{4}$/
|
||||
|| !check_date($_, 1, 1)) {
|
||||
$self->{"error"} = {"msg"=>N_("Please specify a valid year in YYYY format.")}
|
||||
if !defined $self->{"error"};
|
||||
} else {
|
||||
$from = sprintf "%04d-%02d-%02d", $_, 1, 1;
|
||||
$self->{"startdate"} = $from
|
||||
if ($self->{"startdate"} cmp $from) < 0;
|
||||
$to = sprintf "%04d-%02d-%02d", $_, 12, 31;
|
||||
$self->{"enddate"} = $to
|
||||
if ($self->{"enddate"} cmp $to) > 0;
|
||||
push @conds, "date>=" . $DBH->quote($self->{"startdate"});
|
||||
push @conds, "date<=" . $DBH->quote($self->{"enddate"});
|
||||
$self->{"actrange"} = "r=y&y=" . $form->param("y");
|
||||
}
|
||||
|
||||
# Specified reange
|
||||
} elsif ($self->{"range"} eq "s") {
|
||||
my @actrange;
|
||||
@actrange = qw();
|
||||
# Trim the value
|
||||
if (defined($_ = $form->param("f"))) {
|
||||
s/^\s+//;
|
||||
s/\s+$//;
|
||||
$form->param("f", $_);
|
||||
}
|
||||
if (defined($_ = $form->param("t"))) {
|
||||
s/^\s+//;
|
||||
s/\s+$//;
|
||||
$form->param("t", $_);
|
||||
}
|
||||
# The start day
|
||||
if (!defined $form->param("f") || $form->param("f") eq "") {
|
||||
$self->{"error"} = {"msg"=>N_("Please specify the start date.")}
|
||||
if !defined $self->{"error"};
|
||||
} elsif ( $form->param("f") !~ /^(\d{4})-(\d{2})-(\d{2})$/
|
||||
|| !check_date($year = $1, $month = $2, $day =$3)) {
|
||||
$self->{"error"} = {"msg"=>N_("Please specify a valid start date in YYYY-MM-DD format.")}
|
||||
if !defined $self->{"error"};
|
||||
} else {
|
||||
$from = sprintf "%04d-%02d-%02d", $year, $month, $day;
|
||||
$self->{"startdate"} = $from
|
||||
if ($self->{"startdate"} cmp $from) < 0;
|
||||
push @conds, "date>=" . $DBH->quote($self->{"startdate"});
|
||||
push @actrange, "f=" . $form->param("f");
|
||||
}
|
||||
# The end day
|
||||
if (!defined $form->param("t") || $form->param("t") eq "") {
|
||||
$self->{"error"} = {"msg"=>N_("Please specify the end date.")};
|
||||
} elsif ( $form->param("t") !~ /^(\d{4})-(\d{2})-(\d{2})$/
|
||||
|| !check_date($year = $1, $month = $2, $day =$3)) {
|
||||
$self->{"error"} = {"msg"=>N_("Please specify a valid end date in YYYY-MM-DD format.")}
|
||||
if !defined $self->{"error"};
|
||||
} else {
|
||||
$to = sprintf "%04d-%02d-%02d", $year, $month, $day;
|
||||
$self->{"enddate"} = $to
|
||||
if ($self->{"enddate"} cmp $to) > 0;
|
||||
push @conds, "date<=" . $DBH->quote($self->{"enddate"});
|
||||
push @actrange, "t=" . $form->param("t");
|
||||
}
|
||||
if (@actrange > 0) {
|
||||
unshift @actrange, "r=s";
|
||||
$self->{"actrange"} = join "&", @actrange;
|
||||
}
|
||||
|
||||
# All
|
||||
} elsif ($self->{"range"} eq "a") {
|
||||
# No condition is applied here
|
||||
$self->{"actrange"} = "r=a";
|
||||
|
||||
# Else
|
||||
} else {
|
||||
$self->{"error"} = {"msg"=>N_("This option is invalid. Please select a proper date range.")}
|
||||
if !defined $self->{"error"};
|
||||
}
|
||||
}
|
||||
# Range not set - default to the current month
|
||||
if (!defined $self->{"actrange"}) {
|
||||
($year, $month) = (localtime)[5,4];
|
||||
$year += 1900;
|
||||
$month++;
|
||||
$from = sprintf "%04d-%02d-%02d", $year, $month, 1;
|
||||
$self->{"startdate"} = $from
|
||||
if ($self->{"startdate"} cmp $from) < 0;
|
||||
$self->{"actrange"} = "r=m&m=" . sprintf("%04d-%02d", $year, $month);
|
||||
$month++;
|
||||
if ($month > 12) {
|
||||
$year++;
|
||||
$month = 1;
|
||||
}
|
||||
# The previous day before the first day of next month
|
||||
# - The last day of this month
|
||||
$_ = timelocal(0, 0, 0, 1, $month - 1, $year - 1900);
|
||||
$_ -= 86400;
|
||||
@_ = localtime $_;
|
||||
$to = sprintf "%04d-%02d-%02d",
|
||||
$_[5] + 1900, $_[4] + 1, $_[3];
|
||||
$self->{"enddate"} = $to
|
||||
if ($self->{"enddate"} cmp $to) > 0;
|
||||
push @conds, "date>=" . $DBH->quote($self->{"startdate"});
|
||||
push @conds, "date<=" . $DBH->quote($self->{"enddate"});
|
||||
}
|
||||
# Th end date should not be before the first date
|
||||
$self->{"enddate"} = $self->{"startdate"}
|
||||
if exists $self->{"startdate"} && exists $self->{"enddate"}
|
||||
&& ($self->{"startdate"} cmp $self->{"enddate"}) > 0;
|
||||
return undef if @conds == 0;
|
||||
return join " AND ", @conds;
|
||||
}
|
||||
|
||||
# html: Output the list
|
||||
sub html : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Fetch the current list if not fetched yet
|
||||
$self->fetch if !$self->{"fetched"};
|
||||
# Download the CSV
|
||||
return $self->html_csv if $self->{"iscsv"} && $self->can("html_csv");
|
||||
# Run the parent method
|
||||
return $self->SUPER::html;
|
||||
}
|
||||
|
||||
# set_listpref: Set the list preference
|
||||
sub set_listpref : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
$_ = new Selima::ListPref::AcctReps($self->{"FORM"});
|
||||
$_->main;
|
||||
}
|
||||
|
||||
# html_newlink: Display a link to add a new item
|
||||
sub html_newlink : method {
|
||||
local ($_, %_);
|
||||
my ($self, $urle, $urli, $urlt, $prompt);
|
||||
$self = $_[0];
|
||||
|
||||
$urle = "accttrx.cgi?form=new&formsub=expense";
|
||||
$urli = "accttrx.cgi?form=new&formsub=income";
|
||||
$urlt = "accttrx.cgi?form=new&formsub=trans";
|
||||
$prompt = C_("<a href=\"[_1]\">Add a new cash expense transaction</a>, <a href=\"[_2]\">add a new cash income transaction</a> or <a href=\"[_3]\">add a new transfer transaction</a>.",
|
||||
h($urle), h($urli), h($urlt));
|
||||
|
||||
print << "EOT";
|
||||
<p>$prompt</p>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_lists_switch: Display the switch for different lists
|
||||
sub html_lists_switch : method {
|
||||
local ($_, %_);
|
||||
my ($self, $labellist, @lists);
|
||||
$self = $_[0];
|
||||
|
||||
# No need to run if there is no data at all
|
||||
return if $self->{"nodata"};
|
||||
|
||||
# Switch for different lists
|
||||
$labellist = h_abbr(C_("Report type:"));
|
||||
@lists = qw();
|
||||
push @lists, {
|
||||
"type" => "cash",
|
||||
"title" => C_("Cash book"),
|
||||
};
|
||||
push @lists, {
|
||||
"type" => "cashsum",
|
||||
"title" => C_("Cash book summary"),
|
||||
};
|
||||
push @lists, {
|
||||
"type" => "ldgr",
|
||||
"title" => C_("Ledger"),
|
||||
};
|
||||
push @lists, {
|
||||
"type" => "ldgrsum",
|
||||
"title" => C_("Ledger summary"),
|
||||
};
|
||||
push @lists, {
|
||||
"type" => "journal",
|
||||
"title" => C_("Journal"),
|
||||
};
|
||||
push @lists, {
|
||||
"type" => "tb",
|
||||
"title" => C_("Trial balance"),
|
||||
};
|
||||
push @lists, {
|
||||
"type" => "incmstat",
|
||||
"title" => C_("Income statement"),
|
||||
};
|
||||
push @lists, {
|
||||
"type" => "blncshet",
|
||||
"title" => C_("Balance sheet"),
|
||||
};
|
||||
|
||||
# Display the form
|
||||
print << "EOT";
|
||||
<p>$labellist
|
||||
EOT
|
||||
@_ = qw();
|
||||
foreach (@lists) {
|
||||
if (defined $self->{"type"} && $self->{"type"} eq $$_{"type"}) {
|
||||
push @_, h($$_{"title"});
|
||||
} else {
|
||||
push @_, sprintf("<a href=\"%s\">%s</a>",
|
||||
h($REQUEST_FILE . "?list=" . $$_{"type"}),
|
||||
h($$_{"title"}));
|
||||
}
|
||||
}
|
||||
print join(" |\n", @_) . "\n";
|
||||
print << "EOT";
|
||||
</p>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
local ($_, %_);
|
||||
my ($self, $prompt, $label, $query, $request_file);
|
||||
($self, $prompt) = @_;
|
||||
|
||||
# No need to run if there is no data at all
|
||||
return if $self->{"nodata"};
|
||||
|
||||
# Display the report query box
|
||||
$self->html_report_query;
|
||||
|
||||
$prompt = C_("Search the accounting records:") if !defined $prompt;
|
||||
$prompt = h($prompt);
|
||||
$request_file = h($REQUEST_FILE);
|
||||
$query = defined $self->{"query"}? h($self->{"query"}): "";
|
||||
$label = h(C_("Search"));
|
||||
|
||||
print << "EOT";
|
||||
<form action="$request_file" method="get" accept-charset="<!--selima:charset-->">
|
||||
<div class="searchbox">
|
||||
<input type="hidden" name="list" value="search" />
|
||||
<label for="query">$prompt</label>
|
||||
<input id="query" type="text" name="query" value="$query" /><input
|
||||
type="hidden" name="charset" value="<!--selima:charset-->" /><input
|
||||
type="submit" value="$label" />
|
||||
</div>
|
||||
</form>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_report_query: Display the report query box
|
||||
sub html_report_query : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $request_file, $label, $curlist);
|
||||
my ($labelmonth, $labelyear, $labelspecified, $labelall);
|
||||
my ($labelfrom, $labelto, $labelrange);
|
||||
my ($valrm, $valry, $valrs, $valra);
|
||||
my ($valm, $valy, $valf, $valt);
|
||||
my ($sql, $sth, $count, $row);
|
||||
$self = $_[0];
|
||||
$form = $self->{"FORM"};
|
||||
|
||||
$request_file = h($REQUEST_FILE);
|
||||
$label = h_abbr(C_("Query"));
|
||||
$labelrange = h_abbr(C_("Date range:"));
|
||||
$labelmonth = h_abbr(C_("By month:"));
|
||||
$labelyear = h_abbr(C_("By year:"));
|
||||
$labelspecified = h_abbr(C_("Specified date range:"));
|
||||
$labelall = h_abbr(C_("All"));
|
||||
$labelfrom = h_abbr(C_("From"));
|
||||
$labelto = h_abbr(C_("to"));
|
||||
|
||||
# Whether each radio button is checked
|
||||
($valrm, $valry, $valrs, $valra) = ("", "", "", "");
|
||||
if (defined $self->{"range"}) {
|
||||
$valrm = " checked=\"checked\""
|
||||
if $self->{"range"} eq "m";
|
||||
$valry = " checked=\"checked\""
|
||||
if $self->{"range"} eq "y";
|
||||
$valrs = " checked=\"checked\""
|
||||
if $self->{"range"} eq "s";
|
||||
$valra = " checked=\"checked\""
|
||||
if $self->{"range"} eq "a";
|
||||
# Default to this month
|
||||
} else {
|
||||
$valrm = " checked=\"checked\"";
|
||||
}
|
||||
# The value of each range
|
||||
@_ = localtime;
|
||||
$_[5] += 1900;
|
||||
$_[4]++;
|
||||
$valm = defined $form->param("m")? h($form->param("m")):
|
||||
sprintf("%04d-%02d", @_[5,4]);
|
||||
$valy = defined $form->param("y")? h($form->param("y")): $_[5];
|
||||
$valf = defined $form->param("f")? h($form->param("f")):
|
||||
sprintf("%04d-%02d-%02d", @_[5,4,3]);
|
||||
$valt = defined $form->param("t")? h($form->param("t")):
|
||||
sprintf("%04d-%02d-%02d", @_[5,4,3]);
|
||||
|
||||
$curlist = h($self->{"type"});
|
||||
print << "EOT";
|
||||
<form id="acctrepquery" action="$request_file" method="get" accept-charset="<!--selima:charset-->">
|
||||
<div class="acctrepquery">
|
||||
<div><input type="hidden" name="list" value="$curlist" /></div>
|
||||
|
||||
EOT
|
||||
# Display the subject selection if available
|
||||
$self->html_select_subject if $self->can("html_select_subject");
|
||||
|
||||
print << "EOT";
|
||||
<p>$labelrange
|
||||
<input id="rangemonth" type="radio" name="r" value="m"$valrm onchange="acctRepQueryDisableNoUseRanges();" /><label
|
||||
for="rangemonth">$labelmonth</label><select
|
||||
name="m">
|
||||
EOT
|
||||
$sql = "SELECT extract(year FROM date) AS year, extract(month FROM date) AS month FROM accttrx"
|
||||
. " GROUP BY extract(year FROM date), extract(month FROM date)"
|
||||
. " ORDER BY extract(year FROM date) DESC, extract(month FROM date) DESC;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$count = $sth->rows;
|
||||
for (my $i = 0, @_ = qw(); $i < $count; $i++) {
|
||||
my ($val, $selected);
|
||||
$row = $sth->fetchrow_hashref;
|
||||
$_ = sprintf "%04d-%02d", $$row{"year"}, $$row{"month"};
|
||||
$val = h($_);
|
||||
$selected = $valm eq $_? " selected=\"selected\"": "";
|
||||
print << "EOT";
|
||||
<option value="$val"$selected>$_</option>
|
||||
EOT
|
||||
}
|
||||
print << "EOT";
|
||||
</select>
|
||||
<input id="rangeyear" type="radio" name="r" value="y"$valry onchange="acctRepQueryDisableNoUseRanges();" /><label
|
||||
for="rangeyear">$labelyear</label><select
|
||||
name="y">
|
||||
EOT
|
||||
$sql = "SELECT extract(year FROM date) AS year FROM accttrx"
|
||||
. " GROUP BY extract(year FROM date)"
|
||||
. " ORDER BY extract(year FROM date) DESC;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$count = $sth->rows;
|
||||
for (my $i = 0, @_ = qw(); $i < $count; $i++) {
|
||||
my ($val, $selected);
|
||||
$row = $sth->fetchrow_hashref;
|
||||
$_ = $$row{"year"};
|
||||
$val = h($_);
|
||||
$selected = $valy eq $_? " selected=\"selected\"": "";
|
||||
print << "EOT";
|
||||
<option value="$val"$selected>$_</option>
|
||||
EOT
|
||||
}
|
||||
print << "EOT";
|
||||
</select>
|
||||
<input id="rangespecified" type="radio" name="r" value="s"$valrs onchange="acctRepQueryDisableNoUseRanges();" /><label
|
||||
for="rangespecified">$labelspecified</label><label
|
||||
for="rangestart">$labelfrom</label><input
|
||||
id="rangestart" type="text" name="f" value="$valf" size="10" /><label
|
||||
for="rangeend">$labelto</label><input
|
||||
id="rangeend" type="text" name="t" value="$valt" size="10" />
|
||||
<input id="rangeall" type="radio" name="r" value="a"$valra onchange="acctRepQueryDisableNoUseRanges();" /><label
|
||||
for="rangeall">$labelall</label>
|
||||
</p>
|
||||
|
||||
<p><input type="hidden" name="charset" value="<!--selima:charset-->" /><input
|
||||
type="submit" value="$label" />
|
||||
</p>
|
||||
</div>
|
||||
</form>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_liststat: Display the list statistics
|
||||
sub html_liststat : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Print the current time period
|
||||
if (!$self->{"nodata"}) {
|
||||
my ($message, $from, $to);
|
||||
($from, $to) = ($self->{"startdate"}, $self->{"enddate"});
|
||||
$message = h(C_("From [_1] to [_2].", $from, $to));
|
||||
|
||||
print << "EOT";
|
||||
<p>$message</p>
|
||||
|
||||
EOT
|
||||
}
|
||||
# Run the parent method
|
||||
return $self->SUPER::html_liststat;
|
||||
}
|
||||
|
||||
# html_listprefform: Display a form to change the list preference
|
||||
sub html_listprefform : method {
|
||||
local ($_, %_);
|
||||
my ($self, $submit, $referer, $request_file_h, $domain);
|
||||
my ($label, $pagesize);
|
||||
$self = $_[0];
|
||||
|
||||
# Do not show the list
|
||||
return if !defined $self->{"total"};
|
||||
# No record to be listed
|
||||
return if $self->{"total"} == 0;
|
||||
# Return if users preferences are not available
|
||||
return if !use_users || !defined $SESSION;
|
||||
$submit = C_("Set");
|
||||
# The referer
|
||||
$referer = h(rem_get_arg $REQUEST_FULLURI, "statid");
|
||||
|
||||
$request_file_h = h($REQUEST_FILE);
|
||||
# The domain -- my class name
|
||||
$domain = h(ref($self));
|
||||
|
||||
print << "EOT";
|
||||
<form action="$request_file_h" method="post" accept-charset="<!--selima:charset-->">
|
||||
<div><input type="hidden" name="charset" value="<!--selima:charset-->" /><input
|
||||
type="hidden" name="form" value="listpref" /><input
|
||||
type="hidden" name="referer" value="$referer" /><input
|
||||
type="hidden" name="domain" value="$domain" />
|
||||
EOT
|
||||
|
||||
# The number of rows per page
|
||||
$label = h_abbr(C_("Rows per page:"));
|
||||
$pagesize = h($self->{"pagesize"});
|
||||
print << "EOT";
|
||||
<label for="listsize">$label</label><input
|
||||
id="listsize" type="text" name="listsize" size="5" maxlength="5" value="$pagesize" />
|
||||
EOT
|
||||
|
||||
print << "EOT";
|
||||
<input type="submit" name="confirm" value="$submit" /></div>
|
||||
</form>
|
||||
|
||||
EOT
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
|
||||
# No record to list
|
||||
if ($self->{"total"} == 0) {
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message;
|
||||
# Fit in one page
|
||||
} elsif ($self->{"total"} <= $self->{"pagesize"}) {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,accounting record].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,accounting record].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,accounting record], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,accounting record], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
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;
|
||||
95
lib/perl5/Selima/List/Accounting/Subjects.pm
Normal file
95
lib/perl5/Selima/List/Accounting/Subjects.pm
Normal file
@@ -0,0 +1,95 @@
|
||||
# Selima Website Content Management System
|
||||
# Subjects.pm: The accounting subject 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-08-23
|
||||
|
||||
package Selima::List::Accounting::Subjects;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "acctsubj" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}?
|
||||
C_("Select an Accounting Subject"):
|
||||
C_("Manage Accounting Subjects");
|
||||
# The default sort order
|
||||
$self->{"DEFAULT_SORTBY"} = "code";
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"parent" => C_("Parent subject"),
|
||||
"code" => C_("Code"),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# html_newlink: Display a link to add a new item
|
||||
sub html_newlink : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_newlink(C_("Add a new accounting subject."));
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_search(C_("Search for an accounting subject:"));
|
||||
}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
|
||||
# No record to list
|
||||
if ($self->{"total"} == 0) {
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message;
|
||||
# Fit in one page
|
||||
} elsif ($self->{"total"} <= $self->{"pagesize"}) {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,accounting subject].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,accounting subject].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,accounting subject], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,accounting subject], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
45
lib/perl5/Selima/List/Accounting/Subjects/LastLv.pm
Normal file
45
lib/perl5/Selima/List/Accounting/Subjects/LastLv.pm
Normal file
@@ -0,0 +1,45 @@
|
||||
# Selima Website Content Management System
|
||||
# LastLv.pm: The last-level accounting subject 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-22
|
||||
|
||||
package Selima::List::Accounting::Subjects::LastLv;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List::Accounting::Subjects);
|
||||
|
||||
use Selima::DataVars qw(:l10n :lninfo);
|
||||
use Selima::GetLang;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "acctsubj" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
if (@ALL_LINGUAS == 1) {
|
||||
$self->{"view"} = "acctsubj_lastlv_list";
|
||||
} else {
|
||||
$self->{"view"} = "acctsubj_lastlv_list_" . getlang LN_DATABASE;
|
||||
}
|
||||
return $self;
|
||||
}
|
||||
|
||||
return 1;
|
||||
116
lib/perl5/Selima/List/Accounting/Transacts.pm
Normal file
116
lib/perl5/Selima/List/Accounting/Transacts.pm
Normal file
@@ -0,0 +1,116 @@
|
||||
# Selima Website Content Management System
|
||||
# Transacts.pm: The accounting transaction 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-08-23
|
||||
|
||||
package Selima::List::Accounting::Transacts;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use Selima::AddGet;
|
||||
use Selima::DataVars qw(:requri);
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "accttrx" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}?
|
||||
C_("Select an Accounting Transaction"):
|
||||
C_("Manage Accounting Transactions");
|
||||
# The default sort order
|
||||
$self->{"DEFAULT_SORTBY"} = "-date,-ord";
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"num" => C_("Number"),
|
||||
"note" => C_("Note"),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# html_newlink: Display a link to add a new item
|
||||
sub html_newlink : method {
|
||||
local ($_, %_);
|
||||
my ($self, $urle, $urli, $urlt, $prompt);
|
||||
$self = $_[0];
|
||||
|
||||
# No new item creation if it is a called form
|
||||
return if $self->{"is_called_form"};
|
||||
$_ = $REQUEST_FILEQS;
|
||||
# Remove list parameters
|
||||
$_ = rem_get_arg $_, "query", "sortby", "pageno", "form", "formcat", "formid", "statid";
|
||||
$_ = add_get_arg $_, "form", "new", DUP_OK;
|
||||
$urle = add_get_arg $_, "formsub", "expense", DUP_OK;
|
||||
$urli = add_get_arg $_, "formsub", "income", DUP_OK;
|
||||
$urlt = add_get_arg $_, "formsub", "trans", DUP_OK;
|
||||
$prompt = C_("<a href=\"[_1]\">Add a new cash expense transaction</a>, <a href=\"[_2]\">add a new cash income transaction</a> or <a href=\"[_3]\">add a new transfer transaction</a>.",
|
||||
h($urle), h($urli), h($urlt));
|
||||
|
||||
print << "EOT";
|
||||
<p>$prompt</p>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_search(C_("Search for an accounting transaction:"));
|
||||
}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
|
||||
# No record to list
|
||||
if ($self->{"total"} == 0) {
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message;
|
||||
# Fit in one page
|
||||
} elsif ($self->{"total"} <= $self->{"pagesize"}) {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,accounting transaction].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,accounting transaction].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,accounting transaction], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,accounting transaction], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
256
lib/perl5/Selima/List/ActLog.pm
Normal file
256
lib/perl5/Selima/List/ActLog.pm
Normal file
@@ -0,0 +1,256 @@
|
||||
# Selima Website Content Management System
|
||||
# ActLog.pm: The activity log record list.
|
||||
|
||||
# Copyright (c) 2005-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: 2005-05-10
|
||||
|
||||
package Selima::List::ActLog;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use Encode qw(decode);
|
||||
use Fcntl qw(:flock);
|
||||
|
||||
use Selima::A2HTML;
|
||||
use Selima::DataVars qw(:lninfo :requri);
|
||||
use Selima::GetLang;
|
||||
use Selima::Logging;
|
||||
use Selima::HTTP;
|
||||
use Selima::Query;
|
||||
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_("Browse the Activity Log");
|
||||
$self->{"rows"} = defined $self->{"FORM"}->param("rows")?
|
||||
$self->{"FORM"}->param("rows"): undef;
|
||||
$self->{"rdgt"} = 4;
|
||||
$self->{"reverse"} = 1;
|
||||
return $self;
|
||||
}
|
||||
|
||||
# fetch: Fetch the current list
|
||||
sub fetch : method {
|
||||
local ($_, %_);
|
||||
my ($self, $error, $FH);
|
||||
$self = $_[0];
|
||||
|
||||
# Fetched before
|
||||
return $self->{"error"} if $self->{"fetched"};
|
||||
$self->{"fetched"} = 1;
|
||||
|
||||
# Initialize the error status
|
||||
$self->{"error"} = undef;
|
||||
$self->{"total"} = undef;
|
||||
|
||||
# Check the query phrases
|
||||
$self->check_query;
|
||||
# Check the number of rows to display
|
||||
$error = $self->check_pagesize;
|
||||
if (defined $error) {
|
||||
$self->{"error"} = $error if !defined $self->{"error"};
|
||||
$self->{"pagesize"} = $self->{"DEFAULT_LIST_SIZE"};
|
||||
} elsif (!defined $self->{"rows"}) {
|
||||
$self->{"pagesize"} = $self->{"DEFAULT_LIST_SIZE"};
|
||||
} else {
|
||||
$self->{"pagesize"} = $self->{"rows"};
|
||||
}
|
||||
|
||||
check_actlog_file;
|
||||
open $FH, $ACTLOG or http_500 "$ACTLOG: $!";
|
||||
flock $FH, LOCK_SH or http_500 "$ACTLOG: $!";
|
||||
# Obtain all the log entries
|
||||
if (@{$self->{"query_phrases"}} == 0) {
|
||||
$self->{"current"} = [map decode("UTF-8", $_), <$FH>];
|
||||
# Obtain all the matched log entries
|
||||
} else {
|
||||
$self->{"current"} = [];
|
||||
while (defined($_ = <$FH>)) {
|
||||
my $matched;
|
||||
$_ = decode("UTF-8", $_);
|
||||
$matched = 1;
|
||||
foreach my $phrase (@{$self->{"query_phrases"}}) {
|
||||
next if /\Q$phrase\E/i;
|
||||
$matched = 0;
|
||||
last;
|
||||
}
|
||||
push @{$self->{"current"}}, $_ if $matched;
|
||||
}
|
||||
}
|
||||
flock $FH, LOCK_UN or http_500 "$ACTLOG: $!";
|
||||
close $FH or http_500 "$ACTLOG: $!";
|
||||
$self->{"total"} = scalar @{$self->{"current"}};
|
||||
|
||||
$self->{"endno"} = $self->{"total"} - 1;
|
||||
$self->{"startno"} = 1;
|
||||
if ($self->{"total"} > $self->{"pagesize"}) {
|
||||
$self->{"startno"} = $self->{"endno"} - $self->{"pagesize"} + 1;
|
||||
$self->{"current"} = [@{$self->{"current"}}[$self->{"startno"}...$self->{"endno"}]];
|
||||
}
|
||||
|
||||
$self->{"current"} = [reverse @{$self->{"current"}}];
|
||||
|
||||
# Done
|
||||
return $self->{"error"};
|
||||
}
|
||||
|
||||
# check_query: Check the query phrases
|
||||
sub check_query : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
|
||||
# No query, return
|
||||
return if !defined $self->{"query"};
|
||||
|
||||
# Regularize it
|
||||
$self->{"query"} =~ s/^\s*(.*?)\s*$/$1/;
|
||||
# Check if it is filled
|
||||
return if $self->{"query"} eq "";
|
||||
|
||||
$self->{"query_phrases"} = [parse_query $self->{"query"}];
|
||||
return;
|
||||
}
|
||||
|
||||
# check_pagesize: Check the number of rows to display
|
||||
sub check_pagesize : method {
|
||||
local ($_, %_);
|
||||
my ($self, $error, $errmsg);
|
||||
$self = $_[0];
|
||||
# No rows, return
|
||||
return if !defined $self->{"rows"};
|
||||
# Regularize it
|
||||
$self->{"rows"} =~ s/^\s*(.*?)\s*$/$1/;
|
||||
# Check if it is filled
|
||||
return {"msg"=>N_("Please fill in the number of rows to display.")}
|
||||
if $self->{"rows"} eq "";
|
||||
# If there is any non-digit character
|
||||
return {"msg"=>N_("Please fill in a positive integer number of rows to display.")}
|
||||
unless $self->{"rows"} =~ /^[1-9][0-9]*$/;
|
||||
# Set to an integer
|
||||
$self->{"rows"} += 0;
|
||||
# Check the length
|
||||
return {"msg"=>N_("This number of rows to display is too long. (Max. length [#,_1])"),
|
||||
"margs"=>[$self->{"rdgt"}]}
|
||||
if length $self->{"rows"} > $self->{"rdgt"};
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_newlink: Display a link to add a new item
|
||||
# Make it a null function
|
||||
sub html_newlink : method {}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
local ($_, %_);
|
||||
my ($self, $prompt, $label, $query, $request_file);
|
||||
my ($prompt2, $rows, $size);
|
||||
($self, $prompt) = @_;
|
||||
$prompt = C_("Search for log entries:") if !defined $prompt;
|
||||
$prompt = h($prompt);
|
||||
|
||||
$request_file = h($REQUEST_FILE);
|
||||
$query = defined $self->{"query"}? h($self->{"query"}): "";
|
||||
$label = h(C_("Display"));
|
||||
$prompt2 = h(C_("Display rows:"));
|
||||
$rows = defined $self->{"rows"}? h($self->{"rows"}):
|
||||
h($self->{"DEFAULT_LIST_SIZE"});
|
||||
$size = h($self->{"rdgt"});
|
||||
|
||||
print << "EOT";
|
||||
<form action="$request_file" method="get" accept-charset="<!--selima:charset-->">
|
||||
<div class="searchbox">
|
||||
<label for="query">$prompt</label><input
|
||||
id="query" type="text" name="query" value="$query" />
|
||||
<label for="rows">$prompt2</label><input
|
||||
id="rows" type="text" name="rows" size="$size" maxlength="$size" value="$rows" />
|
||||
<input type="hidden" name="charset" value="<!--selima:charset-->" />
|
||||
<input type="submit" value="$label" />
|
||||
</div>
|
||||
</form>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
|
||||
# No record to list
|
||||
if ($self->{"total"} == 0) {
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message;
|
||||
# Fit in one page
|
||||
} elsif ($self->{"total"} <= $self->{"pagesize"}) {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,log entry,log entries].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,log entry,log entries].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,log entry,log entries], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,log entry,log entries], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# html_pagebar: Display a page navigation bar
|
||||
# Make it a null function
|
||||
sub html_pagebar : method {}
|
||||
|
||||
# html_list: List the items
|
||||
sub html_list : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Do not show the list
|
||||
return if !defined $self->{"total"};
|
||||
# No record to be listed
|
||||
return if $self->{"total"} == 0;
|
||||
|
||||
$_ = a2html(join "", @{$self->{"current"}});
|
||||
s/([\x00-\x08\x0B\x0C\x0E-\x1F])/sprintf("\\x%02x", ord($1));/ge;
|
||||
print << "EOT";
|
||||
<div>
|
||||
$_
|
||||
</div>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
return 1;
|
||||
74
lib/perl5/Selima/List/Category.pm
Normal file
74
lib/perl5/Selima/List/Category.pm
Normal file
@@ -0,0 +1,74 @@
|
||||
# Selima Website Content Management System
|
||||
# Category.pm: The base category list.
|
||||
|
||||
# Copyright (c) 2006-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: 2006-03-21
|
||||
|
||||
package Selima::List::Category;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use Selima::ShortCut;
|
||||
|
||||
# html_newlink: Display a link to add a new item
|
||||
sub html_newlink : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_newlink(C_("Add a new category."));
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_search(C_("Search for a category:"));
|
||||
}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
|
||||
# No record to list
|
||||
if ($self->{"total"} == 0) {
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message;
|
||||
# Fit in one page
|
||||
} elsif ($self->{"total"} <= $self->{"pagesize"}) {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,category,categories].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,category,categories].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,category,categories], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,category,categories], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
74
lib/perl5/Selima/List/Categorz.pm
Normal file
74
lib/perl5/Selima/List/Categorz.pm
Normal file
@@ -0,0 +1,74 @@
|
||||
# Selima Website Content Management System
|
||||
# Categorz.pm: The base category membership list.
|
||||
|
||||
# Copyright (c) 2006-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: 2006-03-21
|
||||
|
||||
package Selima::List::Categorz;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use Selima::ShortCut;
|
||||
|
||||
# html_newlink: Display a link to add a new item
|
||||
sub html_newlink : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_newlink(C_("Add a new categorization record."));
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_search(C_("Search for a categorization record:"));
|
||||
}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
|
||||
# No record to list
|
||||
if ($self->{"total"} == 0) {
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message;
|
||||
# Fit in one page
|
||||
} elsif ($self->{"total"} <= $self->{"pagesize"}) {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,categorization record].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,categorization record].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,categorization record], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,categorization record], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
95
lib/perl5/Selima/List/GroupMem.pm
Normal file
95
lib/perl5/Selima/List/GroupMem.pm
Normal file
@@ -0,0 +1,95 @@
|
||||
# Selima Website Content Management System
|
||||
# GroupMem.pm: The group-to-group membership list.
|
||||
|
||||
# Copyright (c) 2004-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: 2004-10-14
|
||||
|
||||
package Selima::List::GroupMem;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "groupmem" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}?
|
||||
C_("Select a Group Membership Record"):
|
||||
C_("Manage Group Membership");
|
||||
# The default sort order
|
||||
$self->{"DEFAULT_SORTBY"} = "grp,member";
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"grp" => C_("Group"),
|
||||
"member" => C_("Member"),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# html_newlink: Display a link to add a new item
|
||||
sub html_newlink : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_newlink(C_("Add a new membership record."));
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_search(C_("Search for a membership record:"));
|
||||
}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
|
||||
# No record to list
|
||||
if ($self->{"total"} == 0) {
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message;
|
||||
# Fit in one page
|
||||
} elsif ($self->{"total"} <= $self->{"pagesize"}) {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,membership record].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,membership record].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,membership record], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,membership record], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
94
lib/perl5/Selima/List/Groups.pm
Normal file
94
lib/perl5/Selima/List/Groups.pm
Normal file
@@ -0,0 +1,94 @@
|
||||
# Selima Website Content Management System
|
||||
# Groups.pm: The account group list.
|
||||
|
||||
# Copyright (c) 2004-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: 2004-10-12
|
||||
|
||||
package Selima::List::Groups;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "groups" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}? C_("Select a Group"):
|
||||
C_("Manage Groups");
|
||||
# The default sort order
|
||||
$self->{"DEFAULT_SORTBY"} = "id";
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"id" => C_("Group ID."),
|
||||
"dsc" => C_("Description"),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# html_newlink: Display a link to add a new item
|
||||
sub html_newlink : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_newlink(C_("Add a new group."));
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_search(C_("Search for a group:"));
|
||||
}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
|
||||
# No record to list
|
||||
if ($self->{"total"} == 0) {
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message;
|
||||
# Fit in one page
|
||||
} elsif ($self->{"total"} <= $self->{"pagesize"}) {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,group].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,group].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,group], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,group], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
110
lib/perl5/Selima/List/Guestbook.pm
Normal file
110
lib/perl5/Selima/List/Guestbook.pm
Normal file
@@ -0,0 +1,110 @@
|
||||
# Selima Website Content Management System
|
||||
# Guestbook.pm: The base administrative guestbook message list.
|
||||
|
||||
# Copyright (c) 2004-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: 2004-10-16
|
||||
|
||||
package Selima::List::Guestbook;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use Selima::AddGet;
|
||||
use Selima::DataVars qw(:requri);
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "guestbook" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}?
|
||||
C_("Select a Message"):
|
||||
C_("Manage Guestbook");
|
||||
# The default sort order
|
||||
$self->{"DEFAULT_SORTBY"} = "created";
|
||||
# Columns that should display its brief instead
|
||||
push @{$self->{"COLS_BRIEF"}}, qw(message);
|
||||
# Columns should be displayed in a reversed order
|
||||
$self->{"reverse"} = 1;
|
||||
# The list brief size
|
||||
$self->{"DEFAULT_BRIEF_LEN"} = 20;
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"name" => C_("Signature"),
|
||||
"identity" => C_("Identity"),
|
||||
"location" => C_("Location"),
|
||||
"message" => C_("Message"),
|
||||
"ip" => C_("IP"),
|
||||
"host" => C_("Host"),
|
||||
"ct" => C_("Country"),
|
||||
"pageno" => C_("Page No."),
|
||||
"oldpageno" => C_("Old page No."),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# html_newlink: Display a link to add a new item
|
||||
sub html_newlink : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_newlink(C_("Write a new message."));
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_search(C_("Search for a message:"));
|
||||
}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
|
||||
# No record to list
|
||||
if ($self->{"total"} == 0) {
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message;
|
||||
# Fit in one page
|
||||
} elsif ($self->{"total"} <= $self->{"pagesize"}) {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,message].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,message].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,message], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,message], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
226
lib/perl5/Selima/List/Guestbook/Public.pm
Normal file
226
lib/perl5/Selima/List/Guestbook/Public.pm
Normal file
@@ -0,0 +1,226 @@
|
||||
# Selima Website Content Management System
|
||||
# Public.pm: The base guestbook message list.
|
||||
|
||||
# Copyright (c) 2004-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: 2004-10-23
|
||||
|
||||
package Selima::List::Guestbook::Public;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use IO::NestedCapture qw(CAPTURE_STDOUT);
|
||||
|
||||
use Selima::A2HTML;
|
||||
use Selima::DataVars qw($DBH :requri);
|
||||
use Selima::Format;
|
||||
use Selima::GetLang;
|
||||
use Selima::MungAddr;
|
||||
use Selima::ShortCut;
|
||||
use Selima::Unicode;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "guestbook" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
$self->{"view"} = "guestbook_public";
|
||||
# Entries should be displayed in a reversed order
|
||||
$self->{"reverse"} = 1;
|
||||
# Magical Traditional/Simplified Chinese conversion
|
||||
$self->{"magic_zhconv"} = 0;
|
||||
return $self;
|
||||
}
|
||||
|
||||
# fetch: Fetch the current list
|
||||
sub fetch : method {
|
||||
local ($_, %_);
|
||||
my ($self, $table, $sth, $sql, $error);
|
||||
$self = $_[0];
|
||||
|
||||
# Fetched before
|
||||
return $self->{"error"} if $self->{"fetched"};
|
||||
$self->{"fetched"} = 1;
|
||||
|
||||
# Initialize the error status
|
||||
$self->{"error"} = undef;
|
||||
|
||||
# The view name
|
||||
$table = $DBH->quote_identifier($self->{"view"});
|
||||
|
||||
# Find the last page number
|
||||
$sql = "SELECT pageno FROM $table ORDER BY pageno DESC LIMIT 1;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
# No records yet
|
||||
if ($sth->rows != 1) {
|
||||
$self->{"lastpage"} = 1;
|
||||
} else {
|
||||
$self->{"lastpage"} = ${$sth->fetch}[0];
|
||||
}
|
||||
# Check the page number
|
||||
$error = $self->check_pageno;
|
||||
$self->{"error"} = $error if defined $error && !defined $self->{"error"};
|
||||
|
||||
# Obtain the total number
|
||||
$self->{"select_total"} = sprintf "SELECT count(*) FROM $table;\n";
|
||||
$sql = $self->{"select_total"};
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$self->{"total"} = ($sth->fetchrow_array)[0];
|
||||
|
||||
# Obtain everything in this page
|
||||
$self->{"current"} = [];
|
||||
# Always reverse
|
||||
$self->{"select"} = "SELECT * FROM $table"
|
||||
. " WHERE pageno=" . $self->{"pageno"} . ";\n";
|
||||
$sql = $self->{"select"};
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
push @{$self->{"current"}}, $_
|
||||
while defined($_ = $sth->fetchrow_hashref);
|
||||
undef $sth;
|
||||
|
||||
# Done
|
||||
return $self->{"error"};
|
||||
}
|
||||
|
||||
# page_param: Obtain page parameters
|
||||
sub page_param : method {
|
||||
local ($_, %_);
|
||||
my ($self, $args);
|
||||
$self = $_[0];
|
||||
# Run the parent method
|
||||
$args = $self->SUPER::page_param;
|
||||
# Add the page bar to the page parameters
|
||||
if (defined $args && $self->{"lastpage"} > 1) {
|
||||
my $FD;
|
||||
# Obtain the page bar
|
||||
IO::NestedCapture->start(CAPTURE_STDOUT);
|
||||
binmode IO::NestedCapture->instance->{"STDOUT_current"}[-1], ":utf8";
|
||||
$self->html_pagebar;
|
||||
IO::NestedCapture->stop(CAPTURE_STDOUT);
|
||||
$FD = IO::NestedCapture->get_last_out;
|
||||
$$args{"header_html_nav"} = join "", <$FD>;
|
||||
$$args{"header_html_nav"} =~ s/\s+$//;
|
||||
$$args{"footer_html_nav"} = $$args{"header_html_nav"};
|
||||
}
|
||||
return $args;
|
||||
}
|
||||
|
||||
# html: Output the list
|
||||
sub html : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Fetch the current list if not fetched yet
|
||||
$self->fetch if !$self->{"fetched"};
|
||||
|
||||
# Display the error message
|
||||
$self->html_errmsg;
|
||||
# List the items
|
||||
$self->html_list;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
# html_list: List the items
|
||||
sub html_list : method {
|
||||
local ($_, %_);
|
||||
my ($self, @htmls, $emailalt);
|
||||
$self = $_[0];
|
||||
# No record to be listed
|
||||
return if $self->{"total"} == 0;
|
||||
|
||||
$emailalt = h(C_("E-mail"));
|
||||
foreach my $current (@{$self->{"current"}}) {
|
||||
my $h;
|
||||
# Magical Traditional/Simplified Chinese conversion
|
||||
if ($self->{"magic_zhconv"}) {
|
||||
$_ = getlang;
|
||||
if ( $_ eq "zh-tw" &&
|
||||
!(defined $$current{"lang"}
|
||||
&& $$current{"lang"} eq "zh-tw")) {
|
||||
foreach my $col (qw(name identity location email url message)) {
|
||||
$$current{$col} = all_to_trad($$current{$col})
|
||||
if defined $$current{$col};
|
||||
}
|
||||
} elsif ( $_ eq "zh-cn" &&
|
||||
!(defined $$current{"lang"}
|
||||
&& $$current{"lang"} eq "zh-cn")) {
|
||||
foreach my $col (qw(name identity location email url message)) {
|
||||
$$current{$col} = all_to_simp($$current{$col})
|
||||
if defined $$current{$col};
|
||||
}
|
||||
}
|
||||
}
|
||||
$h = "";
|
||||
$h .= "<div id=\"msg" . h($$current{"sn"}) . "\" class=\"entry\">\n";
|
||||
$h .= "<div>\n" . a2html($$current{"message"}) . "\n</div>\n\n";
|
||||
# <form ...>...</form> cannot live inside of <address>...</address>
|
||||
$h .= "<form action=\"/cgi-bin/mailto.cgi\" method=\"post\">\n"
|
||||
if defined $$current{"email"} && $$current{"email"} =~ /\@/;
|
||||
$h .= "<address>\n";
|
||||
$h .= "<cite>" . h($$current{"name"}) . "</cite><br />\n"
|
||||
if defined $$current{"name"};
|
||||
if (getlang eq "en") {
|
||||
$h .= myfmttime($$current{"date"}) . "<br />\n";
|
||||
} else {
|
||||
$h .= "<span xml:lang=\"en\">" . myfmttime($$current{"date"}) . "</span><br />\n";
|
||||
}
|
||||
$h .= h($$current{"identity"}) . "<br />\n"
|
||||
if defined $$current{"identity"};
|
||||
$h .= h($$current{"location"}) . "<br />\n"
|
||||
if defined $$current{"location"};
|
||||
if (defined $$current{"email"}) {
|
||||
if ($$current{"email"} =~ /\@/) {
|
||||
$h .= "<samp>" . mung_email_span(h($$current{"email"})) . "</samp>"
|
||||
. "<input\n type=\"hidden\" name=\"email\" value=\""
|
||||
. h(mung_address_at($$current{"email"})) . "\" />"
|
||||
. "<input\n type=\"image\" src=\"/images/email\" alt=\"$emailalt\" /><br />\n";
|
||||
} else {
|
||||
$h .= "<samp>" . mung_email_span(h($$current{"email"})) . "</samp><br />\n";
|
||||
}
|
||||
}
|
||||
if (defined $$current{"url"}) {
|
||||
if ($$current{"url"} =~ /^(?:http|https|ftp|gopher|telnet):\/\//) {
|
||||
$h .= "<samp><a href=\"" . h($$current{"url"}) . "\">"
|
||||
. h($$current{"url"}) . "</a></samp><br />\n";
|
||||
} else {
|
||||
$h .= h($$current{"url"}) . "<br />\n";
|
||||
}
|
||||
}
|
||||
$h .= C_("~[<a href=\"[_1]\">Edit</a>~]",
|
||||
h("/magicat/cgi-bin/guestbook.cgi?form=cur&sn=" . $$current{"sn"})) . "\n"
|
||||
if $ENV{"REMOTE_ADDR"} =~ /^10\./;
|
||||
$h .= "</address>\n";
|
||||
$h .= "</form>\n" if defined $$current{"email"} && $$current{"email"} =~ /\@/;
|
||||
$h .= "</div>\n\n";
|
||||
push @htmls, $h;
|
||||
}
|
||||
|
||||
$_ = h(C_("The message entry seperator"));
|
||||
print "<hr />\n\n<div class=\"entries\">\n\n"
|
||||
. join("<hr title=\"$_\" />\n\n", @htmls) . "</div>\n\n";
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
return 1;
|
||||
48
lib/perl5/Selima/List/LinkCat.pm
Normal file
48
lib/perl5/Selima/List/LinkCat.pm
Normal file
@@ -0,0 +1,48 @@
|
||||
# Selima Website Content Management System
|
||||
# LinkCat.pm: The related-link category list.
|
||||
|
||||
# Copyright (c) 2004-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: 2004-10-24
|
||||
|
||||
package Selima::List::LinkCat;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List::Category);
|
||||
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "linkcat" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}?
|
||||
C_("Select a Link Category"):
|
||||
C_("Manage Link Categories");
|
||||
# The default sort order
|
||||
$self->{"DEFAULT_SORTBY"} = "ord,id";
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
return 1;
|
||||
49
lib/perl5/Selima/List/LinkCatz.pm
Normal file
49
lib/perl5/Selima/List/LinkCatz.pm
Normal file
@@ -0,0 +1,49 @@
|
||||
# Selima Website Content Management System
|
||||
# LinkCatz.pm: The related-link category membership list.
|
||||
|
||||
# Copyright (c) 2004-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: 2004-10-25
|
||||
|
||||
package Selima::List::LinkCatz;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List::Categorz);
|
||||
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "linkcatz" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}?
|
||||
C_("Select a Link Categorization Record"):
|
||||
C_("Manage Link Categorization");
|
||||
# The default sort order
|
||||
$self->{"DEFAULT_SORTBY"} = "cat,link";
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"link" => C_("Link"),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
return 1;
|
||||
100
lib/perl5/Selima/List/Links.pm
Normal file
100
lib/perl5/Selima/List/Links.pm
Normal file
@@ -0,0 +1,100 @@
|
||||
# Selima Website Content Management System
|
||||
# Links.pm: The related-link list.
|
||||
|
||||
# Copyright (c) 2004-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: 2004-10-24
|
||||
|
||||
package Selima::List::Links;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "links" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}?
|
||||
C_("Select a Related Link"):
|
||||
C_("Manage Related Links");
|
||||
# The default sort order
|
||||
$self->{"DEFAULT_SORTBY"} = "title";
|
||||
# Columns that should display its brief instead
|
||||
push @{$self->{"COLS_BRIEF"}}, qw(dsc);
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"title_2ln" => C_("2nd language title"),
|
||||
"_imgsrc" => C_("Link icon"),
|
||||
"addr" => C_("Address"),
|
||||
"tel" => C_("Tel."),
|
||||
"fax" => C_("Fax."),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# html_newlink: Display a link to add a new item
|
||||
sub html_newlink : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_newlink(C_("Add a new related link."));
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_search(C_("Search for a related link:"));
|
||||
}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
|
||||
# No record to list
|
||||
if ($self->{"total"} == 0) {
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message;
|
||||
# Fit in one page
|
||||
} elsif ($self->{"total"} <= $self->{"pagesize"}) {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,related link].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,related link].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,related link], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,related link], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
96
lib/perl5/Selima/List/Pages.pm
Normal file
96
lib/perl5/Selima/List/Pages.pm
Normal file
@@ -0,0 +1,96 @@
|
||||
# Selima Website Content Management System
|
||||
# Pages.pm: The base web page list.
|
||||
|
||||
# Copyright (c) 2005-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: 2005-02-28
|
||||
|
||||
package Selima::List::Pages;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "pages" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}?
|
||||
C_("Select a Page"):
|
||||
C_("Manage Pages");
|
||||
# The default sort order
|
||||
$self->{"DEFAULT_SORTBY"} = "title";
|
||||
# Columns that should display its brief instead
|
||||
push @{$self->{"COLS_BRIEF"}}, qw(body);
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"path" => C_("Page path"),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# html_newlink: Display a link to add a new item
|
||||
sub html_newlink : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_newlink(C_("Write a new page."));
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_search(C_("Search for a page:"));
|
||||
}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
|
||||
# No record to list
|
||||
if ($self->{"total"} == 0) {
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message;
|
||||
# Fit in one page
|
||||
} elsif ($self->{"total"} <= $self->{"pagesize"}) {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,page].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,page].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,page], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,page], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
95
lib/perl5/Selima/List/ScptPriv.pm
Normal file
95
lib/perl5/Selima/List/ScptPriv.pm
Normal file
@@ -0,0 +1,95 @@
|
||||
# Selima Website Content Management System
|
||||
# ScptPriv.pm: The script privilege list.
|
||||
|
||||
# Copyright (c) 2004-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: 2004-10-14
|
||||
|
||||
package Selima::List::ScptPriv;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "scptpriv" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}?
|
||||
C_("Select a Script Privilege Record"):
|
||||
C_("Manage Script Privileges");
|
||||
# The default sort order
|
||||
$self->{"DEFAULT_SORTBY"} = "script,grp";
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"script" => C_("Script"),
|
||||
"grp" => C_("Privilege"),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# html_newlink: Display a link to add a new item
|
||||
sub html_newlink : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_newlink(C_("Add a new script privilege record."));
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_search(C_("Search for a script privilege record:"));
|
||||
}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
|
||||
# No record to list
|
||||
if ($self->{"total"} == 0) {
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message;
|
||||
# Fit in one page
|
||||
} elsif ($self->{"total"} <= $self->{"pagesize"}) {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,script privilege record].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,script privilege record].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,script privilege record], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,script privilege record], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
95
lib/perl5/Selima/List/UserMem.pm
Normal file
95
lib/perl5/Selima/List/UserMem.pm
Normal file
@@ -0,0 +1,95 @@
|
||||
# Selima Website Content Management System
|
||||
# UserMem.pm: The user-to-group membership list.
|
||||
|
||||
# Copyright (c) 2004-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: 2004-10-13
|
||||
|
||||
package Selima::List::UserMem;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "usermem" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}?
|
||||
C_("Select a User Membership Record"):
|
||||
C_("Manage User Membership");
|
||||
# The default sort order
|
||||
$self->{"DEFAULT_SORTBY"} = "grp,member";
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"grp" => C_("Group"),
|
||||
"member" => C_("Member"),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# html_newlink: Display a link to add a new item
|
||||
sub html_newlink : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_newlink(C_("Add a new membership record."));
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_search(C_("Search for a membership record:"));
|
||||
}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
|
||||
# No record to list
|
||||
if ($self->{"total"} == 0) {
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message;
|
||||
# Fit in one page
|
||||
} elsif ($self->{"total"} <= $self->{"pagesize"}) {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,membership record].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,membership record].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,membership record], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,membership record], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
96
lib/perl5/Selima/List/UserPref.pm
Normal file
96
lib/perl5/Selima/List/UserPref.pm
Normal file
@@ -0,0 +1,96 @@
|
||||
# Selima Website Content Management System
|
||||
# UserPref.pm: The user preference list.
|
||||
|
||||
# Copyright (c) 2004-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: 2004-10-14
|
||||
|
||||
package Selima::List::UserPref;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "userpref" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}?
|
||||
C_("Select a User Preference"):
|
||||
C_("Manage User Preferences");
|
||||
# The default sort order
|
||||
$self->{"DEFAULT_SORTBY"} = "domain,usr,name";
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"usr" => C_("User"),
|
||||
"domain" => C_("Domain"),
|
||||
"value" => C_("Value"),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# html_newlink: Display a link to add a new item
|
||||
sub html_newlink : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_newlink(C_("Add a new user preference."));
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_search(C_("Search for a user preference:"));
|
||||
}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
|
||||
# No record to list
|
||||
if ($self->{"total"} == 0) {
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message;
|
||||
# Fit in one page
|
||||
} elsif ($self->{"total"} <= $self->{"pagesize"}) {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,user preference].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,user preference].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,user preference], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,user preference], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
101
lib/perl5/Selima/List/Users.pm
Normal file
101
lib/perl5/Selima/List/Users.pm
Normal file
@@ -0,0 +1,101 @@
|
||||
# Selima Website Content Management System
|
||||
# Users.pm: The user account list.
|
||||
|
||||
# Copyright (c) 2004-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: 2004-09-28
|
||||
|
||||
package Selima::List::Users;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "users" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}? C_("Select a User"):
|
||||
C_("Manage Users");
|
||||
# The default sort order
|
||||
$self->{"DEFAULT_SORTBY"} = "id";
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"id" => C_("User ID."),
|
||||
"name" => C_("Full name"),
|
||||
"deleted" => C_("Deleted?"),
|
||||
"lang" => C_("Pref. language"),
|
||||
"visits" => C_("Visits"),
|
||||
"visited" => C_("Visited"),
|
||||
"ip" => C_("IP"),
|
||||
"host" => C_("Host"),
|
||||
"ct" => C_("Country"),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# html_newlink: Display a link to add a new item
|
||||
sub html_newlink : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_newlink(C_("Add a new user account."));
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_search(C_("Search for a user:"));
|
||||
}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
|
||||
# No record to list
|
||||
if ($self->{"total"} == 0) {
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message;
|
||||
# Fit in one page
|
||||
} elsif ($self->{"total"} <= $self->{"pagesize"}) {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,user].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,user].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return C_("Your query found [*,_1,user], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return C_("[*,_1,user], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
Reference in New Issue
Block a user