Initial commit.

lib/perl5/Selima/Checker/AcctSubj.pm

@@ -0,0 +1,147 @@
+# Selima Website Content Management System
+# AcctSubj.pm: The accounting subject form checker.
+
+#  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::Checker::AcctSubj;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Selima::CallForm;
+use Selima::FetchRec;
+use Selima::ShortCut;
+use Selima::DataVars qw($DBH);
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my ($class, $self);
+    ($class, @_) = @_;
+    $_[1] = "acctsubj" if scalar(@_) < 2 || !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+# _check_code: Check the code
+sub _check_code : method {
+    my ($self, $form, $error, $sth, $sql);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("code");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("code");
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in the code.")}
+        if $form->param("code") eq "";
+    # Check the length
+    return {"msg"=>N_("This code is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"code"}]}
+        if length $form->param("code") > ${$self->{"maxlens"}}{"code"};
+    # Check if the characters used are valid
+    return {"msg"=>N_("Only numbers are allowed for the code.")}
+        unless $form->param("code") =~ /^\d+$/;
+    # Check if this item is duplicated
+    @_ = qw();
+    push @_, "code=" . $DBH->quote($form->param("code"));
+    push @_, "sn!=" . $self->{"sn"} if $self->{"iscur"};
+    $sql = "SELECT * FROM " . $DBH->quote_identifier($self->{"table"})
+        . " WHERE " . join(" AND ", @_) . ";\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    return {"msg"=>N_("This accounting subject already exists.  You cannot create a duplicated one.")}
+        if $sth->rows > 0;
+    # Check if its parent code exists
+    if (length $form->param("code") > 1) {
+        $_ = substr $form->param("code"), 0, -1;
+        $sql = "SELECT * FROM " . $DBH->quote_identifier($self->{"table"})
+            . " WHERE code=" . $DBH->quote($_) . ";\n";
+        $sth = $DBH->prepare($sql);
+        $sth->execute;
+        return {"msg"=>N_("Accounting subject [_1] does not exist.  You cannot create a subject under that."),
+                "margs"=>[$_]}
+            if $sth->rows == 0;
+    }
+    # OK
+    return;
+}
+
+# _check_parent: Check the parent subject
+sub _check_parent : method {
+    local ($_, %_);
+    my ($self, $form, $error, $sth, $sql, %row);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # "topmost not set" has a different form context
+    return {"msg"=>N_("Please select a parent accounting subject.")}
+        if $self->_missing("topmost");
+    # Regularize it
+    $self->_trim("topmost");
+    # Check the option value
+    return {"msg"=>N_("This option is invalid.  Please select a proper parent accounting subject.")}
+        unless $form->param("topmost") =~ /^(?:true|false)$/;
+    # Check the parent subject if not a topmost subject
+    if ($form->param("topmost") eq "false") {
+        # Check if our code says we are topmost
+        if (!$self->_missing("code")) {
+            $self->_trim("code");
+            return {"msg"=>N_("An accounting subject having its code with a single digit must not have a parent.")}
+                if length $form->param("code") < 2;
+        }
+        # Check if it exists
+        $error = $self->_missing("parent");
+        return $error if defined $error;
+        # Regularize it
+        $self->_trim("parent");
+        # Check if it is filled
+        return {"msg"=>N_("Please select a parent accounting subject.")}
+            if $form->param("parent") eq "";
+        # Check if the parent subject is itself
+        return {"msg"=>N_("An accounting subject cannot belong to itself.  Please select another one.")}
+            if $self->{"iscur"} && $form->param("parent") == $self->{"sn"};
+        # Check if this subject exists
+        %row = fetchrec ${$form->param_fetch("parent")}[0], "acctsubj";
+        return {"msg"=>N_("This parent accounting subject does not exist anymore.  Please select another one.")}
+            if keys %row == 0;
+        # Check if the parent matches our code
+        if (!$self->_missing("code")) {
+            $_ = substr $form->param("code"), 0, -1;
+            return {"msg"=>N_("The parent accounting subject of accounting subject [_1] must be of code [_2], not [_3]."),
+                    "margs"=>[$form->param("code"), $_, $row{"code"}]}
+                if $row{"code"} ne $_;
+        }
+    # Check the parent subject if a topmost subject
+    } else {
+        # Check if our code says we are not topmost
+        if (!$self->_missing("code")) {
+            $self->_trim("code");
+            return {"msg"=>N_("An accounting subject having its code with more than one digit must have a parent.")}
+                if length $form->param("code") > 1;
+        }
+    }
+    # OK
+    return;
+}
+
+# _check_title: Check the title
+# Use the default title checker
+
+return 1;