# Selima Website Content Management System
# Processor.pm: The base data processor.

#  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-06-30

package Selima::Processor;
use 5.008;
use strict;
use warnings;

use Selima::AddCol;
use Selima::DataVars qw($DBH :addcol :dataman :l10n);
use Selima::GetLang;
use Selima::Guest;
use Selima::HTTP;
use Selima::ShortCut;
use Selima::Unicode;

# Load these classes
use Selima::Processor::User;
use Selima::Processor::Group;
use Selima::Processor::UserMem;
use Selima::Processor::GroupMem;
use Selima::Processor::UserPref;
use Selima::Processor::ScptPriv;
use Selima::Processor::ListPref;

use Selima::Processor::Guestbook;
use Selima::Processor::Page;
use Selima::Processor::LinkCat;
use Selima::Processor::Link;
use Selima::Processor::LinkCatz;

use Selima::Processor::Rebuild;
use Selima::Processor::Deletion;
use Selima::Processor::LogOut;
use Selima::Processor::Category;
use Selima::Processor::Categorz;

use Selima::Processor::AcctSubj;
use Selima::Processor::AcctTrx;
use Selima::Processor::AcctRec;
use Selima::Processor::ListPref::AcctReps;

# The relevent variables
use constant NEWSN_LEN => 9;
use vars qw($NEWSN_MIN $NEWSN_MAX $NEWSN_INT);
$NEWSN_MIN = 10 ** (NEWSN_LEN - 1);     # 100000000
$NEWSN_MAX = (10 ** NEWSN_LEN) - 1;     # 999999999
$NEWSN_INT = $NEWSN_MAX - $NEWSN_MIN + 1;

# new: Initialize the processor
sub new : method {
    local ($_, %_);
    my ($class, $form, $table, $self);
    ($class, $form, $table) = @_;
    $self = bless {}, $class;
    $self->{"form"} = $form;
    $self->{"table"} = $table;
    $self->{"pres"} = [];
    $self->{"subs"} = [];
    $self->{"type"} = $self->{"form"}->param("form")
        if defined $self->{"form"}->param("form");
    $self->{"step"} = $self->{"form"}->param("step")
        if defined $self->{"form"}->param("step");
    $self->{"sn"} = $self->{"form"}->param("sn")
        if defined $self->{"form"}->param("sn");
    # The current item
    $self->{"cur"} = new CGI({%CURRENT});
    # The user request
    $self->{"req"} = new CGI({%REQUEST});
    $self->{"is_sql"} = 1;
    $self->{"update_timestamp"} = 1;
    return $self;
}

# process: Process the form, fully
sub process : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    # Submitted but not confirmed yet
    return {"preview"=>1} if !defined $self->{"form"}->param("confirm");
    
    # Save the column deposit
    $self->_save_cols;
    # Not modified
    return $self->_ret_status unless $self->_modified;
    
    # Begin the SQL transaction
    $DBH->begin_work if $self->{"is_sql"};
    # Update the columns
    $self->_update_cols;
    # Rebuild a limited part of pages
    $self->_rebuild_partial_pages;
    # Perform tasks other than column updates
    $self->_other_tasks;
    # Commit the SQL transaction
    $DBH->commit if $self->{"is_sql"};
    
    # Log and return the process status
    $self->_actlog;
    return $self->_ret_status;
}

###################
# Methods belows are to be called by other processors.  Do not call them directly.
# Override them when needed.
###################
# _save_cols: Save the column deposit
sub _save_cols : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    return unless exists $self->{"type"};
    # A form to create a new item
    if ($self->{"type"} eq "new") {
        $self->{"sn"} = $self->_new_sn;
        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
        $self->{"cols"}->addnum("sn", $self->{"sn"});
    
    # A form to edit a current item
    } elsif ($self->{"type"} eq "cur") {
        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
    }
    return;
}

###################
# Methods belows are private.  Do not call them directly.
# Override them when needed.
###################
# _update_cols: Update the columns
sub _update_cols : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    # Run the pre-processing sub-processors
    foreach (@{$self->{"pres"}}) {
        $_->_update_cols if $_->_modified;
    }
    
    # Process the update
    if ($self->{"is_sql"} && exists $self->{"type"}) {
        # A form to create a new item
        if ($self->{"type"} eq "new" && exists $self->{"cols"}) {
            $_ = "INSERT INTO " . $self->{"table"}
                . " " . $self->{"cols"}->ret($self->{"update_timestamp"}) . ";\n";
            $DBH->gdo($_);
        
        # A form to edit a current item
        } elsif ($self->{"type"} eq "cur" && exists $self->{"cols"} && exists $self->{"sn"}) {
            $_ = "UPDATE " . $self->{"table"}
                . " " . $self->{"cols"}->ret($self->{"update_timestamp"})
                . " WHERE sn=" . $self->{"sn"} . ";\n";
            $DBH->gdo($_);
        
        # A form to delete a current item
        } elsif ($self->{"type"} eq "del" && exists $self->{"sn"}) {
            $_ = "DELETE FROM " . $self->{"table"}
                . " WHERE sn=" . $self->{"sn"} . ";\n";
            $DBH->gdo($_);
        }
    }
    
    # Run the sub-processors
    foreach (@{$self->{"subs"}}) {
        $_->_update_cols if $_->_modified;
    }
    return;
}

