Initial commit.

lib/perl5/Selima/Checker/LinkCatz.pm

@@ -0,0 +1,162 @@
+# Selima Website Content Management System
+# LinkCatz.pm: The related-link category membership form checker.
+
+#  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-11-03
+
+package Selima::Checker::LinkCatz;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Selima::ChkFunc;
+use Selima::CallForm;
+use Selima::DataVars qw($DBH :forms);
+use Selima::ShortCut;
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my $class;
+    ($class, @_) = @_;
+    $_[1] = "linkcatz" if scalar(@_) < 2 || !defined $_[1];
+    return $class->SUPER::new(@_);
+}
+
+# check: Run a list of checks
+sub check : method {
+    local ($_, %_);
+    my ($self, $error, @cols);
+    ($self, @cols) = @_;
+    # Run the parent method first
+    $error = $self->SUPER::check(@cols);
+    return $error if defined $error;
+    # See if we need to check the duplicates.  Check it in the end.
+    %_ = map { $_ => 1 } @cols;
+    if (exists $_{"cat"} && exists $_{"link"}) {
+        $error = $self->__check_dup();
+        return $error if defined $error;
+    }
+    return;
+}
+
+# _check_cat: Check the category
+sub _check_cat : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("cat");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("cat");
+    # Check if it is filled
+    return {"msg"=>N_("Please select a category.")}
+        if $form->param("cat") eq "";
+    # Check if the category exists
+    return {"msg"=>N_("This category does not exist anymore.  Please select another one.")}
+        if !check_sn_in ${$form->param_fetch("cat")}[0], "linkcat";
+    # OK
+    return;
+}
+
+# _check_link: Check the related link
+sub _check_link : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("link");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("link");
+    # Check if it is filled
+    return {"msg"=>N_("Please select a related link.")}
+        if $form->param("link") eq "";
+    # Check if this link exists
+    return {"msg"=>N_("This related link does not exist anymore.  Please select another one.")}
+        if !check_sn_in ${$form->param_fetch("link")}[0], "links";
+    # OK
+    return;
+}
+
+# __check_dup: Check if this item is duplicated
+sub __check_dup : method {
+    local ($_, %_);
+    my ($self, $form, $error, $sth, $sql);
+    $self = $_[0];
+    $form = $self->{"form"};
+    @_ = qw();
+    push @_, "cat=" . $form->param("cat");
+    push @_, "link=" . $form->param("link");
+    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 categorization record already exists.  You cannot create a duplicated one.")}
+        if $sth->rows > 0;
+    return;
+}
+
+# _redir_selcat: Suspend and move to the category selection form
+sub _redir_selcat : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if $self->_missing("selcat");
+    call_form FORM_LINKCAT, undef, "import_selcat";
+}
+
+# _redir_delcat: Remove the category
+sub _redir_delcat : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if $self->_missing("delcat");
+    $self->{"form"}->delete("cat");
+    success_redirect undef;
+}
+
+# _redir_sellink: Suspend and move to the related link selection form
+sub _redir_sellink : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if $self->_missing("sellink");
+    call_form FORM_LINKS, undef, "import_sellink";
+}
+
+# _redir_dellink: Remove the related link
+sub _redir_dellink : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if $self->_missing("dellink");
+    $self->{"form"}->delete("link");
+    success_redirect undef;
+}
+
+return 1;