Initial commit.
This commit is contained in:
179
lib/perl5/Selima/Form/AcctRec.pm
Normal file
179
lib/perl5/Selima/Form/AcctRec.pm
Normal file
@@ -0,0 +1,179 @@
|
||||
# Selima Website Content Management System
|
||||
# AcctRec.pm: The accounting record 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-09-23
|
||||
|
||||
package Selima::Form::AcctRec;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form);
|
||||
|
||||
use Selima::Accounting;
|
||||
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"} = "acctrecs"
|
||||
if !exists $$args{"table"};
|
||||
$$args{"deltext"} = C_("Delete this accounting record")
|
||||
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 record.");
|
||||
# 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 record.");
|
||||
# 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 record.");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"cols"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"cols"} = [qw(trx type ord subj summary amount)];
|
||||
# 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 trx type ord subj summary amount
|
||||
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 Record");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"title"} = C_("Edit a Current Accounting Record");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"title"} = C_("Delete an Accounting Record");
|
||||
}
|
||||
}
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _html_col_trx: The accounting transaction
|
||||
sub _html_col_trx : method {
|
||||
$_[0]->_html_coltmpl_call("trx", h_abbr(C_("Accounting transaction:")), \&accttrx_id);
|
||||
}
|
||||
|
||||
# _html_col_type: The type
|
||||
sub _html_col_type : method {
|
||||
local ($_, %_);
|
||||
my ($self, @opts);
|
||||
$self = $_[0];
|
||||
@opts = ( { "val" => "debit",
|
||||
"title" => C_("Debit"), },
|
||||
{ "val" => "credit",
|
||||
"title" => C_("Credit"), }, );
|
||||
return $self->_html_coltmpl_radio("type", h_abbr(C_("Type:")), \@opts, undef, 1);
|
||||
}
|
||||
|
||||
# _html_col_subj: The accounting subject
|
||||
sub _html_col_subj : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $current, $label, $choose, $mark, $colspan);
|
||||
my ($cur, $orig, $new);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
$current = $self->{"cur"};
|
||||
$label = h_abbr(C_("Accounting subject:"));
|
||||
$choose = h_abbr(C_("Choose"));
|
||||
$mark = $self->_mark("subj");
|
||||
$colspan = $self->_colspan;
|
||||
|
||||
# A form to create a new item
|
||||
if ($self->{"type"} eq "new") {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" scope="row"><label for="subj">$mark$label</label></th>
|
||||
<td$colspan><select id="subj" name="subj">
|
||||
EOT
|
||||
print acctsubj_recent_options $form->param("subj");
|
||||
print << "EOT";
|
||||
</select>
|
||||
<input id="selsubj" type="submit" name="selsubj" value="$choose" />
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($self->{"type"} eq "cur") {
|
||||
$cur = h(acctsubj_title $current->param("subj"));
|
||||
$orig = h_abbr(C_("Original:"));
|
||||
$new = h_abbr(C_("New:"));
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" rowspan="2" scope="row"><label for="subj">$mark$label</label></th>
|
||||
<th class="oldnew" scope="row">$orig</th>
|
||||
<td$colspan>$cur</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<th class="oldnew" scope="row"><label for="subj">$new</label></th>
|
||||
<td$colspan><select id="subj" name="subj">
|
||||
EOT
|
||||
print acctsubj_recent_options $form->param("subj");
|
||||
print << "EOT";
|
||||
</select>
|
||||
<input id="selsubj" type="submit" name="selsubj" value="$choose" />
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($self->{"type"} eq "del") {
|
||||
$cur = h(acctsubj_title $current->param("subj"));
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" scope="row">$mark$label</th>
|
||||
<td$colspan>$cur</td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# _html_col_summary: The summary
|
||||
sub _html_col_summary : method {
|
||||
$_[0]->_html_coltmpl_text("summary", h_abbr(C_("Summary:")));
|
||||
}
|
||||
|
||||
# _html_col_amount: The amount
|
||||
sub _html_col_amount : method {
|
||||
$_[0]->_html_coltmpl_text("amount", h_abbr(C_("Amount:")));
|
||||
}
|
||||
|
||||
return 1;
|
||||
143
lib/perl5/Selima/Form/AcctSubj.pm
Normal file
143
lib/perl5/Selima/Form/AcctSubj.pm
Normal 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;
|
||||
819
lib/perl5/Selima/Form/AcctTrx.pm
Normal file
819
lib/perl5/Selima/Form/AcctTrx.pm
Normal file
@@ -0,0 +1,819 @@
|
||||
# Selima Website Content Management System
|
||||
# AcctTrx.pm: The accounting transaction 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-09-20
|
||||
|
||||
package Selima::Form::AcctTrx;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form);
|
||||
|
||||
use Selima::Accounting;
|
||||
use Selima::AddGet;
|
||||
use Selima::CommText;
|
||||
use Selima::DataVars qw($DBH :requri :scptconf);
|
||||
use Selima::FormFunc;
|
||||
use Selima::Format;
|
||||
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"} = "accttrx"
|
||||
if !exists $$args{"table"};
|
||||
$$args{"deltext"} = C_("Delete this accounting transaction")
|
||||
if !exists $$args{"deltext"};
|
||||
# The hidden columns
|
||||
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 transaction.");
|
||||
# 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 transaction.");
|
||||
# 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 transaction.");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"cols"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"cols"} = [qw(date ord recs note)];
|
||||
# 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 date ord recs note
|
||||
created createdby updated updatedby)];
|
||||
}
|
||||
}
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
${$self->{"maxlens"}}{"ord"} = 2;
|
||||
# Set the subform type
|
||||
if ($$args{"type"} eq "new") {
|
||||
$_ = curform;
|
||||
$self->{"subtype"} = $_->param("formsub");
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$self->{"subtype"} = $self->{"form"}->param("formsub");
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$self->{"subtype"} = $self->{"cur"}->param("formsub");
|
||||
}
|
||||
# Only expense, income or trans are allowed
|
||||
http_500 "invalid form sub-type: " . $self->{"type"}
|
||||
if $self->{"subtype"} !~ /^(?:expense|income|trans)$/;
|
||||
if ($self->{"subtype"} eq "expense" || $self->{"subtype"} eq "income") {
|
||||
$self->{"colspan"} = 3;
|
||||
} else {
|
||||
$self->{"colspan"} = 6;
|
||||
}
|
||||
$self->{"hidcols"} = [] if !exists $self->{"hidcols"};
|
||||
push @{$self->{"hidcols"}}, {
|
||||
"name" => "formsub",
|
||||
"value" => $self->{"subtype"},
|
||||
};
|
||||
if ($self->{"type"} eq "cur" && $self->{"subtype"} ne "trans") {
|
||||
$self->{"header_buttons"} = [
|
||||
{ "name" => undef, "value" => h(C_("Submit")) },
|
||||
{ "name" => "confirm", "value" => h(C_("Save")) },
|
||||
{ "name" => "del", "value" => h($self->{"deltext"}) },
|
||||
{ "name" => "cnvttrans", "value" => h(C_("Convert to a transfer transaction")) }, ];
|
||||
$self->{"footer_buttons"} = [
|
||||
{ "name" => undef, "value" => h(C_("Submit")) },
|
||||
{ "name" => "confirm", "value" => h(C_("Save")) },
|
||||
{ "name" => "del", "value" => h($self->{"deltext"}) },
|
||||
{ "name" => "cnvttrans", "value" => h(C_("Convert to a transfer transaction")) }, ];
|
||||
}
|
||||
# A form to create a new item
|
||||
if ($self->{"type"} eq "new") {
|
||||
if ($self->{"subtype"} eq "expense") {
|
||||
$self->{"title"} = C_("Add a New Cache Expense Transaction");
|
||||
} elsif ($self->{"subtype"} eq "income") {
|
||||
$self->{"title"} = C_("Add a New Cache Income Transaction");
|
||||
} elsif ($self->{"subtype"} eq "trans") {
|
||||
$self->{"title"} = C_("Add a New Transfer Transaction");
|
||||
}
|
||||
# A form to edit a current item
|
||||
} elsif ($self->{"type"} eq "cur") {
|
||||
if ($self->{"subtype"} eq "expense") {
|
||||
$self->{"title"} = C_("Edit a Current Cache Expense Transaction");
|
||||
} elsif ($self->{"subtype"} eq "income") {
|
||||
$self->{"title"} = C_("Edit a Current Cache Income Transaction");
|
||||
} elsif ($self->{"subtype"} eq "trans") {
|
||||
$self->{"title"} = C_("Edit a Current Transfer Transaction");
|
||||
}
|
||||
# A form to delete a current item
|
||||
} elsif ($self->{"type"} eq "del") {
|
||||
if ($self->{"subtype"} eq "expense") {
|
||||
$self->{"title"} = C_("Delete a Cache Expense Transaction");
|
||||
} elsif ($self->{"subtype"} eq "income") {
|
||||
$self->{"title"} = C_("Delete a Cache Income Transaction");
|
||||
} elsif ($self->{"subtype"} eq "trans") {
|
||||
$self->{"title"} = C_("Delete a Transfer Transaction");
|
||||
}
|
||||
}
|
||||
%_ = $DBH->col_lens("acctrec");
|
||||
${$self->{"maxlens"}}{"recsubj"} = $_{"subj"};
|
||||
${$self->{"maxlens"}}{"recsummary"} = $_{"summary"};
|
||||
${$self->{"maxlens"}}{"recamount"} = $_{"amount"};
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _html_coltmpl_ro_loop_rec: Display a read-only record row column
|
||||
sub _html_coltmpl_ro_loop_rec : method {
|
||||
local ($_, %_);
|
||||
local ($_, %_);
|
||||
my ($self, $i, $current, $rowhdrs);
|
||||
my ($curlsubj, $curlsummary, $curlamount);
|
||||
my ($curbsubj, $curbsummary, $curbamount);
|
||||
($self, $i) = @_;
|
||||
$current = $self->{"cur"};
|
||||
$rowhdrs = "threcs";
|
||||
$rowhdrs .= " thold" if $self->{"type"} eq "cur";
|
||||
|
||||
# A form to fill in a cash expense transaction
|
||||
if ($self->{"subtype"} eq "expense") {
|
||||
$curlsubj = defined($_ = $current->param("debt$i" . "subj"))?
|
||||
h_abbr(acctsubj_title $_): "";
|
||||
$curlsummary = defined($_ = $current->param("debt$i" . "summary"))?
|
||||
h_abbr($_): "";
|
||||
$curlamount = defined($_ = $current->param("debt$i" . "amount"))?
|
||||
h_abbr(fmtntamount $_): "";
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<td headers="$rowhdrs thcdsubj">$curlsubj</td>
|
||||
<td headers="$rowhdrs thcdsummary">$curlsummary</td>
|
||||
<td class="amount" headers="$rowhdrs thcdamount">$curlamount</td>
|
||||
</tr>
|
||||
EOT
|
||||
|
||||
# A form to fill in a cash income transaction
|
||||
} elsif ($self->{"subtype"} eq "income") {
|
||||
$curbsubj = defined($_ = $current->param("crdt$i" . "subj"))?
|
||||
h_abbr(acctsubj_title $_): "";
|
||||
$curbsummary = defined($_ = $current->param("crdt$i" . "summary"))?
|
||||
h_abbr($_): "";
|
||||
$curbamount = defined($_ = $current->param("crdt$i" . "amount"))?
|
||||
h_abbr(fmtntamount $_): "";
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<td headers="$rowhdrs thccsubj">$curbsubj</td>
|
||||
<td headers="$rowhdrs thccsummary">$curbsummary</td>
|
||||
<td class="amount" headers="$rowhdrs thccamount">$curbamount</td>
|
||||
</tr>
|
||||
EOT
|
||||
|
||||
# A form to fill in a transfer transaction
|
||||
} elsif ($self->{"subtype"} eq "trans") {
|
||||
$curlsubj = defined($_ = $current->param("debt$i" . "subj"))?
|
||||
h_abbr(acctsubj_title $_): "";
|
||||
$curlsummary = defined($_ = $current->param("debt$i" . "summary"))?
|
||||
h_abbr($_): "";
|
||||
$curlamount = defined($_ = $current->param("debt$i" . "amount"))?
|
||||
h_abbr(fmtntamount $_): "";
|
||||
$curbsubj = defined($_ = $current->param("crdt$i" . "subj"))?
|
||||
h_abbr(acctsubj_title $_): "";
|
||||
$curbsummary = defined($_ = $current->param("crdt$i" . "summary"))?
|
||||
h_abbr($_): "";
|
||||
$curbamount = defined($_ = $current->param("crdt$i" . "amount"))?
|
||||
h_abbr(fmtntamount $_): "";
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<td headers="$rowhdrs thcdsubj">$curlsubj</td>
|
||||
<td headers="$rowhdrs thcdsummary">$curlsummary</td>
|
||||
<td class="amount" headers="$rowhdrs thcdamount">$curlamount</td>
|
||||
<td headers="$rowhdrs thccsubj">$curbsubj</td>
|
||||
<td headers="$rowhdrs thccsummary">$curbsummary</td>
|
||||
<td class="amount" headers="$rowhdrs thccamount">$curbamount</td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# _html_coltmpl_loop_rec: Display a record row column
|
||||
sub _html_coltmpl_loop_rec : method {
|
||||
local ($_, %_);
|
||||
my ($self, $i, $form, $choose, $rowhdrs);
|
||||
my ($coldsubj, $coldsummary, $valdsummary, $coldamount, $valdamount);
|
||||
my ($colcsubj, $colcsummary, $valcsummary, $colcamount, $valcamount);
|
||||
($self, $i) = @_;
|
||||
$form = $self->{"form"};
|
||||
$choose = h_abbr(C_("Choose"));
|
||||
$rowhdrs = "threcs";
|
||||
$rowhdrs .= " thnew" if $self->{"type"} eq "cur";
|
||||
|
||||
# A form to fill in a cash expense transaction
|
||||
if ($self->{"subtype"} eq "expense") {
|
||||
$coldsubj = "debt$i" . "subj";
|
||||
$coldsubj = h($coldsubj);
|
||||
$coldsummary = "debt$i" . "summary";
|
||||
$valdsummary = $self->_val_text($coldsummary, "recsummary");
|
||||
$coldsummary = h($coldsummary);
|
||||
$coldamount = "debt$i" . "amount";
|
||||
$valdamount = $self->_val_text($coldamount, "recamount");
|
||||
$coldamount = h($coldamount);
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<td headers="$rowhdrs thdsubj"><select id="$coldsubj" name="$coldsubj" onchange="setAutoSummary(this);">
|
||||
EOT
|
||||
print acctsubj_recent_options $form->param($coldsubj);
|
||||
print << "EOT";
|
||||
</select>
|
||||
<input id="sel$coldsubj" type="submit" name="sel$coldsubj" value="$choose" />
|
||||
</td>
|
||||
<td headers="$rowhdrs thdsummary"><input id="$coldsummary" type="text" name="$coldsummary" size="15"$valdsummary /></td>
|
||||
<td headers="$rowhdrs thdamount"><input id="$coldamount" class="amount" type="text" name="$coldamount" size="10"$valdamount onchange="calcTotal(this);" /></td>
|
||||
</tr>
|
||||
EOT
|
||||
|
||||
# A form to fill in a cash income transaction
|
||||
} elsif ($self->{"subtype"} eq "income") {
|
||||
$colcsubj = "crdt$i" . "subj";
|
||||
$colcsubj = h($colcsubj);
|
||||
$colcsummary = "crdt$i" . "summary";
|
||||
$valcsummary = $self->_val_text($colcsummary, "recsummary");
|
||||
$colcsummary = h($colcsummary);
|
||||
$colcamount = "crdt$i" . "amount";
|
||||
$valcamount = $self->_val_text($colcamount, "recamount");
|
||||
$colcamount = h($colcamount);
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<td headers="$rowhdrs thcsubj"><select id="$colcsubj" name="$colcsubj" onchange="setAutoSummary(this);">
|
||||
EOT
|
||||
print acctsubj_recent_options $form->param($colcsubj);
|
||||
print << "EOT";
|
||||
</select>
|
||||
<input id="sel$colcsubj" type="submit" name="sel$colcsubj" value="$choose" />
|
||||
</td>
|
||||
<td headers="$rowhdrs thcsummary"><input id="$colcsummary" type="text" name="$colcsummary" size="15"$valcsummary /></td>
|
||||
<td headers="$rowhdrs thcamount"><input id="$colcamount" class="amount" type="text" name="$colcamount" size="10"$valcamount onchange="calcTotal(this);" /></td>
|
||||
</tr>
|
||||
EOT
|
||||
|
||||
# A form to fill in a transfer transaction
|
||||
} elsif ($self->{"subtype"} eq "trans") {
|
||||
$coldsubj = "debt$i" . "subj";
|
||||
$coldsubj = h($coldsubj);
|
||||
$coldsummary = "debt$i" . "summary";
|
||||
$valdsummary = $self->_val_text($coldsummary, "recsummary");
|
||||
$coldsummary = h($coldsummary);
|
||||
$coldamount = "debt$i" . "amount";
|
||||
$valdamount = $self->_val_text($coldamount, "recamount");
|
||||
$coldamount = h($coldamount);
|
||||
$colcsubj = "crdt$i" . "subj";
|
||||
$colcsubj = h($colcsubj);
|
||||
$colcsummary = "crdt$i" . "summary";
|
||||
$valcsummary = $self->_val_text($colcsummary, "recsummary");
|
||||
$colcsummary = h($colcsummary);
|
||||
$colcamount = "crdt$i" . "amount";
|
||||
$valcamount = $self->_val_text($colcamount, "recamount");
|
||||
$colcamount = h($colcamount);
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<td headers="$rowhdrs thdebit thdsubj"><select id="$coldsubj" name="$coldsubj" onchange="setAutoSummary(this);">
|
||||
EOT
|
||||
print acctsubj_recent_options $form->param($coldsubj);
|
||||
print << "EOT";
|
||||
</select>
|
||||
<input id="sel$coldsubj" type="submit" name="sel$coldsubj" value="$choose" />
|
||||
</td>
|
||||
<td headers="$rowhdrs thdebit thdsummary"><input id="$coldsummary" type="text" name="$coldsummary" size="15"$valdsummary /></td>
|
||||
<td headers="$rowhdrs thdebit thdamount"><input id="$coldamount" class="amount" type="text" name="$coldamount" size="10"$valdamount onchange="calcTotal(this);" /></td>
|
||||
<td headers="$rowhdrs thcredit thcsubj"><select id="$colcsubj" name="$colcsubj" onchange="setAutoSummary(this);">
|
||||
EOT
|
||||
print acctsubj_recent_options $form->param($colcsubj);
|
||||
print << "EOT";
|
||||
</select>
|
||||
<input id="sel$colcsubj" type="submit" name="sel$colcsubj" value="$choose" />
|
||||
</td>
|
||||
<td headers="$rowhdrs thcredit thcsummary"><input id="$colcsummary" type="text" name="$colcsummary" size="15"$valcsummary /></td>
|
||||
<td headers="$rowhdrs thcredit thcamount"><input id="$colcamount" class="amount" type="text" name="$colcamount" size="10"$valcamount onchange="calcTotal(this);" /></td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# _html_col_ord: The order
|
||||
sub _html_col_ord : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# Set the default order to maximum
|
||||
$form->param("ord", 99)
|
||||
if $self->{"is_first_form"} && $self->{"type"} eq "new";
|
||||
$self->_html_coltmpl_text("ord", h_abbr(C_("Order:")), undef,
|
||||
${$self->{"maxlens"}}{"ord"});
|
||||
}
|
||||
|
||||
# _html_col_recs: The accounting records
|
||||
sub _html_col_recs : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $current, $label, $mark, $orig, $new);
|
||||
my ($labeldebit, $labelcredit, $labelsubj, $labelsummary, $labelamount);
|
||||
my ($labelsum, $sumdebit, $sumcredit);
|
||||
my ($count_new, $rows_new, $count_cur, $rows_cur, $rowspan);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
$current = $self->{"cur"};
|
||||
$mark = $self->_mark("recs");
|
||||
$labeldebit = h_abbr(C_("Debit"));
|
||||
$labelcredit = h_abbr(C_("Credit"));
|
||||
$labelsubj = h_abbr(C_("Accounting subject"));
|
||||
$labelsummary = h_abbr(C_("Summary"));
|
||||
$labelamount = h_abbr(C_("Amount"));
|
||||
$labelsum = h_abbr(C_("Total"));
|
||||
|
||||
# A form to create a new item
|
||||
if ($self->{"type"} eq "new") {
|
||||
# Find the total number of records
|
||||
$count_new = 0;
|
||||
# Find the last-used debit record
|
||||
for ( $_ = 0;
|
||||
defined $form->param("debt$_" . "subj")
|
||||
|| defined $form->param("debt$_" . "summary")
|
||||
|| defined $form->param("debt$_" . "amount"); $_++) {};
|
||||
if ($_ > 0) {
|
||||
for ( $_--;
|
||||
$_ >= 0
|
||||
&& $form->param("debt$_" . "subj") eq ""
|
||||
&& $form->param("debt$_" . "summary") eq ""
|
||||
&& $form->param("debt$_" . "amount") eq ""; $_--) {};
|
||||
$_++;
|
||||
}
|
||||
$count_new = $_ if $count_new < $_;
|
||||
# Find the last-used credit record
|
||||
for ( $_ = 0;
|
||||
defined $form->param("crdt$_" . "subj")
|
||||
|| defined $form->param("crdt$_" . "summary")
|
||||
|| defined $form->param("crdt$_" . "amount"); $_++) {};
|
||||
if ($_ > 0) {
|
||||
for ( $_--;
|
||||
$_ >= 0
|
||||
&& $form->param("crdt$_" . "subj") eq ""
|
||||
&& $form->param("crdt$_" . "summary") eq ""
|
||||
&& $form->param("crdt$_" . "amount") eq ""; $_--) {};
|
||||
$_++;
|
||||
}
|
||||
$count_new = $_ if $count_new < $_;
|
||||
# We need at least 5 blank records
|
||||
$count_new += 5;
|
||||
$_ = $count_new + 2;
|
||||
$_++ if $self->{"subtype"} eq "trans";
|
||||
$rows_new = " rowspan=\"" . h($_) . "\"";
|
||||
$rows_new = "" if $_ == 1;
|
||||
$label = h_abbr(C_("[numerate,_1,Content]:", 0));
|
||||
# A form to fill in a cash expense transaction
|
||||
if ($self->{"subtype"} eq "expense") {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="threcs" class="th"$rows_new scope="row"><label for="debt0subj">$mark$label</label></th>
|
||||
<th id="thdsubj"><label for="debt0subj">$labelsubj</label></th>
|
||||
<th id="thdsummary"><label for="debt0summary">$labelsummary</label></th>
|
||||
<th id="thdamount"><label for="debt0amount">$labelamount</label></th>
|
||||
</tr>
|
||||
EOT
|
||||
# A form to fill in a cash income transaction
|
||||
} elsif ($self->{"subtype"} eq "income") {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="threcs" class="th"$rows_new scope="row"><label for="crdt0subj">$mark$label</label></th>
|
||||
<th id="thcsubj"><label for="crdt0subj">$labelsubj</label></th>
|
||||
<th id="thcsummary"><label for="crdt0summary">$labelsummary</label></th>
|
||||
<th id="thcamount"><label for="crdt0amount">$labelamount</label></th>
|
||||
</tr>
|
||||
EOT
|
||||
# A form to fill in a transfer transaction
|
||||
} elsif ($self->{"subtype"} eq "trans") {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="threcs" class="th"$rows_new scope="row"><label for="debt0subj">$mark$label</label></th>
|
||||
<th id="thdebit" colspan="3"><label for="debt0subj">$labeldebit</label></th>
|
||||
<th id="thcredit" colspan="3"><label for="crdt0subj">$labelcredit</label></th>
|
||||
</tr>
|
||||
<tr>
|
||||
<th id="thdsubj"><label for="debt0subj">$labelsubj</label></th>
|
||||
<th id="thdsummary"><label for="debt0summary">$labelsummary</label></th>
|
||||
<th id="thdamount"><label for="debt0amount">$labelamount</label></th>
|
||||
<th id="thcsubj"><label for="crdt0subj">$labelsubj</label></th>
|
||||
<th id="thcsummary"><label for="crdt0summary">$labelsummary</label></th>
|
||||
<th id="thcamount"><label for="crdt0amount">$labelamount</label></th>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
for ($_ = 0, @_ = qw(); $_ < $count_new; $_++) {
|
||||
$self->_html_coltmpl_loop_rec($_);
|
||||
}
|
||||
# A form to fill in a cash expense transaction
|
||||
if ($self->{"subtype"} eq "expense") {
|
||||
for (my $i = 0, $sumdebit = 0; $i < $count_new; $i++) {
|
||||
$sumdebit += $_
|
||||
if defined($_ = $form->param("debt$i" . "amount"))
|
||||
&& /^\d+$/;
|
||||
}
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="thdsum" colspan="2"><label for="debttotal">$labelsum</label></th>
|
||||
<td headers="threcs thdsum"><input id="debttotal" class="amount" type="text" name="debttotal" size="10" value="$sumdebit" disabled="disabled" /></td>
|
||||
</tr>
|
||||
EOT
|
||||
# A form to fill in a cash income transaction
|
||||
} elsif ($self->{"subtype"} eq "income") {
|
||||
for (my $i = 0, $sumcredit = 0; $i < $count_new; $i++) {
|
||||
$sumcredit += $_
|
||||
if defined($_ = $current->param("crdt$i" . "amount"))
|
||||
&& /^\d+$/;
|
||||
}
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="thcsum" colspan="2"><label for="crdttotal">$labelsum</label></th>
|
||||
<td headers="threcs thcsum"><input id="crdttotal" class="amount" type="text" name="crdttotal" size="10" value="$sumcredit" disabled="disabled" /></td>
|
||||
</tr>
|
||||
EOT
|
||||
# A form to fill in a transfer transaction
|
||||
} elsif ($self->{"subtype"} eq "trans") {
|
||||
for (my $i = 0, $sumdebit = 0, $sumcredit = 0; $i < $count_new; $i++) {
|
||||
$sumdebit += $_
|
||||
if defined($_ = $current->param("debt$i" . "amount"))
|
||||
&& /^\d+$/;
|
||||
$sumcredit += $_
|
||||
if defined($_ = $current->param("crdt$i" . "amount"))
|
||||
&& /^\d+$/;
|
||||
}
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="thdsum" colspan="2"><label for="debttotal">$labelsum</label></th>
|
||||
<td headers="threcs thdebit thdsum"><input id="debttotal" class="amount" type="text" name="debttotal" size="10" value="$sumdebit" disabled="disabled" /></td>
|
||||
<th id="thcsum" colspan="2"><label for="crdttotal">$labelsum</label></th>
|
||||
<td headers="threcs thcredit thcsum"><input id="crdttotal" class="amount" type="text" name="crdttotal" size="10" value="$sumcredit" disabled="disabled" /></td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($self->{"type"} eq "cur") {
|
||||
$count_cur = 0;
|
||||
$count_cur = $current->param("debtcount")
|
||||
if $count_cur < $current->param("debtcount");
|
||||
$count_cur = $current->param("crdtcount")
|
||||
if $count_cur < $current->param("crdtcount");
|
||||
$_ = $count_cur + 2;
|
||||
$_++ if $self->{"subtype"} eq "trans";
|
||||
$rows_cur = " rowspan=\"" . h($_) . "\"";
|
||||
$rows_cur = "" if $_ == 1;
|
||||
# Find the total number of records
|
||||
$count_new = 0;
|
||||
# Find the last-used debit record
|
||||
for ( $_ = 0;
|
||||
defined $form->param("debt$_" . "subj")
|
||||
|| defined $form->param("debt$_" . "summary")
|
||||
|| defined $form->param("debt$_" . "amount"); $_++) {};
|
||||
if ($_ > 0) {
|
||||
for ( $_--;
|
||||
$_ > 0
|
||||
&& $form->param("debt$_" . "subj") eq ""
|
||||
&& $form->param("debt$_" . "summary") eq ""
|
||||
&& $form->param("debt$_" . "amount") eq ""; $_--) {};
|
||||
}
|
||||
$_++;
|
||||
$count_new = $_ if $count_new < $_;
|
||||
# Find the last-used credit record
|
||||
for ( $_ = 0;
|
||||
defined $form->param("crdt$_" . "subj")
|
||||
|| defined $form->param("crdt$_" . "summary")
|
||||
|| defined $form->param("crdt$_" . "amount"); $_++) {};
|
||||
if ($_ > 0) {
|
||||
for ( $_--;
|
||||
$_ > 0
|
||||
&& $form->param("crdt$_" . "subj") eq ""
|
||||
&& $form->param("crdt$_" . "summary") eq ""
|
||||
&& $form->param("crdt$_" . "amount") eq ""; $_--) {};
|
||||
}
|
||||
$_++;
|
||||
$count_new = $_ if $count_new < $_;
|
||||
# We need at least 5 blank records
|
||||
$count_new += 5;
|
||||
$_ = $count_new + 2;
|
||||
$_++ if $self->{"subtype"} eq "trans";
|
||||
$rows_new = " rowspan=\"" . h($_) . "\"";
|
||||
$rows_new = "" if $_ == 1;
|
||||
$_ = $count_cur + $count_new + 4;
|
||||
$_ += 2 if $self->{"subtype"} eq "trans";
|
||||
$rowspan = " rowspan=\"" . h($_) . "\"";
|
||||
$rowspan = "" if $_ == 1;
|
||||
$label = h_abbr(C_("[numerate,_1,Content]:", 0));
|
||||
$orig = h_abbr(C_("Original:"));
|
||||
$new = h_abbr(C_("New:"));
|
||||
# A form to fill in a cash expense transaction
|
||||
if ($self->{"subtype"} eq "expense") {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="threcs" class="th"$rowspan scope="row">$mark$label</th>
|
||||
<th id="thold" class="oldnew"$rows_cur>$orig</th>
|
||||
<th id="thcdsubj">$labelsubj</th>
|
||||
<th id="thcdsummary">$labelsummary</th>
|
||||
<th id="thcdamount">$labelamount</th>
|
||||
</tr>
|
||||
EOT
|
||||
# A form to fill in a cash income transaction
|
||||
} elsif ($self->{"subtype"} eq "income") {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="threcs" class="th"$rowspan scope="row">$mark$label</th>
|
||||
<th id="thold" class="oldnew"$rows_cur>$orig</th>
|
||||
<th id="thccsubj">$labelsubj</th>
|
||||
<th id="thccsummary">$labelsummary</th>
|
||||
<th id="thccamount">$labelamount</th>
|
||||
</tr>
|
||||
EOT
|
||||
# A form to fill in a transfer transaction
|
||||
} elsif ($self->{"subtype"} eq "trans") {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="threcs" class="th"$rowspan scope="row">$mark$label</th>
|
||||
<th id="thold" class="oldnew"$rows_cur>$orig</th>
|
||||
<th id="thcdebit" colspan="3">$labeldebit</th>
|
||||
<th id="thccredit" colspan="3">$labelcredit</th>
|
||||
</tr>
|
||||
<tr>
|
||||
<th id="thcdsubj">$labelsubj</th>
|
||||
<th id="thcdsummary">$labelsummary</th>
|
||||
<th id="thcdamount">$labelamount</th>
|
||||
<th id="thccsubj">$labelsubj</th>
|
||||
<th id="thccsummary">$labelsummary</th>
|
||||
<th id="thccamount">$labelamount</th>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
for ($_ = 0, @_ = qw(); $_ < $count_cur; $_++) {
|
||||
$self->_html_coltmpl_ro_loop_rec($_);
|
||||
}
|
||||
# A form to fill in a cash expense transaction
|
||||
if ($self->{"subtype"} eq "expense") {
|
||||
for (my $i = 0, $sumdebit = 0; $i < $count_cur; $i++) {
|
||||
$sumdebit += $_
|
||||
if defined($_ = $current->param("debt$i" . "amount"));
|
||||
}
|
||||
$sumdebit = h_abbr(fmtntamount $sumdebit);
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="thcdsum" colspan="2">$labelsum</th>
|
||||
<td class="amount" headers="threcs thold thcdsum">$sumdebit</td>
|
||||
</tr>
|
||||
EOT
|
||||
# A form to fill in a cash income transaction
|
||||
} elsif ($self->{"subtype"} eq "income") {
|
||||
for (my $i = 0, $sumcredit = 0; $i < $count_cur; $i++) {
|
||||
$sumcredit += $_
|
||||
if defined($_ = $current->param("crdt$i" . "amount"));
|
||||
}
|
||||
$sumcredit = h_abbr(fmtntamount $sumcredit);
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="thccsum" colspan="2">$labelsum</th>
|
||||
<td class="amount" headers="threcs thold thccsum">$sumcredit</td>
|
||||
</tr>
|
||||
EOT
|
||||
# A form to fill in a transfer transaction
|
||||
} elsif ($self->{"subtype"} eq "trans") {
|
||||
for (my $i = 0, $sumdebit = 0, $sumcredit = 0; $i < $count_cur; $i++) {
|
||||
$sumdebit += $_
|
||||
if defined($_ = $current->param("debt$i" . "amount"));
|
||||
$sumcredit += $_
|
||||
if defined($_ = $current->param("crdt$i" . "amount"));
|
||||
}
|
||||
$sumdebit = h_abbr(fmtntamount $sumdebit);
|
||||
$sumcredit = h_abbr(fmtntamount $sumcredit);
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="thcdsum" colspan="2">$labelsum</th>
|
||||
<td class="amount" headers="threcs thold thcdebit thcdsum">$sumdebit</td>
|
||||
<th id="thccsum" colspan="2">$labelsum</th>
|
||||
<td class="amount" headers="threcs thold thccredit thccsum">$sumcredit</td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
# A form to fill in a cash expense transaction
|
||||
if ($self->{"subtype"} eq "expense") {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="thnew" class="oldnew"$rows_new>$new</th>
|
||||
<th id="thdsubj"><label for="debt0subj">$labelsubj</label></th>
|
||||
<th id="thdsummary"><label for="debt0summary">$labelsummary</label></th>
|
||||
<th id="thdamount"><label for="debt0amount">$labelamount</label></th>
|
||||
</tr>
|
||||
EOT
|
||||
# A form to fill in a cash income transaction
|
||||
} elsif ($self->{"subtype"} eq "income") {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="thnew" class="oldnew"$rows_new>$new</th>
|
||||
<th id="thcsubj"><label for="crdt0subj">$labelsubj</label></th>
|
||||
<th id="thcsummary"><label for="crdt0summary">$labelsummary</label></th>
|
||||
<th id="thcamount"><label for="crdt0amount">$labelamount</label></th>
|
||||
</tr>
|
||||
EOT
|
||||
# A form to fill in a transfer transaction
|
||||
} elsif ($self->{"subtype"} eq "trans") {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="thnew" class="oldnew"$rows_new>$new</th>
|
||||
<th id="thdebit" colspan="3"><label for="debt0subj">$labeldebit</label></th>
|
||||
<th id="thcredit" colspan="3"><label for="crdt0subj">$labelcredit</label></th>
|
||||
</tr>
|
||||
<tr>
|
||||
<th id="thdsubj"><label for="debt0subj">$labelsubj</label></th>
|
||||
<th id="thdsummary"><label for="debt0summary">$labelsummary</label></th>
|
||||
<th id="thdamount"><label for="debt0amount">$labelamount</label></th>
|
||||
<th id="thcsubj"><label for="crdt0subj">$labelsubj</label></th>
|
||||
<th id="thcsummary"><label for="crdt0summary">$labelsummary</label></th>
|
||||
<th id="thcamount"><label for="crdt0amount">$labelamount</label></th>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
for ($_ = 0, @_ = qw(); $_ < $count_new; $_++) {
|
||||
$self->_html_coltmpl_loop_rec($_);
|
||||
}
|
||||
# A form to fill in a cash expense transaction
|
||||
if ($self->{"subtype"} eq "expense") {
|
||||
for (my $i = 0, $sumdebit = 0; $i < $count_new; $i++) {
|
||||
$sumdebit += $_
|
||||
if defined($_ = $form->param("debt$i" . "amount"))
|
||||
&& /^\d+$/;
|
||||
}
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="thdsum" colspan="2"><label for="debttotal">$labelsum</label></th>
|
||||
<td headers="threcs thdsum"><input id="debttotal" class="amount" type="text" name="debttotal" size="10" value="$sumdebit" disabled="disabled" /></td>
|
||||
</tr>
|
||||
EOT
|
||||
# A form to fill in a cash income transaction
|
||||
} elsif ($self->{"subtype"} eq "income") {
|
||||
for (my $i = 0, $sumcredit = 0; $i < $count_new; $i++) {
|
||||
$sumcredit += $_
|
||||
if defined($_ = $current->param("crdt$i" . "amount"))
|
||||
&& /^\d+$/;
|
||||
}
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="thcsum" colspan="2"><label for="crdttotal">$labelsum</label></th>
|
||||
<td headers="threcs thcsum"><input id="crdttotal" class="amount" type="text" name="crdttotal" size="10" value="$sumcredit" disabled="disabled" /></td>
|
||||
</tr>
|
||||
EOT
|
||||
# A form to fill in a transfer transaction
|
||||
} elsif ($self->{"subtype"} eq "trans") {
|
||||
for (my $i = 0, $sumdebit = 0, $sumcredit = 0; $i < $count_new; $i++) {
|
||||
$sumdebit += $_
|
||||
if defined($_ = $current->param("debt$i" . "amount"))
|
||||
&& /^\d+$/;
|
||||
$sumcredit += $_
|
||||
if defined($_ = $current->param("crdt$i" . "amount"))
|
||||
&& /^\d+$/;
|
||||
}
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="thdsum" colspan="2"><label for="debttotal">$labelsum</label></th>
|
||||
<td headers="threcs thdebit thdsum"><input id="debttotal" class="amount" type="text" name="debttotal" size="10" value="$sumdebit" disabled="disabled" /></td>
|
||||
<th id="thcsum" colspan="2"><label for="crdttotal">$labelsum</label></th>
|
||||
<td headers="threcs thcredit thcsum"><input id="crdttotal" class="amount" type="text" name="crdttotal" size="10" value="$sumcredit" disabled="disabled" /></td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($self->{"type"} eq "del") {
|
||||
$count_cur = 0;
|
||||
$count_cur = $current->param("debtcount")
|
||||
if $count_cur < $current->param("debtcount");
|
||||
$count_cur = $current->param("crdtcount")
|
||||
if $count_cur < $current->param("crdtcount");
|
||||
$_ = $count_cur + 2;
|
||||
$_++ if $self->{"subtype"} eq "trans";
|
||||
$rows_cur = " rowspan=\"" . h($_) . "\"";
|
||||
$rows_cur = "" if $_ == 1;
|
||||
$label = h_abbr(C_("[numerate,_1,Content]:", $count_cur));
|
||||
# A form to fill in a cash expense transaction
|
||||
if ($self->{"subtype"} eq "expense") {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="threcs" class="th"$rows_cur scope="row">$mark$label</th>
|
||||
<th id="thcdsubj">$labelsubj</th>
|
||||
<th id="thcdsummary">$labelsummary</th>
|
||||
<th id="thcdamount">$labelamount</th>
|
||||
</tr>
|
||||
EOT
|
||||
# A form to fill in a cash income transaction
|
||||
} elsif ($self->{"subtype"} eq "income") {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="threcs" class="th"$rows_cur scope="row">$mark$label</th>
|
||||
<th id="thccsubj">$labelsubj</th>
|
||||
<th id="thccsummary">$labelsummary</th>
|
||||
<th id="thccamount">$labelamount</th>
|
||||
</tr>
|
||||
EOT
|
||||
# A form to fill in a transfer transaction
|
||||
} elsif ($self->{"subtype"} eq "trans") {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th id="threcs" class="th"$rows_cur scope="row">$mark$label</th>
|
||||
<th id="thcdebit" colspan="3">$labeldebit</th>
|
||||
<th id="thccredit" colspan="3">$labelcredit</th>
|
||||
</tr>
|
||||
<tr>
|
||||
<th id="thcdsubj">$labelsubj</th>
|
||||
<th id="thcdsummary">$labelsummary</th>
|
||||
<th id="thcdamount">$labelamount</th>
|
||||
<th id="thccsubj">$labelsubj</th>
|
||||
<th id="thccsummary">$labelsummary</th>
|
||||
<th id="thccamount">$labelamount</th>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
for ($_ = 0, @_ = qw(); $_ < $count_cur; $_++) {
|
||||
$self->_html_coltmpl_ro_loop_rec($_);
|
||||
}
|
||||
# A form to fill in a cash expense transaction
|
||||
if ($self->{"subtype"} eq "expense") {
|
||||
for (my $i = 0, $sumdebit = 0; $i < $count_cur; $i++) {
|
||||
$sumdebit += $_
|
||||
if defined($_ = $current->param("debt$i" . "amount"));
|
||||
}
|
||||
$sumdebit = h_abbr(fmtntamount $sumdebit);
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<td id="thcdsum" colspan="2">$labelsum</td>
|
||||
<td class="amount" headers="threcs thcdsum">$sumdebit</td>
|
||||
</tr>
|
||||
EOT
|
||||
# A form to fill in a cash income transaction
|
||||
} elsif ($self->{"subtype"} eq "income") {
|
||||
for (my $i = 0, $sumcredit = 0; $i < $count_cur; $i++) {
|
||||
$sumcredit += $_
|
||||
if defined($_ = $current->param("crdt$i" . "amount"));
|
||||
}
|
||||
$sumcredit = h_abbr(fmtntamount $sumcredit);
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<td id="thccsum" colspan="2">$labelsum</td>
|
||||
<td class="amount" headers="threcs thccsum">$sumcredit</td>
|
||||
</tr>
|
||||
EOT
|
||||
# A form to fill in a transfer transaction
|
||||
} elsif ($self->{"subtype"} eq "trans") {
|
||||
for (my $i = 0, $sumdebit = 0, $sumcredit = 0; $i < $count_cur; $i++) {
|
||||
$sumdebit += $_
|
||||
if defined($_ = $current->param("debt$i" . "amount"));
|
||||
$sumcredit += $_
|
||||
if defined($_ = $current->param("crdt$i" . "amount"));
|
||||
}
|
||||
$sumdebit = h_abbr(fmtntamount $sumdebit);
|
||||
$sumcredit = h_abbr(fmtntamount $sumcredit);
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<td id="thcdsum" colspan="2">$labelsum</td>
|
||||
<td class="amount" headers="threcs thcdebit thcdsum">$sumdebit</td>
|
||||
<td id="thccsum" colspan="2">$labelsum</td>
|
||||
<td class="amount" headers="threcs thccredit thccsum">$sumcredit</td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# _html_col_note: The note
|
||||
sub _html_col_note : method {
|
||||
$_[0]->_html_coltmpl_textarea("note", h_abbr(C_("Note:")),
|
||||
h_abbr(C_("Fill in the note here.")), undef, 2);
|
||||
}
|
||||
|
||||
return 1;
|
||||
498
lib/perl5/Selima/Form/Group.pm
Normal file
498
lib/perl5/Selima/Form/Group.pm
Normal file
@@ -0,0 +1,498 @@
|
||||
# Selima Website Content Management System
|
||||
# Group.pm: The account group form.
|
||||
|
||||
# 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::Form::Group;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form);
|
||||
|
||||
use Selima::CommText;
|
||||
use Selima::ChkPriv;
|
||||
use Selima::ChkFunc;
|
||||
use Selima::FormFunc;
|
||||
use Selima::HTTP;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
use Selima::UserName;
|
||||
use Selima::Unicode;
|
||||
|
||||
# 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"} = "groups"
|
||||
if !exists $$args{"table"};
|
||||
$$args{"deltext"} = C_("Delete this group")
|
||||
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 group.");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"summary"} = C_("This table provides you a form to update a current group.");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"summary"} = C_("This table provides you a form to delete a group.");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"cols"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"cols"} = [qw(id dsc subuser subgroup supgroup)];
|
||||
# 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 id dsc subuser subgroup supgroup
|
||||
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 Group");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"title"} = C_("Update a Current Group");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"title"} = C_("Delete a Group");
|
||||
}
|
||||
}
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
if ($$args{"type"} eq "cur" && !is_su && $self->{"sn"} == su_group_sn) {
|
||||
$self->{"nodelete"} = 1;
|
||||
push @{$self->{"prefmsg"}}, C_("This is a super-user group. You can only change parts of its infomation.");
|
||||
}
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _html_col_id: The group ID.
|
||||
sub _html_col_id : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Read-only for a non-super-user editing a super-user
|
||||
if ($self->{"type"} eq "cur" && !is_su && $self->{"sn"} == su_group_sn) {
|
||||
$self->_html_coltmpl_ro("id", h_abbr(C_("Group ID.:")));
|
||||
} else {
|
||||
$self->_html_coltmpl_text("id", h_abbr(C_("Group ID.:")));
|
||||
}
|
||||
}
|
||||
|
||||
# _html_col_dsc: The description
|
||||
sub _html_col_dsc : method {
|
||||
$_[0]->_html_coltmpl_text("dsc", h_abbr(C_("Description:")));
|
||||
}
|
||||
|
||||
# _html_col_subuser: Its child users
|
||||
sub _html_col_subuser : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $current, $label, $orig, $new, $submit, $mark, $colspan, $title);
|
||||
#my ($col, $val, $colsn, $valsn, $title);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
$current = $self->{"cur"};
|
||||
$mark = $self->_mark("subuser");
|
||||
$colspan = $self->_colspan;
|
||||
$submit = h_abbr(C_("Add a user"));
|
||||
|
||||
# A form to create a new item
|
||||
if ($self->{"type"} eq "new") {
|
||||
$label = h_abbr(C_("[numerate,_1,User member]:", 0));
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" scope="row"><label for="selsubuser">$mark$label</label></th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); defined $form->param("subuser$_" . "sn"); $_++) {
|
||||
if (defined($title = user_opt_label(scalar $form->param("subuser$_" . "sn"), "subuser$_"))) {
|
||||
push @_, sprintf(" <li><input type=\"hidden\" name=\"subuser%1\$dsn\"%2\$s />\n"
|
||||
. " <input id=\"subuser%1\$d\" type=\"checkbox\" name=\"subuser%1\$d\"%3\$s />\n"
|
||||
. " %4\$s\n"
|
||||
. " </li>\n",
|
||||
h($_), $self->_val_text("subuser$_" . "sn"),
|
||||
$self->_val_check("subuser$_"), $title);
|
||||
} else {
|
||||
push @_, sprintf(" <li><input type=\"hidden\" name=\"subuser%1\$dsn\"%2\$s />\n"
|
||||
. " <input type=\"checkbox\"%3\$s disabled=\"disabled\" />\n"
|
||||
. " %4\$s\n"
|
||||
. " </li>\n",
|
||||
h($_), $self->_val_text("subuser$_" . "sn"),
|
||||
$self->_val_check("subuser$_"), h_abbr(t_na));
|
||||
}
|
||||
}
|
||||
push @_, " <li><input id=\"selsubuser\" type=\"submit\" name=\"selsubuser\" value=\"$submit\" /></li>\n";
|
||||
print "<ul>\n" . join("", @_) . " </ul>\n ";
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($self->{"type"} eq "cur") {
|
||||
# Read-only for a non-super-user editing a super-user group
|
||||
if (!is_su && $self->{"sn"} == su_group_sn) {
|
||||
$label = h_abbr(C_("[numerate,_1,User member]:", $_[0]->_delcolcount("subuser")));
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th colspan="2" scope="row">$mark$label</th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); $_ < $current->param("subusercount"); $_++) {
|
||||
push @_, " <li>" . $self->_cval_text("subuser$_" . "title") . "</li>\n";
|
||||
}
|
||||
print @_ > 0? "<ul>\n" . join("", @_) . " </ul>\n ": h_abbr(t_none);
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
|
||||
} else {
|
||||
$label = h_abbr(C_("[numerate,_1,User member]:", 0));
|
||||
$orig = h_abbr(C_("Original:"));
|
||||
$new = h_abbr(C_("New:"));
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" rowspan="2" scope="row"><label for="selsubuser">$mark$label</label></th>
|
||||
<th class="oldnew" scope="row">$orig</th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); $_ < $current->param("subusercount"); $_++) {
|
||||
push @_, " <li>" . $self->_cval_text("subuser$_" . "title") . "</li>\n";
|
||||
}
|
||||
print @_ > 0? "<ul>\n" . join("", @_) . " </ul>\n ": h_abbr(t_none);
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<th class="oldnew" scope="row"><label for="selsubuser">$new</label></th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); defined $form->param("subuser$_" . "sn"); $_++) {
|
||||
if (defined($title = user_opt_label(scalar $form->param("subuser$_" . "sn"), "subuser$_"))) {
|
||||
push @_, sprintf(" <li><input type=\"hidden\" name=\"subuser%1\$dsn\"%2\$s />\n"
|
||||
. " <input id=\"subuser%1\$d\" type=\"checkbox\" name=\"subuser%1\$d\"%3\$s />\n"
|
||||
. " %4\$s\n"
|
||||
. " </li>\n",
|
||||
h($_), $self->_val_text("subuser$_" . "sn"),
|
||||
$self->_val_check("subuser$_"), $title);
|
||||
} else {
|
||||
push @_, sprintf(" <li><input type=\"hidden\" name=\"subuser%1\$dsn\"%2\$s />\n"
|
||||
. " <input type=\"checkbox\"%3\$s disabled=\"disabled\" />\n"
|
||||
. " %4\$s\n"
|
||||
. " </li>\n",
|
||||
h($_), $self->_val_text("subuser$_" . "sn"),
|
||||
$self->_val_check("subuser$_"), h_abbr(t_na));
|
||||
}
|
||||
}
|
||||
push @_, " <li><input id=\"selsubuser\" type=\"submit\" name=\"selsubuser\" value=\"$submit\" /></li>\n";
|
||||
print "<ul>\n" . join("", @_) . " </ul>\n ";
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
|
||||
# A form to delete a current item
|
||||
} else {
|
||||
$label = h_abbr(C_("[numerate,_1,User member]:", $_[0]->_delcolcount("subuser")));
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" scope="row">$mark$label</th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); $_ < $current->param("subusercount"); $_++) {
|
||||
push @_, " <li>" . $self->_cval_text("subuser$_" . "title") . "</li>\n";
|
||||
}
|
||||
print @_ > 0? "<ul>\n" . join("", @_) . " </ul>\n ": h_abbr(t_none);
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# _html_col_subgroup: Its child groups
|
||||
sub _html_col_subgroup : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $current, $label, $orig, $new, $submit, $mark, $colspan, $title);
|
||||
#my ($col, $val, $colsn, $valsn, $title);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
$current = $self->{"cur"};
|
||||
$mark = $self->_mark("subgroup");
|
||||
$colspan = $self->_colspan;
|
||||
$submit = h_abbr(C_("Add a group"));
|
||||
|
||||
# A form to create a new item
|
||||
if ($self->{"type"} eq "new") {
|
||||
$label = h_abbr(C_("[numerate,_1,Group member]:", 0));
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" scope="row"><label for="selsubgroup">$mark$label</label></th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); defined $form->param("subgroup$_" . "sn"); $_++) {
|
||||
if (defined($title = group_opt_label(scalar $form->param("subgroup$_" . "sn"), "subgroup$_"))) {
|
||||
push @_, sprintf(" <li><input type=\"hidden\" name=\"subgroup%1\$dsn\"%2\$s />\n"
|
||||
. " <input id=\"subgroup%1\$d\" type=\"checkbox\" name=\"subgroup%1\$d\"%3\$s />\n"
|
||||
. " %4\$s\n"
|
||||
. " </li>\n",
|
||||
h($_), $self->_val_text("subgroup$_" . "sn"),
|
||||
$self->_val_check("subgroup$_"), $title);
|
||||
} else {
|
||||
push @_, sprintf(" <li><input type=\"hidden\" name=\"subgroup%1\$dsn\"%2\$s />\n"
|
||||
. " <input type=\"checkbox\"%3\$s disabled=\"disabled\" />\n"
|
||||
. " %4\$s\n"
|
||||
. " </li>\n",
|
||||
h($_), $self->_val_text("subgroup$_" . "sn"),
|
||||
$self->_val_check("subgroup$_"), h_abbr(t_na));
|
||||
}
|
||||
}
|
||||
push @_, " <li><input id=\"selsubgroup\" type=\"submit\" name=\"selsubgroup\" value=\"$submit\" /></li>\n";
|
||||
print "<ul>\n" . join("", @_) . " </ul>\n ";
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($self->{"type"} eq "cur") {
|
||||
# Read-only for a non-super-user editing a super-user group
|
||||
if (!is_su && $self->{"sn"} == su_group_sn) {
|
||||
$label = h_abbr(C_("[numerate,_1,Group member]:", $_[0]->_delcolcount("subgroup")));
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th colspan="2" scope="row">$mark$label</th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); $_ < $current->param("subgroupcount"); $_++) {
|
||||
push @_, " <li>" . $self->_cval_text("subgroup$_" . "title") . "</li>\n";
|
||||
}
|
||||
print @_ > 0? "<ul>\n" . join("", @_) . " </ul>\n ": h_abbr(t_none);
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
|
||||
} else {
|
||||
$label = h_abbr(C_("[numerate,_1,Group member]:", 0));
|
||||
$orig = h_abbr(C_("Original:"));
|
||||
$new = h_abbr(C_("New:"));
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" rowspan="2" scope="row"><label for="selsubgroup">$mark$label</label></th>
|
||||
<th class="oldnew" scope="row">$orig</th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); $_ < $current->param("subgroupcount"); $_++) {
|
||||
push @_, " <li>" . $self->_cval_text("subgroup$_" . "title") . "</li>\n";
|
||||
}
|
||||
print @_ > 0? "<ul>\n" . join("", @_) . " </ul>\n ": h_abbr(t_none);
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<th class="oldnew" scope="row"><label for="selsubgroup">$new</label></th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); defined $form->param("subgroup$_" . "sn"); $_++) {
|
||||
if (defined($title = group_opt_label(scalar $form->param("subgroup$_" . "sn"), "subgroup$_"))) {
|
||||
push @_, sprintf(" <li><input type=\"hidden\" name=\"subgroup%1\$dsn\"%2\$s />\n"
|
||||
. " <input id=\"subgroup%1\$d\" type=\"checkbox\" name=\"subgroup%1\$d\"%3\$s />\n"
|
||||
. " %4\$s\n"
|
||||
. " </li>\n",
|
||||
h($_), $self->_val_text("subgroup$_" . "sn"),
|
||||
$self->_val_check("subgroup$_"), $title);
|
||||
} else {
|
||||
push @_, sprintf(" <li><input type=\"hidden\" name=\"subgroup%1\$dsn\"%2\$s />\n"
|
||||
. " <input type=\"checkbox\"%3\$s disabled=\"disabled\" />\n"
|
||||
. " %4\$s\n"
|
||||
. " </li>\n",
|
||||
h($_), $self->_val_text("subgroup$_" . "sn"),
|
||||
$self->_val_check("subgroup$_"), h_abbr(t_na));
|
||||
}
|
||||
}
|
||||
push @_, " <li><input id=\"selsubgroup\" type=\"submit\" name=\"selsubgroup\" value=\"$submit\" /></li>\n";
|
||||
print "<ul>\n" . join("", @_) . " </ul>\n ";
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
|
||||
# A form to delete a current item
|
||||
} else {
|
||||
$label = h_abbr(C_("[numerate,_1,Group member]:", $_[0]->_delcolcount("subgroup")));
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" scope="row">$mark$label</th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); $_ < $current->param("subgroupcount"); $_++) {
|
||||
push @_, " <li>" . $self->_cval_text("subgroup$_" . "title") . "</li>\n";
|
||||
}
|
||||
print @_ > 0? "<ul>\n" . join("", @_) . " </ul>\n ": h_abbr(t_none);
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# _html_col_supgroup: Its belonging groups
|
||||
sub _html_col_supgroup : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $current, $label, $orig, $new, $submit, $mark, $colspan, $title);
|
||||
#my ($col, $val, $colsn, $valsn, $title);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
$current = $self->{"cur"};
|
||||
$mark = $self->_mark("supgroup");
|
||||
$colspan = $self->_colspan;
|
||||
$label = h_abbr(C_("Belonging to:"));
|
||||
$submit = h_abbr(C_("Add a group"));
|
||||
|
||||
# A form to create a new item
|
||||
if ($self->{"type"} eq "new") {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" scope="row"><label for="selsupgroup">$mark$label</label></th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); defined $form->param("supgroup$_" . "sn"); $_++) {
|
||||
if (defined($title = group_opt_label(scalar $form->param("supgroup$_" . "sn"), "supgroup$_"))) {
|
||||
push @_, sprintf(" <li><input type=\"hidden\" name=\"supgroup%1\$dsn\"%2\$s />\n"
|
||||
. " <input id=\"supgroup%1\$d\" type=\"checkbox\" name=\"supgroup%1\$d\"%3\$s />\n"
|
||||
. " %4\$s\n"
|
||||
. " </li>\n",
|
||||
h($_), $self->_val_text("supgroup$_" . "sn"),
|
||||
$self->_val_check("supgroup$_"), $title);
|
||||
} else {
|
||||
push @_, sprintf(" <li><input type=\"hidden\" name=\"supgroup%1\$dsn\"%2\$s />\n"
|
||||
. " <input type=\"checkbox\"%3\$s disabled=\"disabled\" />\n"
|
||||
. " %4\$s\n"
|
||||
. " </li>\n",
|
||||
h($_), $self->_val_text("supgroup$_" . "sn"),
|
||||
$self->_val_check("supgroup$_"), h_abbr(t_na));
|
||||
}
|
||||
}
|
||||
push @_, " <li><input id=\"selsupgroup\" type=\"submit\" name=\"selsupgroup\" value=\"$submit\" /></li>\n";
|
||||
print "<ul>\n" . join("", @_) . " </ul>\n ";
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($self->{"type"} eq "cur") {
|
||||
# Read-only for a non-super-user editing a super-user group
|
||||
if (!is_su && $self->{"sn"} == su_group_sn) {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th colspan="2" scope="row">$mark$label</th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); $_ < $current->param("supgroupcount"); $_++) {
|
||||
push @_, " <li>" . $self->_cval_text("supgroup$_" . "title") . "</li>\n";
|
||||
}
|
||||
print @_ > 0? "<ul>\n" . join("", @_) . " </ul>\n ": h_abbr(t_none);
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
|
||||
} else {
|
||||
$orig = h_abbr(C_("Original:"));
|
||||
$new = h_abbr(C_("New:"));
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" rowspan="2" scope="row"><label for="selsupgroup">$mark$label</label></th>
|
||||
<th class="oldnew" scope="row">$orig</th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); $_ < $current->param("supgroupcount"); $_++) {
|
||||
push @_, " <li>" . $self->_cval_text("supgroup$_" . "title") . "</li>\n";
|
||||
}
|
||||
print @_ > 0? "<ul>\n" . join("", @_) . " </ul>\n ": h_abbr(t_none);
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<th class="oldnew" scope="row"><label for="selsupgroup">$new</label></th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); defined $form->param("supgroup$_" . "sn"); $_++) {
|
||||
if (defined($title = group_opt_label(scalar $form->param("supgroup$_" . "sn"), "supgroup$_"))) {
|
||||
push @_, sprintf(" <li><input type=\"hidden\" name=\"supgroup%1\$dsn\"%2\$s />\n"
|
||||
. " <input id=\"supgroup%1\$d\" type=\"checkbox\" name=\"supgroup%1\$d\"%3\$s />\n"
|
||||
. " %4\$s\n"
|
||||
. " </li>\n",
|
||||
h($_), $self->_val_text("supgroup$_" . "sn"),
|
||||
$self->_val_check("supgroup$_"), $title);
|
||||
} else {
|
||||
push @_, sprintf(" <li><input type=\"hidden\" name=\"supgroup%1\$dsn\"%2\$s />\n"
|
||||
. " <input type=\"checkbox\"%3\$s disabled=\"disabled\" />\n"
|
||||
. " %4\$s\n"
|
||||
. " </li>\n",
|
||||
h($_), $self->_val_text("supgroup$_" . "sn"),
|
||||
$self->_val_check("supgroup$_"), h_abbr(t_na));
|
||||
}
|
||||
}
|
||||
push @_, " <li><input id=\"selsupgroup\" type=\"submit\" name=\"selsupgroup\" value=\"$submit\" /></li>\n";
|
||||
print "<ul>\n" . join("", @_) . " </ul>\n ";
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
|
||||
# A form to delete a current item
|
||||
} else {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" scope="row">$mark$label</th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); $_ < $current->param("supgroupcount"); $_++) {
|
||||
push @_, " <li>" . $self->_cval_text("supgroup$_" . "title") . "</li>\n";
|
||||
}
|
||||
print @_ > 0? "<ul>\n" . join("", @_) . " </ul>\n ": h_abbr(t_none);
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
return 1;
|
||||
93
lib/perl5/Selima/Form/GroupMem.pm
Normal file
93
lib/perl5/Selima/Form/GroupMem.pm
Normal file
@@ -0,0 +1,93 @@
|
||||
# Selima Website Content Management System
|
||||
# GroupMem.pm: The group-to-group membership form.
|
||||
|
||||
# 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::Form::GroupMem;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form);
|
||||
|
||||
use Selima::FormFunc;
|
||||
use Selima::HTTP;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
use Selima::UserName;
|
||||
|
||||
# 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"} = "groupmem"
|
||||
if !exists $$args{"table"};
|
||||
$$args{"deltext"} = C_("Delete this membership record")
|
||||
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 membership record.");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"summary"} = C_("This table provides you a form to change a current membership record.");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"summary"} = C_("This table provides you a form to delete a membership record.");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"cols"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"cols"} = [qw(grp member)];
|
||||
# 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 grp member
|
||||
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 Group Membership Record");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"title"} = C_("Change a Current Group Membership Record");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"title"} = C_("Delete a Group Membership Record");
|
||||
}
|
||||
}
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _html_col_member: The member
|
||||
sub _html_col_member : method {
|
||||
$_[0]->_html_coltmpl_call("member", h_abbr(C_("Member:")), \&groupdsc);
|
||||
}
|
||||
|
||||
return 1;
|
||||
116
lib/perl5/Selima/Form/Guestbook.pm
Normal file
116
lib/perl5/Selima/Form/Guestbook.pm
Normal file
@@ -0,0 +1,116 @@
|
||||
# Selima Website Content Management System
|
||||
# Guestbook.pm: The base administrative guestbook form.
|
||||
|
||||
# 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::Form::Guestbook;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form);
|
||||
|
||||
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"} = "guestbook"
|
||||
if !exists $$args{"table"};
|
||||
$$args{"deltext"} = C_("Delete this message")
|
||||
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 message.");
|
||||
# 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 message.");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"summary"} = C_("This table provides you a form to delete a message.");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"cols"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"cols"} = [qw(name identity location email url message hid)];
|
||||
# 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 name identity location email url message hid
|
||||
ip host ct pageno oldpageno
|
||||
created createdby updated updatedby)];
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"title"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"title"} = C_("Write a New Message");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"title"} = C_("Edit a Current Message");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"title"} = C_("Delete a Message");
|
||||
}
|
||||
}
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
${$self->{"maxlens"}}{"message"} = 10240;
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _html_col_ct: The country
|
||||
sub _html_col_ct : method {
|
||||
$_[0]->_html_coltmpl_ro_ct("ct", h_abbr(C_("Country:")));
|
||||
}
|
||||
|
||||
# _html_col_hid: Hide?
|
||||
sub _html_col_hid : method {
|
||||
$_[0]->_html_coltmpl_bool("hid", h_abbr(C_("Hide?")),
|
||||
h_abbr(C_("Hide this message")), h_abbr(C_("Show this message")),
|
||||
h_abbr(C_("Hide this message currently.")));
|
||||
}
|
||||
|
||||
# _html_col_name: The name
|
||||
sub _html_col_name : method {
|
||||
$_[0]->_html_coltmpl_text("name", h_abbr(C_("Signature:")));
|
||||
}
|
||||
|
||||
# _html_col_oldpageno: The old page number
|
||||
sub _html_col_oldpageno : method {
|
||||
$_[0]->_html_coltmpl_ro("oldpageno", h_abbr(C_("Old page no.:")));
|
||||
}
|
||||
|
||||
# _html_col_pageno: The page number
|
||||
sub _html_col_pageno : method {
|
||||
$_[0]->_html_coltmpl_ro("pageno", h_abbr(C_("Page no.:")));
|
||||
}
|
||||
|
||||
return 1;
|
||||
86
lib/perl5/Selima/Form/Guestbook/Public.pm
Normal file
86
lib/perl5/Selima/Form/Guestbook/Public.pm
Normal file
@@ -0,0 +1,86 @@
|
||||
# Selima Website Content Management System
|
||||
# Public.pm: The base guestbook form.
|
||||
|
||||
# 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::Form::Guestbook::Public;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form::Guestbook);
|
||||
|
||||
use Selima::DataVars qw(:lninfo);
|
||||
use Selima::GetLang;
|
||||
use Selima::HTTP;
|
||||
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";
|
||||
# This should always be always a new form
|
||||
$$args{"type"} = "new"
|
||||
if !exists $$args{"type"};
|
||||
$$args{"type_to_pass"} = undef
|
||||
if !exists $$args{"type_to_pass"};
|
||||
$$args{"valid_types"} = [qw(new)]
|
||||
if !exists $$args{"valid_types"};
|
||||
$$args{"table"} = "guestbook"
|
||||
if !exists $$args{"table"};
|
||||
$$args{"header_buttons"} = []
|
||||
if !exists $$args{"header_buttons"};
|
||||
$$args{"footer_buttons"} = [
|
||||
{ "name" => "submit", "value" => h(C_("Leave a messsage")) } ]
|
||||
if !exists $$args{"footer_buttons"};
|
||||
$$args{"summary"} = C_("This table provides you a form to leave a message.")
|
||||
if !exists $$args{"summary"};
|
||||
$$args{"onsubmit"} = "return isGuestbookOK(this);"
|
||||
if !exists $$args{"onsubmit"};
|
||||
$$args{"cols"} = [qw(message name identity location email captcha url)]
|
||||
if !exists $$args{"cols"};
|
||||
$$args{"auto_referer2"} = 0
|
||||
if !exists $$args{"auto_referer2"};
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _html_col_message: The message
|
||||
sub _html_col_message : method {
|
||||
local ($_, %_);
|
||||
my ($self, $val, $label, $default, $colspan, $hdef);
|
||||
$self = $_[0];
|
||||
$colspan = $self->_colspan_full;
|
||||
$default = C_("Fill in your message here.");
|
||||
$val = $self->_val_textarea("message", $default);
|
||||
$hdef = h($default);
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<td class="gbmessage"$colspan><textarea id="message" name="message" cols="50" rows="10"
|
||||
onfocus="if (this.value == "$hdef") this.value = "";">$val</textarea></td>
|
||||
</tr>
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
return 1;
|
||||
190
lib/perl5/Selima/Form/Link.pm
Normal file
190
lib/perl5/Selima/Form/Link.pm
Normal file
@@ -0,0 +1,190 @@
|
||||
# Selima Website Content Management System
|
||||
# Link.pm: The related-link form.
|
||||
|
||||
# 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::Form::Link;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form);
|
||||
|
||||
use Selima::ChkFunc;
|
||||
use Selima::CommText;
|
||||
use Selima::FormFunc;
|
||||
use Selima::HTTP;
|
||||
use Selima::Links;
|
||||
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"} = "links"
|
||||
if !exists $$args{"table"};
|
||||
$$args{"deltext"} = C_("Delete this related link")
|
||||
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 related link.");
|
||||
# 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 related link.");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"summary"} = C_("This table provides you a form to delete a related link.");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"cols"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"cols"} = [qw(title title_2ln url icon email
|
||||
addr tel fax dsc hid cats)];
|
||||
# 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 title title_2ln url icon email
|
||||
addr tel fax dsc hid cats
|
||||
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 Related Link");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"title"} = C_("Edit a Current Related Link");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"title"} = C_("Delete a Related Link");
|
||||
}
|
||||
}
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _html_col_cats: The categories
|
||||
sub _html_col_cats : method {
|
||||
$_[0]->_html_coltmpl_select_multi("cat",
|
||||
h_abbr(C_("[numerate,_1,Category,Categories]:", $_[0]->_delcolcount("cat"))),
|
||||
\&linkcat_options);
|
||||
}
|
||||
|
||||
# _html_col_hid: Hide?
|
||||
sub _html_col_hid : method {
|
||||
$_[0]->_html_coltmpl_bool("hid", h_abbr(C_("Hide?")),
|
||||
h_abbr(C_("Hide this related link")), h_abbr(C_("Show this related link")),
|
||||
h_abbr(C_("Hide this related link currently.")));
|
||||
}
|
||||
|
||||
# _html_col_icon: The link icon
|
||||
sub _html_col_icon : method {
|
||||
local ($_, %_);
|
||||
my ($self, $label, $alt, $size, $mark, $colspan);
|
||||
my ($cur, $preview, $val, $orig, $new);
|
||||
$self = $_[0];
|
||||
$mark = $self->_mark("icon");
|
||||
$colspan = $self->_colspan;
|
||||
$label = h_abbr(C_("Link icon:"));
|
||||
$alt = h(C_("Link icon unavailable"));
|
||||
$size = h($self->{"defsize"});
|
||||
$self->{"form"}->param("icon", "http://")
|
||||
if $self->{"is_first_form"} && !defined $self->{"form"}->param("icon");
|
||||
|
||||
# A form to create a new item
|
||||
if ($self->{"type"} eq "new") {
|
||||
$val = $self->_val_text("icon", "icon");
|
||||
if (is_url_wellformed $self->{"form"}->param("icon")) {
|
||||
$preview = "<img src=\"" . h($self->{"form"}->param("icon"))
|
||||
. "\" alt=\"$alt\" /><br />\n";
|
||||
} else {
|
||||
$preview = "";
|
||||
}
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" scope="row"><label for="icon">$mark$label</label></th>
|
||||
<td$colspan>$preview<input id="icon" class="text" type="text" name="icon" size="$size"$val /></td>
|
||||
</tr>
|
||||
EOT
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($self->{"type"} eq "cur") {
|
||||
$cur = $self->{"cur"}->param("icon");
|
||||
if (defined $cur) {
|
||||
$cur = "<img src=\"" . h($cur) . "\" alt=\"$alt\" /><br />\n"
|
||||
. " " . h($cur);
|
||||
} else {
|
||||
$cur = h_abbr(t_none);
|
||||
}
|
||||
$val = $self->_val_text("icon", "icon");
|
||||
if (is_url_wellformed $self->{"form"}->param("icon")) {
|
||||
$preview = "<img src=\"" . h($self->{"form"}->param("icon"))
|
||||
. "\" alt=\"$alt\" /><br />\n";
|
||||
} else {
|
||||
$preview = "";
|
||||
}
|
||||
$orig = h_abbr(C_("Original:"));
|
||||
$new = h_abbr(C_("New:"));
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" rowspan="2" scope="row"><label for="icon">$mark$label</label></th>
|
||||
<th class="oldnew" scope="row">$orig</th>
|
||||
<td$colspan>$cur</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<th class="oldnew" scope="row"><label for="icon">$new</label></th>
|
||||
<td$colspan>$preview<input id="icon" class="text" type="text" name="icon" size="$size"$val /></td>
|
||||
</tr>
|
||||
EOT
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($self->{"type"} eq "del") {
|
||||
$cur = $self->{"cur"}->param("icon");
|
||||
if (defined $cur) {
|
||||
$cur = "<img src=\"" . h($cur) . "\" alt=\"$alt\" /><br />\n"
|
||||
. " " . h($cur);
|
||||
} else {
|
||||
$cur = h_abbr(t_none);
|
||||
}
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" scope="row">$mark$label</th>
|
||||
<td$colspan>$cur</td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# _html_col_title_2ln: Title in the second language
|
||||
sub _html_col_title_2ln : method {
|
||||
$_[0]->_html_coltmpl_text("title_2ln", h_abbr(C_("2nd language title:")));
|
||||
}
|
||||
|
||||
return 1;
|
||||
145
lib/perl5/Selima/Form/LinkCat.pm
Normal file
145
lib/perl5/Selima/Form/LinkCat.pm
Normal file
@@ -0,0 +1,145 @@
|
||||
# Selima Website Content Management System
|
||||
# LinkCat.pm: The related-link category form.
|
||||
|
||||
# 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::Form::LinkCat;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form);
|
||||
|
||||
use Selima::CommText;
|
||||
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"} = "linkcat"
|
||||
if !exists $$args{"table"};
|
||||
$$args{"deltext"} = C_("Delete this category")
|
||||
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 category.");
|
||||
# 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 category.");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"summary"} = C_("This table provides you a form to delete a category.");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"cols"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"cols"} = [qw(parent id ord title kw hid)];
|
||||
# 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 id ord title kw hid
|
||||
scats links
|
||||
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 Link Category");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"title"} = C_("Edit a Current Link Category");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"title"} = C_("Delete a Link Category");
|
||||
}
|
||||
}
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
${$self->{"maxlens"}}{"ord"} = 2;
|
||||
if ($self->{"type"} eq "cur") {
|
||||
if (defined $self->{"cur"}->param("scatcount") && $self->{"cur"}->param("scatcount") > 0) {
|
||||
$self->{"nodelete"} = 1;
|
||||
push @{$self->{"prefmsg"}}, C_("This category has [numerate,_1,a subcategory,subcategories]. It cannot be deleted. To delete the category, [numerate,_1,its subcategory,all of its subcategories] must first be deleted.", $self->{"cur"}->param("scatcount"));
|
||||
}
|
||||
if (defined $self->{"cur"}->param("linkcount") && $self->{"cur"}->param("linkcount") > 0) {
|
||||
$self->{"nodelete"} = 1;
|
||||
push @{$self->{"prefmsg"}}, C_("This category has [numerate,_1,a link,links]. It cannot be deleted. To delete the category, [numerate,_1,its link,all of its links] must first be deleted.", $self->{"cur"}->param("linkcount"));
|
||||
}
|
||||
}
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _html_col_hid: Hide?
|
||||
sub _html_col_hid : method {
|
||||
$_[0]->_html_coltmpl_bool("hid", h_abbr(C_("Hide?")),
|
||||
h_abbr(C_("Hide this category")), h_abbr(C_("Show this category")),
|
||||
h_abbr(C_("Hide this category currently.")));
|
||||
}
|
||||
|
||||
# _html_col_id: The ID.
|
||||
sub _html_col_id : method {
|
||||
$_[0]->_html_coltmpl_text("id", h_abbr(C_("ID.:")), undef, 8);
|
||||
}
|
||||
|
||||
# _html_col_links: The links
|
||||
sub _html_col_links : method {
|
||||
my ($self, $form, $current, $label, $mark, $colspan, $thclass, $thcolspan);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
$current = $self->{"cur"};
|
||||
$mark = $self->_mark("links");
|
||||
$colspan = $self->_colspan;
|
||||
$label = h_abbr(C_("[numerate,_1,Link,Links]:", $current->param("linkcount")));
|
||||
# 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>";
|
||||
for ($_ = 0, @_ = qw(); $_ < $current->param("linkcount"); $_++) {
|
||||
push @_, sprintf(" <li><a href=\"%1\$s\">%2\$s</a>\n"
|
||||
. " (<a href=\"%3\$s\"><samp>%3\$s</samp></a>)\n"
|
||||
. " </li>\n",
|
||||
h("links.cgi?form=cur&sn=" . $current->param("link$_" . "sn")),
|
||||
h_abbr($current->param("link$_" . "title")),
|
||||
h($current->param("link$_" . "url")));
|
||||
}
|
||||
print @_ > 0? "<ul>\n" . join("", @_) ." </ul>\n ": h_abbr(t_none);
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
|
||||
return 1;
|
||||
98
lib/perl5/Selima/Form/LinkCatz.pm
Normal file
98
lib/perl5/Selima/Form/LinkCatz.pm
Normal file
@@ -0,0 +1,98 @@
|
||||
# Selima Website Content Management System
|
||||
# LinkCatz.pm: The related-link category membership form.
|
||||
|
||||
# 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::Form::LinkCatz;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form);
|
||||
|
||||
use Selima::FormFunc;
|
||||
use Selima::HTTP;
|
||||
use Selima::Links;
|
||||
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"} = "linkcatz"
|
||||
if !exists $$args{"table"};
|
||||
$$args{"deltext"} = C_("Delete this categorization record")
|
||||
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 categorization record.");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"summary"} = C_("This table provides you a form to change a current categorization record.");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"summary"} = C_("This table provides you a form to delete a categorization record.");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"cols"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"cols"} = [qw(cat link)];
|
||||
# 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 cat link
|
||||
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 Link Categorization Record");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"title"} = C_("Change a Current Link Categorization Record");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"title"} = C_("Delete a Link Categorization Record");
|
||||
}
|
||||
}
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _html_col_cat: The category
|
||||
sub _html_col_cat : method {
|
||||
$_[0]->_html_coltmpl_call("cat", h_abbr(C_("Category:")), \&linkcat_title);
|
||||
}
|
||||
|
||||
# _html_col_link: The link
|
||||
sub _html_col_link : method {
|
||||
$_[0]->_html_coltmpl_call("link", h_abbr(C_("Link:")), \&link_title);
|
||||
}
|
||||
|
||||
return 1;
|
||||
100
lib/perl5/Selima/Form/Page.pm
Normal file
100
lib/perl5/Selima/Form/Page.pm
Normal file
@@ -0,0 +1,100 @@
|
||||
# Selima Website Content Management System
|
||||
# Page.pm: The base web page form.
|
||||
|
||||
# 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::Form::Page;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form);
|
||||
|
||||
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"} = "pages"
|
||||
if !exists $$args{"table"};
|
||||
$$args{"deltext"} = C_("Delete this page")
|
||||
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 write a new page.");
|
||||
# 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 page.");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"summary"} = C_("This table provides you a form to delete a page.");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"cols"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"cols"} = [qw(path ord title body kw html hid)];
|
||||
# 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 path ord title body kw html hid
|
||||
created createdby updated updatedby)];
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"title"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"title"} = C_("Write a New Page");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"title"} = C_("Edit a Current Page");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"title"} = C_("Delete a Page");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"preview"}) {
|
||||
$$args{"preview"} = 1;
|
||||
}
|
||||
if ($$args{"preview"} && !exists $$args{"prevmsg"}) {
|
||||
$$args{"prevmsg"} = C_("Preview this page.");
|
||||
}
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _html_col_hid: Hide?
|
||||
sub _html_col_hid : method {
|
||||
$_[0]->_html_coltmpl_bool("hid", h_abbr(C_("Hide?")),
|
||||
h_abbr(C_("Hide this page")), h_abbr(C_("Show this page")),
|
||||
h_abbr(C_("Hide this page currently.")));
|
||||
}
|
||||
|
||||
return 1;
|
||||
70
lib/perl5/Selima/Form/Rebuild.pm
Normal file
70
lib/perl5/Selima/Form/Rebuild.pm
Normal file
@@ -0,0 +1,70 @@
|
||||
# Selima Website Content Management System
|
||||
# Rebuild.pm: The web page rebuild form.
|
||||
|
||||
# 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-04-04
|
||||
|
||||
package Selima::Form::Rebuild;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form);
|
||||
|
||||
use Selima::HTTP;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::PageFunc;
|
||||
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"} = "new"
|
||||
if !exists $$args{"type"};
|
||||
$$args{"type_to_pass"} = undef
|
||||
if !exists $$args{"type_to_pass"};
|
||||
$$args{"valid_types"} = [qw(new)]
|
||||
if !exists $$args{"valid_types"};
|
||||
$$args{"cols"} = [qw(type)]
|
||||
if !exists $$args{"cols"};
|
||||
$$args{"title"} = C_("Rebuild the Pages")
|
||||
if !exists $$args{"title"};
|
||||
$$args{"header_buttons"} = []
|
||||
if !exists $$args{"header_buttons"};
|
||||
$$args{"footer_buttons"} = [
|
||||
{ "name" => "confirm", "value" => h(C_("Confirm")) },
|
||||
{ "name" => "cancel", "value" => h(C_("Cancel")) } ]
|
||||
if !exists $$args{"footer_buttons"};
|
||||
$$args{"auto_referer2"} = 0
|
||||
if !exists $$args{"auto_referer2"};
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _html_col_type: The page type
|
||||
sub _html_col_type : method {
|
||||
$_[0]->_html_coltmpl_select("type", h_abbr(C_("Type:")),
|
||||
\&rebuildtype_options, undef);
|
||||
}
|
||||
|
||||
return 1;
|
||||
93
lib/perl5/Selima/Form/ScptPriv.pm
Normal file
93
lib/perl5/Selima/Form/ScptPriv.pm
Normal file
@@ -0,0 +1,93 @@
|
||||
# Selima Website Content Management System
|
||||
# ScptPriv.pm: The script privilege form.
|
||||
|
||||
# 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::Form::ScptPriv;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form);
|
||||
|
||||
use Selima::FormFunc;
|
||||
use Selima::HTTP;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
use Selima::UserName;
|
||||
|
||||
# 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"} = "scptpriv"
|
||||
if !exists $$args{"table"};
|
||||
$$args{"deltext"} = C_("Delete this script privilege record")
|
||||
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 script privilege record.");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"summary"} = C_("This table provides you a form to change a current script privilege record.");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"summary"} = C_("This table provides you a form to delete a script privilege record.");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"cols"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"cols"} = [qw(script grp)];
|
||||
# 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 script grp
|
||||
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 Script Privilege Record");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"title"} = C_("Change a Current Script Privilege Record");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"title"} = C_("Delete a Script Privilege Record");
|
||||
}
|
||||
}
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _html_col_grp: The privileged group
|
||||
sub _html_col_grp : method {
|
||||
$_[0]->_html_coltmpl_call("grp", h_abbr(C_("Privilege:")), \&groupdsc);
|
||||
}
|
||||
|
||||
return 1;
|
||||
389
lib/perl5/Selima/Form/User.pm
Normal file
389
lib/perl5/Selima/Form/User.pm
Normal file
@@ -0,0 +1,389 @@
|
||||
# Selima Website Content Management System
|
||||
# User.pm: The user account form.
|
||||
|
||||
# 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-30
|
||||
|
||||
package Selima::Form::User;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form);
|
||||
|
||||
use Selima::ChkPriv;
|
||||
use Selima::CommText;
|
||||
use Selima::DataVars qw($DBH :groups :l10n :lninfo);
|
||||
use Selima::FormFunc;
|
||||
use Selima::GetLang;
|
||||
use Selima::HTTP;
|
||||
use Selima::LnInfo;
|
||||
use Selima::LogIn;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
use Selima::UserName;
|
||||
|
||||
# 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"} = "users"
|
||||
if !exists $$args{"table"};
|
||||
$$args{"deltext"} = C_("Delete this user account")
|
||||
if !exists $$args{"deltext"};
|
||||
$$args{"https"} = ($$args{"type"} ne "del")
|
||||
if !exists $$args{"https"};
|
||||
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 user account.");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"summary"} = C_("This table provides you a form to update a current user account.");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"summary"} = C_("This table provides you a form to delete a user account.");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"cols"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"cols"} = [qw(id passwd name disabled supgroup)];
|
||||
# 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 id passwd name disabled supgroup
|
||||
admin lang visits visited ip host ct
|
||||
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 User Account");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"title"} = C_("Update a Current User Account");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"title"} = C_("Delete a User Account");
|
||||
}
|
||||
}
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
${$self->{"maxlens"}}{"passwd"} = 16;
|
||||
if ( $$args{"type"} eq "cur" && !is_su
|
||||
&& ($self->{"cur"}->param("su") || $self->{"sn"} == get_login_sn)) {
|
||||
$self->{"nodelete"} = 1;
|
||||
push @{$self->{"prefmsg"}}, C_("This is a super-user. You can only change parts of her/his infomation.")
|
||||
if $self->{"cur"}->param("su");
|
||||
}
|
||||
# Set all the available belonging groups list
|
||||
$self->_set_supgroup_list();
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _set_supgroup_list: Set all the available belonging groups list
|
||||
sub _set_supgroup_list : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, %checked, $sth, $sql, $count);
|
||||
my ($lndb, $lndbdef, $title);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# Get the list of checked groups
|
||||
%checked = qw();
|
||||
for ($_ = 0; defined $form->param("supgroup$_" . "sn"); $_++) {
|
||||
$checked{$form->param("supgroup$_" . "sn")} = 1
|
||||
if defined $form->param("supgroup$_");
|
||||
}
|
||||
|
||||
# Remove the old groups list
|
||||
foreach ($form->param) {
|
||||
$form->delete($_) if /^supgroup/;
|
||||
}
|
||||
|
||||
# Get the list of all groups
|
||||
if (@ALL_LINGUAS > 1) {
|
||||
$lndb = getlang LN_DATABASE;
|
||||
if (getlang eq $DEFAULT_LANG) {
|
||||
$title = $DBH->strcat("id", "' ('", "dsc_$lndb", "')'");
|
||||
} else {
|
||||
$lndbdef = ln $DEFAULT_LANG, LN_DATABASE;
|
||||
$title = $DBH->strcat("id", "' ('",
|
||||
"COALESCE(dsc_$lndb, dsc_$lndbdef)", "')'");
|
||||
}
|
||||
} else {
|
||||
$title = $DBH->strcat("id", "' ('", "dsc", "')'");
|
||||
}
|
||||
$sql = "SELECT sn AS sn, $title AS title FROM groups"
|
||||
. " WHERE id!=" . $DBH->quote(SU_GROUP)
|
||||
. " AND id!=" . $DBH->quote(ADMIN_GROUP)
|
||||
. " AND id!=" . $DBH->quote(ALLUSERS_GROUP)
|
||||
. " ORDER BY id;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$count = $sth->rows;
|
||||
for ($_ = 0; $_ < $count; $_++) {
|
||||
%_ = %{$sth->fetchrow_hashref};
|
||||
$form->param("supgroup$_" . "sn", $_{"sn"});
|
||||
$form->param("supgroup$_" . "title", $_{"title"});
|
||||
$form->param("supgroup$_", 1) if exists $checked{$_{"sn"}};
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# _html_col_admin: Is this user an administrator?
|
||||
sub _html_col_admin : method {
|
||||
$_[0]->_html_coltmpl_ro_bool("admin", h_abbr(C_("Administrator?")),
|
||||
h_abbr(C_("Administrator")), h_abbr(C_("Non-administrator")));
|
||||
}
|
||||
|
||||
# _html_col_ct: The country
|
||||
sub _html_col_ct : method {
|
||||
$_[0]->_html_coltmpl_ro_ct("ct", h_abbr(C_("Country:")));
|
||||
}
|
||||
|
||||
# _html_col_disabled: Disabled?
|
||||
sub _html_col_disabled : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Read-only for a non-super-user editing herself or a super-user
|
||||
if ( $self->{"type"} eq "cur" && !is_su
|
||||
&& ($self->{"cur"}->param("su") || $self->{"sn"} == get_login_sn)) {
|
||||
$self->_html_coltmpl_ro_bool("disabled", h_abbr(C_("Disabled?")),
|
||||
h_abbr(C_("Disabled")), h_abbr(C_("Enabled")));
|
||||
} else {
|
||||
$self->_html_coltmpl_bool("disabled", h_abbr(C_("Disabled?")),
|
||||
h_abbr(C_("Disabled")), h_abbr(C_("Enabled")),
|
||||
h_abbr(C_("Disable this user account.")));
|
||||
}
|
||||
}
|
||||
|
||||
# _html_col_id: The user ID.
|
||||
sub _html_col_id : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Read-only for a non-super-user editing a super-user
|
||||
if ($self->{"type"} eq "cur" && !is_su && $self->{"cur"}->param("su")) {
|
||||
$self->_html_coltmpl_ro("id", h_abbr(C_("User ID.:")));
|
||||
} else {
|
||||
$self->_html_coltmpl_text("id", h_abbr(C_("User ID.:")));
|
||||
}
|
||||
}
|
||||
|
||||
# _html_col_lang: The preferred language
|
||||
sub _html_col_lang : method {
|
||||
$_[0]->_html_coltmpl_ro_lang("lang", h_abbr(C_("Pref. language:")));
|
||||
}
|
||||
|
||||
# _html_col_name: The name
|
||||
sub _html_col_name : method {
|
||||
$_[0]->_html_coltmpl_text("name", h_abbr(C_("Full name:")));
|
||||
}
|
||||
|
||||
# _html_col_passwd: The password
|
||||
sub _html_col_passwd : method {
|
||||
local ($_, %_);
|
||||
my ($self, $label, $dummy, $mark, $colspan);
|
||||
$self = $_[0];
|
||||
# Read-only for a non-super-user editing a super-user
|
||||
if ($self->{"type"} eq "cur" && !is_su && $self->{"cur"}->param("su")) {
|
||||
$mark = $self->_mark("passwd");
|
||||
$colspan = $self->_colspan;
|
||||
$label = h_abbr(C_("Password:"));
|
||||
$dummy = h("*" x ${$self->{"maxlens"}}{"passwd"});
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th colspan="2" scope="row">$mark$label</th>
|
||||
<td$colspan>$dummy</td>
|
||||
</tr>
|
||||
EOT
|
||||
} else {
|
||||
$self->SUPER::_html_col_passwd();
|
||||
}
|
||||
}
|
||||
|
||||
# _html_col_supgroup: Its belonging groups
|
||||
sub _html_col_supgroup : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $current, $label, $orig, $new, $mark, $colspan);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
$current = $self->{"cur"};
|
||||
$mark = $self->_mark("supgroup");
|
||||
$colspan = $self->_colspan;
|
||||
$label = h_abbr(C_("Belonging to:"));
|
||||
|
||||
# A form to create a new item
|
||||
if ($self->{"type"} eq "new") {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" scope="row"><label for="supgroup0">$mark$label</label></th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); defined $form->param("supgroup$_" . "sn"); $_++) {
|
||||
push @_, sprintf(" <li><input type=\"hidden\" name=\"supgroup%1\$dsn\"%2\$s />\n"
|
||||
. " <input id=\"supgroup%1\$d\" type=\"checkbox\" name=\"supgroup%1\$d\"%3\$s />\n"
|
||||
. " <label for=\"supgroup%1\$d\">%4\$s</label>\n"
|
||||
. " </li>\n",
|
||||
h($_), $self->_val_text("supgroup$_" . "sn"),
|
||||
$self->_val_check("supgroup$_"),
|
||||
h_abbr($form->param("supgroup$_" . "title")));
|
||||
}
|
||||
# Only super users can set the super-user group
|
||||
if (su_group_sn != 0) {
|
||||
if (is_su) {
|
||||
push @_, sprintf(" <li><input id=\"su\" type=\"checkbox\" name=\"su\"%s />\n"
|
||||
. " %s\n"
|
||||
. " </li>\n",
|
||||
$self->_val_check("su"),
|
||||
group_opt_label(su_group_sn, "su"));
|
||||
} else {
|
||||
push @_, sprintf(" <li><input id=\"su\" type=\"checkbox\" disabled=\"disabled\" />\n"
|
||||
. " %s\n"
|
||||
. " </li>\n",
|
||||
group_opt_label(su_group_sn));
|
||||
}
|
||||
}
|
||||
# Attach the all-users group in any case
|
||||
push @_, sprintf(" <li><input id=\"su\" type=\"checkbox\" checked=\"checked\" disabled=\"disabled\" />\n"
|
||||
. " %s\n"
|
||||
. " </li>\n",
|
||||
group_opt_label(groupsn(ALLUSERS_GROUP)))
|
||||
if defined groupsn(ALLUSERS_GROUP);
|
||||
print "<ul>\n" . join("", @_) . " </ul>\n ";
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($self->{"type"} eq "cur") {
|
||||
# Read-only for a non-super-user editing herself or a super-user
|
||||
if (!is_su && $self->{"sn"} == get_login_sn) {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th colspan="2" scope="row">$mark$label</th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); $_ < $current->param("supgroupcount"); $_++) {
|
||||
push @_, " <li>" . h_abbr($current->param("supgroup$_" . "title")) . "</li>\n";
|
||||
}
|
||||
push @_, " <li>" . group_opt_label(su_group_sn) . "</li>\n"
|
||||
if $current->param("su");
|
||||
push @_, " <li>" . group_opt_label(groupsn(ALLUSERS_GROUP)) . "</li>\n"
|
||||
if defined groupsn(ALLUSERS_GROUP);
|
||||
print @_ > 0? "<ul>\n" . join("", @_) . " </ul>\n ": h_abbr(t_none);
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
|
||||
} else {
|
||||
$orig = h_abbr(C_("Original:"));
|
||||
$new = h_abbr(C_("New:"));
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" rowspan="2" scope="row"><label for="supgroup0">$mark$label</label></th>
|
||||
<th class="oldnew" scope="row">$orig</th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); $_ < $current->param("supgroupcount"); $_++) {
|
||||
push @_, " <li>" . h_abbr($current->param("supgroup$_" . "title")) . "</li>\n";
|
||||
}
|
||||
push @_, " <li>" . group_opt_label(su_group_sn) . "</li>\n"
|
||||
if $current->param("su");
|
||||
push @_, " <li>" . group_opt_label(groupsn(ALLUSERS_GROUP)) . "</li>\n"
|
||||
if defined groupsn(ALLUSERS_GROUP);
|
||||
print @_ > 0? "<ul>\n" . join("", @_) . " </ul>\n ": h_abbr(t_none);
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<th class="oldnew" scope="row"><label for="supgroup0">$new</label></th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); defined $form->param("supgroup$_" . "sn"); $_++) {
|
||||
push @_, sprintf(" <li><input type=\"hidden\" name=\"supgroup%1\$dsn\"%2\$s />\n"
|
||||
. " <input id=\"supgroup%1\$d\" type=\"checkbox\" name=\"supgroup%1\$d\"%3\$s />\n"
|
||||
. " <label for=\"supgroup%1\$d\">%4\$s</label>\n"
|
||||
. " </li>\n",
|
||||
h($_), $self->_val_text("supgroup$_" . "sn"),
|
||||
$self->_val_check("supgroup$_"),
|
||||
h_abbr($form->param("supgroup$_" . "title")));
|
||||
}
|
||||
# Only super users can set the super-user group
|
||||
if (su_group_sn != 0) {
|
||||
if (is_su) {
|
||||
push @_, sprintf(" <li><input id=\"su\" type=\"checkbox\" name=\"su\"%s />\n"
|
||||
. " %s\n"
|
||||
. " </li>\n",
|
||||
$self->_val_check("su"),
|
||||
group_opt_label(su_group_sn, "su"));
|
||||
} else {
|
||||
push @_, sprintf(" <li><input id=\"su\" type=\"checkbox\"%s disabled=\"disabled\" />\n"
|
||||
. " %s\n"
|
||||
. " </li>\n",
|
||||
$current->param("su")? " checked=\"checked\"": "",
|
||||
group_opt_label(su_group_sn));
|
||||
}
|
||||
}
|
||||
# Attach the all-users group in any case
|
||||
push @_, sprintf(" <li><input id=\"su\" type=\"checkbox\" checked=\"checked\" disabled=\"disabled\" />\n"
|
||||
. " %s\n"
|
||||
. " </li>\n",
|
||||
group_opt_label(groupsn(ALLUSERS_GROUP)))
|
||||
if defined groupsn(ALLUSERS_GROUP);
|
||||
print "<ul>\n" . join("", @_) . " </ul>\n ";
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
|
||||
# A form to delete a current item
|
||||
} else {
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" scope="row">$mark$label</th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
for ($_ = 0, @_ = qw(); $_ < $current->param("supgroupcount"); $_++) {
|
||||
push @_, " <li>" . h_abbr($current->param("supgroup$_" . "title")) . "</li>\n";
|
||||
}
|
||||
push @_, " <li>" . group_opt_label(su_group_sn) . "</li>\n"
|
||||
if $current->param("su");
|
||||
push @_, " <li>" . group_opt_label(groupsn(ALLUSERS_GROUP)) . "</li>\n"
|
||||
if defined groupsn(ALLUSERS_GROUP);
|
||||
print @_ > 0? "<ul>\n" . join("", @_) . " </ul>\n ": h_abbr(t_none);
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
return 1;
|
||||
93
lib/perl5/Selima/Form/UserMem.pm
Normal file
93
lib/perl5/Selima/Form/UserMem.pm
Normal file
@@ -0,0 +1,93 @@
|
||||
# Selima Website Content Management System
|
||||
# UserMem.pm: The user-to-group membership form.
|
||||
|
||||
# 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::Form::UserMem;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form);
|
||||
|
||||
use Selima::FormFunc;
|
||||
use Selima::HTTP;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
use Selima::UserName;
|
||||
|
||||
# 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"} = "usermem"
|
||||
if !exists $$args{"table"};
|
||||
$$args{"deltext"} = C_("Delete this membership record")
|
||||
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 membership record.");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"summary"} = C_("This table provides you a form to change a current membership record.");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"summary"} = C_("This table provides you a form to delete a membership record.");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"cols"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"cols"} = [qw(grp member)];
|
||||
# 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 grp member
|
||||
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 User Membership Record");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"title"} = C_("Change a Current User Membership Record");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"title"} = C_("Delete a User Membership Record");
|
||||
}
|
||||
}
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _html_col_member: The member
|
||||
sub _html_col_member : method {
|
||||
$_[0]->_html_coltmpl_call("member", h_abbr(C_("Member:")), \&username);
|
||||
}
|
||||
|
||||
return 1;
|
||||
111
lib/perl5/Selima/Form/UserPref.pm
Normal file
111
lib/perl5/Selima/Form/UserPref.pm
Normal file
@@ -0,0 +1,111 @@
|
||||
# Selima Website Content Management System
|
||||
# UserPref.pm: The user preference form.
|
||||
|
||||
# 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::Form::UserPref;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form);
|
||||
|
||||
use Selima::DataVars qw(:scptconf);
|
||||
use Selima::FormFunc;
|
||||
use Selima::HTTP;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
use Selima::Unicode;
|
||||
use Selima::UserName;
|
||||
|
||||
# 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"} = "usermem"
|
||||
if !exists $$args{"table"};
|
||||
$$args{"deltext"} = C_("Delete this user preference")
|
||||
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 user preference.");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"summary"} = C_("This table provides you a form to modify a current user preference.");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"summary"} = C_("This table provides you a form to delete a user preference.");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"cols"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"cols"} = [qw(usr domain name value)];
|
||||
# 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 usr domain name value
|
||||
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 User Preference");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"title"} = C_("Modify a Current User Preference");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"title"} = C_("Delete a User Preference");
|
||||
}
|
||||
}
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
$self->{"form"}->delete("usr")
|
||||
if defined $self->{"form"}->param("usr")
|
||||
&& (!defined $self->{"form"}->param("usr")
|
||||
|| $self->{"form"}->param("usr") eq "");
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _html_col_domain: The preference domain
|
||||
sub _html_col_domain : method {
|
||||
$_[0]->_html_coltmpl_text_null("domain", h_abbr(C_("Domain:")),
|
||||
"everywhere", h_abbr(C_("Everywhere")));
|
||||
}
|
||||
|
||||
# _html_col_usr: The user
|
||||
sub _html_col_usr : method {
|
||||
$_[0]->_html_coltmpl_call_null("usr", h_abbr(C_("User:")),
|
||||
"everyone", h_abbr(C_("Everyone")), \&username);
|
||||
}
|
||||
|
||||
# _html_col_value: The preference value
|
||||
sub _html_col_value : method {
|
||||
$_[0]->_html_coltmpl_text("value", h_abbr(C_("Value:")));
|
||||
}
|
||||
|
||||
return 1;
|
||||
Reference in New Issue
Block a user