# _rebuild_partial_pages: Rebuild a limited part of pages
#  Empty by default.  Put page building code here.
sub _rebuild_partial_pages : method {}

# _other_tasks: Perform tasks other than column updates
#  Empty by default.
sub _other_tasks : method {}

# _actlog: Log the activity
sub _actlog : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    # A form to create a new item
    return gactlog "Create a record with s/n " . $self->{"sn"} . "."
        if $self->{"type"} eq "new";
    # A form to edit a current item
    return gactlog "Update the record with s/n " . $self->{"sn"} . "."
        if $self->{"type"} eq "cur";
    # A form to delete a current item
    return gactlog "Delete the record with s/n " . $self->{"sn"} . "."
        if $self->{"type"} eq "del";
}

# _ret_status: Return the process status
sub _ret_status : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    return {"msg"=>N_("This record was not modified."),
            "isform"=>0}
        if !$self->_modified;
    # A form to create a new item
    return {"msg"=>N_("This record has been successfully added."),
            "isform"=>0}
        if $self->{"type"} eq "new";
    # A form to edit a current item
    return {"msg"=>N_("This record has been successfully updated."),
            "isform"=>0}
        if $self->{"type"} eq "cur";
    # A form to delete a current item
    return {"msg"=>N_("This record has been successfully deleted."),
            "isform"=>0}
        if $self->{"type"} eq "del";
}

# _form: Return a specific form value
#   Return undef if that column is empty
sub _form : method {
    local ($_, %_);
    my ($self, $name);
    ($self, $name) = @_;
    return scalar $self->{"form"}->param($name);
}

###################
# Methods belows are private.  Do not call them directly.
# Do not override them, either.
###################
# _modified: If the item is modified
sub _modified : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    # Modification status checked before
    return $self->{"modified"} if exists $self->{"modified"};
    # Return true for addition and deletion processors
    return ($self->{"modified"} = 1)
        if exists $self->{"type"} && $self->{"type"} ne "cur";
    # Return true if the columns are modified
    return ($self->{"modified"} = 1)
        if exists $self->{"cols"} && $self->{"cols"}->modified;
    # Return true if any of the subprocessors is modified
    foreach (@{$self->{"pres"}}) {
        return ($self->{"modified"} = 1) if $_->_modified;
    }
    foreach (@{$self->{"subs"}}) {
        return ($self->{"modified"} = 1) if $_->_modified;
    }
    # Not modified
    return ($self->{"modified"} = 0);
}

# _zhsync: Automatic Traditional Chinese to Simplified Chinese conversion
sub _zhsync : method {
    local ($_, %_);
    my ($self, $form, $cur);
    $self = $_[0];
    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
    # Skip unless multilingual
    return unless @ALL_LINGUAS > 1;
    # Skip unless we are in Traditional Chinese, and there is Simplified Chinese
    %_ = map { $_ => 1 } @ALL_LINGUAS;
    return unless getlang eq "zh-tw" && exists $_{"zh-cn"};
    # A form to create a new item
    if ($self->{"type"} eq "new") {
        foreach my $col ($DBH->cols_ml($self->{"table"})) {
            $self->{"cols"}->addstr($col . "_zhcn", all_to_simp($_))
                if defined($_ = $form->param($col));
        }
    # A form to edit a current item
    } elsif ($self->{"type"} eq "cur") {
        foreach my $col ($DBH->cols_ml($self->{"table"})) {
            $self->{"cols"}->addstr($col . "_zhcn", all_to_simp($_), $cur->param($col . "_zhcn"))
                if defined($_ = $form->param($col));
        }
    }
}

# _new_sn: Generate a new random serial number for an SQL table
sub _new_sn : method {
    local ($_, %_);
    my ($self, $sql, $sth);
    $self = $_[0];
    
    do {
        # Generate a random serial number
        $_ = $NEWSN_MIN + int rand $NEWSN_INT;
        # Check if this serial number exists
        $sql = "SELECT sn FROM " . $self->{"table"}
            . " WHERE sn=$_;\n";
        $sth = $DBH->prepare($sql);
        $sth->execute;
    } until $sth->rows == 0;
    
    return $_;
}

return 1;