selima-perl/lib/perl5/Selima/Checker/AcctSubj.pm

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