imacat/selima-perl
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial commit.

Browse Source
This commit is contained in:
依瑪貓
2026-03-10 21:25:26 +08:00
commit 78739bf725
3089 changed files with 472990 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

143
lib/perl5/Selima/Form/AcctSubj.pm Normal file
View File

@@ -0,0 +1,143 @@
# Selima Website Content Management System
# AcctSubj.pm: The accounting subject form.
# 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::Form::AcctSubj;
use 5.008;
use strict;
use warnings;
use base qw(Selima::Form);
use Selima::CommText;
use Selima::DataVars qw(:requri :scptconf);
use Selima::FormFunc;
use Selima::HTTP;
use Selima::MarkAbbr;
use Selima::ShortCut;
# new: Initialize the HTML form table displayer
sub new : method {
local ($_, %_);
my ($class, $status, $args, $self);
($class, $status, $args) = @_;
$args = {} if !defined $args;
# $args must be a hash reference
http_500 "type of argument 2 must be a hash reference"
if ref($args) ne "HASH";
$$args{"type"} = form_type
if !exists $$args{"type"};
$$args{"table"} = "acctsubj"
if !exists $$args{"table"};
$$args{"deltext"} = C_("Delete this accounting subject")
if !exists $$args{"deltext"};
if (!exists $$args{"summary"}) {
# A form to create a new item
if ($$args{"type"} eq "new") {
$$args{"summary"} = C_("This table provides you a form to add a new accounting subject.");
# A form to edit a current item
} elsif ($$args{"type"} eq "cur") {
$$args{"summary"} = C_("This table provides you a form to edit a current accounting subject.");
# A form to delete a current item
} elsif ($$args{"type"} eq "del") {
$$args{"summary"} = C_("This table provides you a form to delete an accounting subject.");
}
}
if (!exists $$args{"cols"}) {
# A form to create a new item
if ($$args{"type"} eq "new") {
$$args{"cols"} = [qw(parent code title)];
# A form to edit a current item
# A form to delete a current item
} elsif ($$args{"type"} eq "cur" || $$args{"type"} eq "del") {
$$args{"cols"} = [qw(sn parent code title ssubs
created createdby updated updatedby)];
}
}
if (!exists $$args{"title"}) {
# A form to create a new item
if ($$args{"type"} eq "new") {
$$args{"title"} = C_("Add a New Accounting Subject");
# A form to edit a current item
} elsif ($$args{"type"} eq "cur") {
$$args{"title"} = C_("Edit a Current Accounting Subject");
# A form to delete a current item
} elsif ($$args{"type"} eq "del") {
$$args{"title"} = C_("Delete an Accounting Subject");
}
}
$self = $class->SUPER::new($status, $args);
if ($self->{"type"} eq "cur") {
if (defined $self->{"cur"}->param("ssubcount") && $self->{"cur"}->param("ssubcount") > 0) {
$self->{"nodelete"} = 1;
push @{$self->{"prefmsg"}}, C_("This accounting subject has [numerate,_1,an accounting sub-subject,accounting sub-subjects]. It cannot be deleted. To delete the accounting subject, [numerate,_1,its accounting sub-subject,all of its accounting sub-subjects] must first be deleted.", $self->{"cur"}->param("ssubcount"));
}
if (defined $self->{"cur"}->param("reccount") && $self->{"cur"}->param("reccount") > 0) {
$self->{"nodelete"} = 1;
push @{$self->{"prefmsg"}}, C_("This accounting subject has [numerate,_1,an accounting record,accounting records]. It cannot be deleted. To delete the accounting subject, [numerate,_1,its accounting record,all of its accounting records] must first be deleted.", $self->{"cur"}->param("reccount"));
}
}
return $self;
}
# _html_col_code: The code
sub _html_col_code : method {
$_[0]->_html_coltmpl_text("code", h_abbr(C_("Code:")), undef,
${$_[0]->{"maxlens"}}{"code"});
}
# _html_col_parent: The parent
sub _html_col_parent : method {
$_[0]->_html_coltmpl_call_null("parent", h_abbr(C_("Parent subject:")),
"topmost", h_abbr(C_("At the very top")), $MAIN->can($_[0]->{"table"} . "_title"));
}
# _html_col_ssubs: The sub-subjects
sub _html_col_ssubs : method {
local ($_, %_);
my ($self, $form, $current, $label, $url, $mark, $colspan, $thclass, $thcolspan);
$self = $_[0];
$form = $self->{"form"};
$current = $self->{"cur"};
$mark = $self->_mark("ssubs");
$colspan = $self->_colspan;
$label = h_abbr(C_("[numerate,_1,Sub-subject,Sub-subjects]:", $current->param("ssubcount")));
# A current form span for 2 columns
$thclass = $self->{"type"} ne "cur"? " class=\"th\"": "";
$thcolspan = $self->{"type"} eq "cur"? " colspan=\"2\"": "";
print << "EOT";
<tr>
<th$thclass$thcolspan scope="row">$mark$label</th>
EOT
print " <td$colspan>";
@_ = qw();
for ($_ = 0; $_ < $current->param("ssubcount"); $_++) {
push @_, sprintf(" <li><a href=\"%1\$s\">%2\$s</a></li>\n",
h($REQUEST_FILE . "?form=cur&sn=" . $current->param("ssub$_" . "sn")),
h($current->param("ssub$_" . "title")));
}
print @_ > 0? "<ul>\n" . join("", @_) . " </ul>\n ": h_abbr(t_none);
print << "EOT";
</td>
</tr>
EOT
}
return 1;