450 lines
19 KiB
Perl
450 lines
19 KiB
Perl
# Selima Website Content Management System
|
|
# AcctTrx.pm: The accounting transaction data processor.
|
|
|
|
# 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::Processor::AcctTrx;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(Selima::Processor);
|
|
|
|
use Selima::Accounting;
|
|
use Selima::DataVars qw($DBH :addcol :dataman);
|
|
use Selima::Format;
|
|
use Selima::Guest;
|
|
use Selima::ShortCut;
|
|
|
|
use Selima::Processor::AcctRec;
|
|
|
|
# new: Initialize the processor
|
|
sub new : method {
|
|
local ($_, %_);
|
|
my ($self, $class);
|
|
($class, @_) = @_;
|
|
$_[1] = "accttrx" if @_ < 2;
|
|
$self = $class->SUPER::new(@_);
|
|
$self->{"fix_ord"} = 1;
|
|
$self->{"subtype"} = $self->{"form"}->param("formsub");
|
|
return $self;
|
|
}
|
|
|
|
# _save_cols: Save the column deposit
|
|
sub _save_cols : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $cur, $o, $sum, $myord);
|
|
$self = $_[0];
|
|
($form, $cur) = ($self->{"form"}, $self->{"cur"});
|
|
|
|
if ($self->{"type"} ne "del") {
|
|
# Supply the omitting debit/credit record
|
|
# A form to fill in a cash expense transaction
|
|
if ($self->{"subtype"} eq "expense") {
|
|
$sum = 0;
|
|
foreach (grep /^debt\d+amount$/, $form->param) {
|
|
$sum += $form->param($_) if $form->param($_) =~ /^\d+$/
|
|
}
|
|
$form->delete($_)
|
|
foreach grep /^crdt\d+/, $form->param;
|
|
$form->param("crdt0subj", acctsubj_sn(ACCTSUBJ_CASH));
|
|
$form->param("crdt0summary", undef);
|
|
$form->param("crdt0amount", $sum);
|
|
if ( $self->{"type"} eq "cur"
|
|
&& $cur->param("crdtcount") == 1
|
|
&& $cur->param("crdt0subj") == acctsubj_sn(ACCTSUBJ_CASH)) {
|
|
$form->param("crdt0summary", $cur->param("crdt0summary"));
|
|
}
|
|
# A form to fill in a cash income transaction
|
|
} elsif ($self->{"subtype"} eq "income") {
|
|
$sum = 0;
|
|
foreach (grep /^crdt\d+amount$/, $form->param) {
|
|
$sum += $form->param($_) if $form->param($_) =~ /^\d+$/
|
|
}
|
|
$form->delete($_)
|
|
foreach grep /^debt\d+/, $form->param;
|
|
$form->param("debt0subj", acctsubj_sn(ACCTSUBJ_CASH));
|
|
$form->param("debt0summary", undef);
|
|
$form->param("debt0amount", $sum);
|
|
if ( $self->{"type"} eq "cur"
|
|
&& $cur->param("debtcount") == 1
|
|
&& $cur->param("debt0subj") == acctsubj_sn(ACCTSUBJ_CASH)) {
|
|
$form->param("debt0summary", $cur->param("debt0summary"));
|
|
}
|
|
}
|
|
}
|
|
|
|
# A form to create a new item
|
|
if ($self->{"type"} eq "new") {
|
|
# Shrink to the maximum order
|
|
$myord = $form->param("ord");
|
|
$myord = accttrx_maxord $form->param("date")
|
|
if $self->{"fix_ord"} && $myord > accttrx_maxord $form->param("date");
|
|
$self->{"myord"} = $myord;
|
|
$self->{"sn"} = $self->_new_sn;
|
|
$self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
|
|
$self->{"cols"}->addnum("sn", $self->{"sn"});
|
|
$self->{"cols"}->adddate("date", $self->_form("date"));
|
|
$self->{"cols"}->addnum("ord", $myord);
|
|
$self->{"cols"}->addstr("note", $self->_form("note"));
|
|
|
|
# Fix the order of other records
|
|
if ($self->{"fix_ord"}) {
|
|
my ($sql, $sth, $count, $row);
|
|
$sql = "SELECT * FROM " . $self->{"table"}
|
|
. " WHERE date=" . $DBH->quote($form->param("date"))
|
|
. " ORDER BY ord;\n";
|
|
$sth = $DBH->prepare($sql);
|
|
$sth->execute;
|
|
$count = $sth->rows;
|
|
for ($_ = 0, $o = 1; $_ < $count; $_++, $o++) {
|
|
my ($subform, $cols, %CURRENT_SUP);
|
|
$row = $sth->fetchrow_hashref;
|
|
$o++ if $o == $myord;
|
|
next if $$row{"ord"} == $o;
|
|
%CURRENT_SUP = %CURRENT;
|
|
%CURRENT = (%$row);
|
|
$subform = new CGI({%CURRENT});
|
|
$subform->param("form", "cur");
|
|
$subform->param("formsub", "trans");
|
|
$subform->param("ord", $o);
|
|
$subform->param("date", fmtdate($CURRENT{"date"}));
|
|
$cols = new Selima::Processor::AcctTrx($subform);
|
|
$cols->{"fix_ord"} = 0;
|
|
$cols->_save_cols;
|
|
unshift @{$self->{"pres"}}, $cols;
|
|
%CURRENT = %CURRENT_SUP;
|
|
}
|
|
}
|
|
|
|
# Find the changed items
|
|
if ($self->{"fix_ord"}) {
|
|
for ($_ = 0, $o = 1; defined $form->param("debt$_" . "subj"); $_++) {
|
|
my ($subform, $cols);
|
|
# Not selected
|
|
next unless $form->param("debt$_" . "subj") ne "";
|
|
$subform = new CGI("");
|
|
$subform->param("form", "new");
|
|
$subform->param("trx", $self->{"sn"});
|
|
$subform->delete("credit");
|
|
$subform->param("ord", $o++);
|
|
$subform->param("subj", $form->param("debt$_" . "subj"));
|
|
$subform->param("summary", $form->param("debt$_" . "summary"));
|
|
$subform->param("amount", $form->param("debt$_" . "amount"));
|
|
$cols = new Selima::Processor::AcctRec($subform);
|
|
$cols->_save_cols;
|
|
push @{$self->{"subs"}}, $cols;
|
|
}
|
|
|
|
for ($_ = 0, $o = 1; defined $form->param("crdt$_" . "subj"); $_++) {
|
|
my ($subform, $cols);
|
|
# Not selected
|
|
next unless $form->param("crdt$_" . "subj") ne "";
|
|
$subform = new CGI("");
|
|
$subform->param("form", "new");
|
|
$subform->param("trx", $self->{"sn"});
|
|
$subform->param("credit", 1);
|
|
$subform->param("ord", $o++);
|
|
$subform->param("subj", $form->param("crdt$_" . "subj"));
|
|
$subform->param("summary", $form->param("crdt$_" . "summary"));
|
|
$subform->param("amount", $form->param("crdt$_" . "amount"));
|
|
$cols = new Selima::Processor::AcctRec($subform);
|
|
$cols->_save_cols;
|
|
push @{$self->{"subs"}}, $cols;
|
|
}
|
|
}
|
|
|
|
# A form to edit a current item
|
|
} elsif ($self->{"type"} eq "cur") {
|
|
# Shrink to the maximum order
|
|
$myord = $form->param("ord");
|
|
$myord = accttrx_maxord $form->param("date")
|
|
if $self->{"fix_ord"} && $myord > accttrx_maxord $form->param("date"), $self->{"sn"};
|
|
$self->{"myord"} = $myord;
|
|
$self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
|
|
$self->{"cols"}->adddate("date", $self->_form("date"), scalar $cur->param("date"));
|
|
$self->{"cols"}->addnum("ord", $myord, scalar $cur->param("ord"));
|
|
$self->{"cols"}->addstr("note", $self->_form("note"), scalar $cur->param("note"));
|
|
|
|
# Fix the order of other records
|
|
if ($self->{"fix_ord"}) {
|
|
my ($sql, $sth, $count, $row);
|
|
# Date changed
|
|
if (fmtdate($cur->param("date")) ne $form->param("date")) {
|
|
$sql = "SELECT * FROM " . $self->{"table"}
|
|
. " WHERE date=" . $DBH->quote(fmtdate $cur->param("date"))
|
|
. " AND sn!=" . $self->{"sn"}
|
|
. " ORDER BY ord;\n";
|
|
$sth = $DBH->prepare($sql);
|
|
$sth->execute;
|
|
$count = $sth->rows;
|
|
for ($_ = 0, $o = 1; $_ < $count; $_++, $o++) {
|
|
my ($subform, $cols, %CURRENT_SUP);
|
|
$row = $sth->fetchrow_hashref;
|
|
next if $$row{"ord"} == $o;
|
|
%CURRENT_SUP = %CURRENT;
|
|
%CURRENT = (%$row);
|
|
$subform = new CGI({%CURRENT});
|
|
$subform->param("form", "cur");
|
|
$subform->param("formsub", "trans");
|
|
$subform->param("ord", $o);
|
|
$subform->param("date", fmtdate($CURRENT{"date"}));
|
|
$cols = new Selima::Processor::AcctTrx($subform);
|
|
$cols->{"fix_ord"} = 0;
|
|
$cols->_save_cols;
|
|
unshift @{$self->{"pres"}}, $cols;
|
|
%CURRENT = %CURRENT_SUP;
|
|
}
|
|
}
|
|
$sql = "SELECT * FROM " . $self->{"table"}
|
|
. " WHERE date=" . $DBH->quote($form->param("date"))
|
|
. " AND sn!=" . $self->{"sn"}
|
|
. " ORDER BY ord;\n";
|
|
$sth = $DBH->prepare($sql);
|
|
$sth->execute;
|
|
$count = $sth->rows;
|
|
for ($_ = 0, $o = 1; $_ < $count; $_++, $o++) {
|
|
my ($subform, $cols, %CURRENT_SUP);
|
|
$row = $sth->fetchrow_hashref;
|
|
$o++ if $o == $myord;
|
|
next if $$row{"ord"} == $o;
|
|
%CURRENT_SUP = %CURRENT;
|
|
%CURRENT = (%$row);
|
|
$subform = new CGI({%CURRENT});
|
|
$subform->param("form", "cur");
|
|
$subform->param("formsub", "trans");
|
|
$subform->param("ord", $o);
|
|
$subform->param("date", fmtdate($CURRENT{"date"}));
|
|
$cols = new Selima::Processor::AcctTrx($subform);
|
|
$cols->{"fix_ord"} = 0;
|
|
$cols->_save_cols;
|
|
unshift @{$self->{"pres"}}, $cols;
|
|
%CURRENT = %CURRENT_SUP;
|
|
}
|
|
}
|
|
|
|
# Find the changed items
|
|
if ($self->{"fix_ord"}) {
|
|
@_ = qw();
|
|
# The debit records
|
|
for ( $_ = 0, $o = 1;
|
|
$_ < $cur->param("debtcount")
|
|
|| defined $form->param("debt$_" . "subj");
|
|
$_++) {
|
|
# Added items to the current
|
|
if ($_ >= $cur->param("debtcount")) {
|
|
my ($subform, $cols);
|
|
# Not selected
|
|
next unless $form->param("debt$_" . "subj") ne "";
|
|
$subform = new CGI("");
|
|
$subform->param("form", "new");
|
|
$subform->param("trx", $self->{"sn"});
|
|
$subform->delete("credit");
|
|
$subform->param("ord", $o++);
|
|
$subform->param("subj", $form->param("debt$_" . "subj"));
|
|
$subform->param("summary", $form->param("debt$_" . "summary"));
|
|
$subform->param("amount", $form->param("debt$_" . "amount"));
|
|
$cols = new Selima::Processor::AcctRec($subform);
|
|
$cols->_save_cols;
|
|
push @{$self->{"subs"}}, $cols;
|
|
|
|
# Selected
|
|
} elsif ($form->param("debt$_" . "subj") ne "") {
|
|
my ($subform, $cols, %CURRENT_SUP);
|
|
%CURRENT_SUP = %CURRENT;
|
|
%CURRENT = (
|
|
"sn" => $cur->param("debt$_" . "sn"),
|
|
"trx" => $self->{"sn"},
|
|
"credit" => undef,
|
|
"ord" => $cur->param("debt$_" . "ord"),
|
|
"subj" => $cur->param("debt$_" . "subj"),
|
|
"summary" => scalar $cur->param("debt$_" . "summary"),
|
|
"amount" => $cur->param("debt$_" . "amount"),
|
|
);
|
|
$subform = new CGI("");
|
|
$subform->param("form", "cur");
|
|
$subform->param("sn", $cur->param("debt$_" . "sn"));
|
|
$subform->param("trx", $self->{"sn"});
|
|
$subform->delete("credit");
|
|
$subform->param("ord", $o++);
|
|
$subform->param("subj", $form->param("debt$_" . "subj"));
|
|
$subform->param("summary", $form->param("debt$_" . "summary"));
|
|
$subform->param("amount", $form->param("debt$_" . "amount"));
|
|
$cols = new Selima::Processor::AcctRec($subform);
|
|
$cols->_save_cols;
|
|
push @{$self->{"subs"}}, $cols;
|
|
%CURRENT = %CURRENT_SUP;
|
|
|
|
# Not selected
|
|
} else {
|
|
push @_, $cur->param("debt$_" . "sn");
|
|
}
|
|
}
|
|
# The credit records
|
|
for ( $_ = 0, $o = 1;
|
|
$_ < $cur->param("crdtcount")
|
|
|| defined $form->param("crdt$_" . "subj");
|
|
$_++) {
|
|
# Added items to the current
|
|
if ($_ >= $cur->param("crdtcount")) {
|
|
my ($subform, $cols);
|
|
# Not selected
|
|
next unless $form->param("crdt$_" . "subj") ne "";
|
|
$subform = new CGI("");
|
|
$subform->param("form", "new");
|
|
$subform->param("trx", $self->{"sn"});
|
|
$subform->param("credit", 1);
|
|
$subform->param("ord", $o++);
|
|
$subform->param("subj", $form->param("crdt$_" . "subj"));
|
|
$subform->param("summary", $form->param("crdt$_" . "summary"));
|
|
$subform->param("amount", $form->param("crdt$_" . "amount"));
|
|
$cols = new Selima::Processor::AcctRec($subform);
|
|
$cols->_save_cols;
|
|
push @{$self->{"subs"}}, $cols;
|
|
|
|
# Selected
|
|
} elsif ($form->param("crdt$_" . "subj") ne "") {
|
|
my ($subform, $cols, %CURRENT_SUP);
|
|
%CURRENT_SUP = %CURRENT;
|
|
%CURRENT = (
|
|
"sn" => $cur->param("crdt$_" . "sn"),
|
|
"trx" => $self->{"sn"},
|
|
"credit" => 1,
|
|
"ord" => $cur->param("crdt$_" . "ord"),
|
|
"subj" => $cur->param("crdt$_" . "subj"),
|
|
"summary" => scalar $cur->param("crdt$_" . "summary"),
|
|
"amount" => $cur->param("crdt$_" . "amount"),
|
|
);
|
|
$subform = new CGI("");
|
|
$subform->param("form", "cur");
|
|
$subform->param("sn", $cur->param("crdt$_" . "sn"));
|
|
$subform->param("trx", $self->{"sn"});
|
|
$subform->param("credit", 1);
|
|
$subform->param("ord", $o++);
|
|
$subform->param("subj", $form->param("crdt$_" . "subj"));
|
|
$subform->param("summary", $form->param("crdt$_" . "summary"));
|
|
$subform->param("amount", $form->param("crdt$_" . "amount"));
|
|
$cols = new Selima::Processor::AcctRec($subform);
|
|
$cols->_save_cols;
|
|
push @{$self->{"subs"}}, $cols;
|
|
%CURRENT = %CURRENT_SUP;
|
|
|
|
# Not selected
|
|
} else {
|
|
push @_, $cur->param("crdt$_" . "sn");
|
|
}
|
|
}
|
|
|
|
# Debit and credit records are in a same table
|
|
if (@_ > 0) {
|
|
my $subform;
|
|
$_ = join " OR ", map "sn=$_", @_;
|
|
$subform = new CGI("");
|
|
$subform->param("cond", $_);
|
|
# Delete first, to spare the order occupied
|
|
unshift @{$self->{"pres"}}, new Selima::Processor::Deletion($subform, "acctrecs");
|
|
}
|
|
}
|
|
|
|
# A form to delete a current item
|
|
} elsif ($self->{"type"} eq "del") {
|
|
# Fix the order of other records
|
|
if ($self->{"fix_ord"}) {
|
|
my ($sql, $sth, $count, $row);
|
|
$sql = "SELECT * FROM " . $self->{"table"}
|
|
. " WHERE date=" . $DBH->quote(fmtdate $cur->param("date"))
|
|
. " AND sn!=" . $self->{"sn"}
|
|
. " ORDER BY ord;\n";
|
|
$sth = $DBH->prepare($sql);
|
|
$sth->execute;
|
|
$count = $sth->rows;
|
|
for ($_ = 0, $o = 1; $_ < $count; $_++, $o++) {
|
|
my ($subform, $cols, %CURRENT_SUP);
|
|
$row = $sth->fetchrow_hashref;
|
|
next if $$row{"ord"} == $o;
|
|
%CURRENT_SUP = %CURRENT;
|
|
%CURRENT = (%$row);
|
|
$subform = new CGI({%CURRENT});
|
|
$subform->param("form", "cur");
|
|
$subform->param("formsub", "trans");
|
|
$subform->param("ord", $o);
|
|
$subform->param("date", fmtdate($CURRENT{"date"}));
|
|
$cols = new Selima::Processor::AcctTrx($subform);
|
|
$cols->{"fix_ord"} = 0;
|
|
$cols->_save_cols;
|
|
unshift @{$self->{"pres"}}, $cols;
|
|
%CURRENT = %CURRENT_SUP;
|
|
}
|
|
}
|
|
|
|
# Find the changed items
|
|
if ($self->{"fix_ord"}) {
|
|
$_ = new CGI("");
|
|
$_->param("cond", "trx=" . $self->{"sn"});
|
|
push @{$self->{"subs"}}, new Selima::Processor::Deletion($_, "acctrecs");
|
|
}
|
|
}
|
|
return;
|
|
}
|
|
|
|
# _actlog: Log the activity
|
|
sub _actlog : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $cur);
|
|
$self = $_[0];
|
|
($form, $cur) = ($self->{"form"}, $self->{"cur"});
|
|
# A form to create a new item
|
|
return gactlog "Create an accounting transaction "
|
|
. accttrxid_compose($form->param("date"), $self->{"myord"})
|
|
. " with s/n " . $self->{"sn"} . "."
|
|
if $self->{"type"} eq "new";
|
|
# A form to edit a current item
|
|
return gactlog "Update the accounting transaction "
|
|
. accttrxid_compose($form->param("date"), $self->{"myord"})
|
|
. " with s/n " . $self->{"sn"} . "."
|
|
if $self->{"type"} eq "cur";
|
|
# A form to delete a current item
|
|
return gactlog "Delete the accounting transaction "
|
|
. accttrxid_compose($cur->param("date"), $cur->param("ord"))
|
|
. " with s/n " . $self->{"sn"} . "."
|
|
if $self->{"type"} eq "del";
|
|
}
|
|
|
|
# _ret_status: Return the process status
|
|
sub _ret_status : method {
|
|
local ($_, %_);
|
|
my $self;
|
|
$self = $_[0];
|
|
return {"msg"=>N_("This accounting transaction was not modified."),
|
|
"isform"=>0}
|
|
if !$self->_modified;
|
|
# A form to create a new item
|
|
return {"msg"=>N_("This accounting transaction has been successfully added."),
|
|
"isform"=>0}
|
|
if $self->{"type"} eq "new";
|
|
# A form to edit a current item
|
|
return {"msg"=>N_("This accounting transaction has been successfully updated."),
|
|
"isform"=>0}
|
|
if $self->{"type"} eq "cur";
|
|
# A form to delete a current item
|
|
return {"msg"=>N_("This accounting transaction has been successfully deleted."),
|
|
"isform"=>0}
|
|
if $self->{"type"} eq "del";
|
|
}
|
|
|
|
return 1;
|