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