# Selima Website Content Management System
# CallForm.pm: The subroutines to transfer between a form and its subform.

#  Copyright (c) 2003-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: 2003-03-24

package Selima::CallForm;
use 5.008;
use strict;
use warnings;
use base qw(Exporter);
use vars qw(@EXPORT @EXPORT_OK);
BEGIN {
@EXPORT = qw();
push @EXPORT, qw(call_form error_redirect success_redirect);
push @EXPORT, qw(suspend_form retrieve_form suspend_status retrieve_status);
push @EXPORT, qw(is_called_form form_this);
@EXPORT_OK = @EXPORT;
# Prototype declaration
sub call_form($;$$);
sub proc_status_redirect($);
sub error_redirect($);
sub success_redirect($);
sub suspend_form(;$);
sub retrieve_form(;$);
sub suspend_status($);
sub retrieve_status(;$);
sub is_called_form();
sub new_formid();
sub new_statid();
sub form_this();
}

use CGI qw();
use Data::Dumper qw();
use File::Spec::Functions qw(catfile);
use Fcntl qw(:flock);
use URI::Escape qw(uri_escape);

use Selima::AddGet;
use Selima::Cache qw(:callform);
use Selima::DataVars qw($SESSION :env :forms :requri :scptconf);
use Selima::FormFunc;
use Selima::HTTP;
use Selima::Session;
use Selima::XFileIO;

use vars qw(%SAVESTATS);

# Settings
# The length of the ID
use constant ID_LEN => 9;

# call_form: Suspend the current form and call another selection form
sub call_form($;$$) {
    local ($_, %_);
    my ($form, @args, $import_func, $FORM, $formid);
    ($form, $_, $import_func) = @_;
    @args = defined $_? @$_: qw();
    # Only work for defined forms
    http_500 "Calling undefined form \"$form\".\n"
        if !exists $SCRIPTS{$form};
    
    # Record the selection import function
    if (defined $import_func) {
        # Obtain the form
        $FORM = get_or_post;
        $FORM->param("import_func", $import_func);
    }
    # Suspend the current form
    $formid = suspend_form $FORM;
    
    # Add the caller
    $_ = $REQUEST_PATH;
    $_ =~ s/^$ROOT_DIFF//;
    push @args, "caller=" . uri_escape($_);
    # Add the caller form ID
    push @args, "cformid=" . uri_escape($formid);
    
    # Redirect
    http_303 $SCRIPTS{$form} . "?" . join("&", @args);
    # No need to return
    exit;
}

# proc_status_redirect: Save the form status, suspend and redirect the form
sub proc_status_redirect($) {
    local ($_, %_);
    my ($status, $url, $FORM, $formid, $statid, $method);
    $status = $_[0];
    
    # Obtain the form
    $FORM = get_or_post;
    
    # No more form
    if (    defined $status
            && exists $$status{"isform"}
            && !$$status{"isform"}) {
        # Find the referring script
        # Specified
        if (exists $$status{"nextstep"}) {
            $url = $$status{"nextstep"};
        } elsif (defined $FORM->param("referer2")) {
            $url = $FORM->param("referer2");
        # Back to the user home on the calling site
        } elsif (defined $FORM->param("hostport")) {
            # To be done
            $url = $FORM->param("hostport") . "/magicat/";
        # Default to the current URL
        } else {
            $url = $REQUEST_FILE;
        }
        # Do not affect the previous form
        delete $$status{"isform"};
    
    # Default to this same script
    } else {
        $url = form_this;
        # Suspend the current form
        $formid = suspend_form $FORM;
        $url = add_get_arg $url, "formid", $formid;
    }
    
    # Add the status
    if (defined $status) {
        $statid = suspend_status $status;
        $url = add_get_arg $url, "statid", $statid;
    }
    
    # Redirect
    $method = $IS_MODPERL? ($IS_MP2?
        Apache2::RequestUtil->request->method: Apache->request->method):
        $ENV{"REQUEST_METHOD"};
    if ($method eq "POST") {
        http_303 $url;
    } else {
        http_307 $url;
    }
    # No need to return
    exit;
}

# error_redirect: Shortcut to redirect the error form
sub error_redirect($) {
    local ($_, %_);
    my $status;
    $status = $_[0];
    
    $$status{"status"} = "error" if defined $status;
    proc_status_redirect $status;
    # No need to return
    exit;
}

# success_redirect: Shortcut to redirect the success form
sub success_redirect($) {
    local ($_, %_);
    my $status;
    $status = $_[0];
    
    $$status{"status"} = "success" if defined $status;
    proc_status_redirect $status;
    # No need to return
    exit;
}

# suspend_form: Suspend the current form
sub suspend_form(;$) {
    local ($_, %_);
    my ($FORM, $formid, $dumper, $origumask);
    $FORM = $_[0];
    
    # Obtain the form
    $FORM = get_or_post if !defined $FORM;
    
    # Using session is better
    if (defined $SESSION) {
        # Initialize the form deposit
        $$SESSION{"saveforms"} = {}
            if !exists $$SESSION{"saveforms"};
        # Do not use existing form ID
        $formid = new_formid;
        # Save the current form
        ${$$SESSION{"saveforms"}}{$formid} = $FORM;
        # Save the form ID
        ${$$SESSION{"saveforms"}}{$formid}->param("formid", $formid);
        ${$$SESSION{"saveforms"}}{$formid}->param("ownerscript", $REQUEST_PATH);
        $SESSION->flush;
    
    # Not using session
    } else {
        # Do not use existing form ID
        $formid = new_formid;
        # Dump the form
        $dumper = new Data::Dumper([$FORM], [qw($_)]);
        $dumper->Indent(1);
        $dumper->Sortkeys(1);
        $_ = $dumper->Dump;
        # Write to the file
        $origumask = umask 0077;
        xfwrite(catfile($Selima::Session::DIR, "saveform_$formid"), $_);
        umask $origumask;
    }
    
    return $formid;
}

# retrieve_form: Retrieve a previously suspended form
#   Return empty array instead of empty, to be merged directly
sub retrieve_form(;$) {
    local ($_, %_);
    my ($formid, $CUR_FORM, $file, $cache);
    $formid = $_[0];
    $cache = \%Callform_retrieve_form;
    
    # Return the cache
    if (!defined $formid) {
        # $cache[0] is the default (previous form)
        return $$cache{0} if exists $$cache{0};
    } else {
        return $$cache{$formid} if exists $$cache{$formid};
    }
    
    # Using session is better
    if (defined $SESSION) {
        # Initialize the form deposit
        if (!exists $$SESSION{"saveforms"}) {
            $$SESSION{"saveforms"} = {};
            if (!defined $formid) {
                return ($$cache{0} = new CGI(""));
            } else {
                return ($$cache{$formid} = new CGI(""));
            }
        }
        
        # Obtain the previous suspended form if form not specified
        if (!defined $formid) {
            # Obtain the form
            $CUR_FORM = get_or_post;
            # Return empty if not set
            return ($$cache{0} = new CGI(""))
                if !defined $CUR_FORM->param("formid");
            $formid = $CUR_FORM->param("formid");
            # There is no such previously suspended form
            if (!exists ${$$SESSION{"saveforms"}}{$formid}) {
                $$cache{$formid} = new CGI("");
                $$cache{0} = $$cache{$formid};
                return $$cache{0};
            }
            $$cache{$formid} = ${$$SESSION{"saveforms"}}{$formid};
            $$cache{0} = $$cache{$formid};
        
        } else {
            # There is no such previously suspended form
            return ($$cache{$formid} = new CGI(""))
                if !exists ${$$SESSION{"saveforms"}}{$formid};
            $$cache{$formid} = ${$$SESSION{"saveforms"}}{$formid};
        }
        
    
    # Not using session
    } else {
        # Obtain the previous suspended form if form not specified
        if (!defined $formid) {
            # Obtain the form
            $CUR_FORM = get_or_post;
            # Return empty if not set
            return ($$cache{0} = new CGI(""))
                if !defined $CUR_FORM->param("formid");
            $formid = $CUR_FORM->param("formid");
            # Compose the save form file name
            $file = catfile($Selima::Session::DIR, "saveform_$formid");
            # There is no such previously suspended form
            if (!-f $file || !-r $file || !-s $file) {
                $$cache{$formid} = new CGI("");
                $$cache{0} = $$cache{$formid};
                return $$cache{0};
            }
            $$cache{$formid} = eval xfread($file);
            $$cache{0} = $$cache{$formid};
        
        } else {
            # Compose the save form file name
            $file = catfile($Selima::Session::DIR, "saveform_$formid");
            # There is no such previously suspended form
            return ($$cache{$formid} = new CGI(""))
                if !-f $file || !-r $file || !-s $file;
            $$cache{$formid} = eval xfread($file);
        }
    }
    
    # Import the selection if needed
    &$_($$cache{$formid})
        if  defined($_ = $$cache{$formid}->param("import_func"))
            && defined($_ = $MAIN->can($_));
    
    # Return the form
    return $$cache{$formid};
}

# suspend_status: Suspend the current status
sub suspend_status($) {
    local ($_, %_);
    my ($status, $statid, $dumper, $origumask);
    $status = $_[0];
    
    # Using session is better
    if (defined $SESSION) {
        # Initialize the status deposit
        $$SESSION{"savestats"} = {}
            if !exists $$SESSION{"savestats"};
        # Do not use existing status ID
        $statid = new_statid;
        # Save the current status
        ${$$SESSION{"savestats"}}{$statid} = $status;
        # Save the status ID
        ${${$$SESSION{"savestats"}}{$statid}}{"statid"} = $statid;
        ${${$$SESSION{"savestats"}}{$statid}}{"ownerscript"} = $REQUEST_PATH;
        $SESSION->flush;
    
    # Not using session
    } else {
        # Do not use existing status ID
        $statid = new_statid;
        # Dump the status
        $dumper = new Data::Dumper([$status], [qw($_)]);
        $dumper->Indent(1);
        $dumper->Sortkeys(1);
        $_ = $dumper->Dump;
        # Write to the file
        $origumask = umask 0077;
        xfwrite(catfile($Selima::Session::DIR, "savestat_$statid"), $_);
        umask $origumask;
    }
    
    return $statid;
}

# retrieve_status: Retrieve a previously suspended status
#   Return empty array instead of empty, to be merged directly
sub retrieve_status(;$) {
    local ($_, %_);
    my ($statid, $CUR_FORM, $file);
    $statid = $_[0];
    
    if (!defined $statid) {
        # Obtain the form
        $CUR_FORM = get_or_post;
        
        # Return nothing if there is no status ID to retrieve
        return if !defined $CUR_FORM->param("statid");
        $statid = $CUR_FORM->param("statid");
    }
    
    # Using session is better
    if (defined $SESSION) {
        return if !exists $$SESSION{"savestats"};
        return if !exists ${$$SESSION{"savestats"}}{$statid};
        return ${$$SESSION{"savestats"}}{$statid};
    
    # Not using session
    } else {
        # Compose the save status file name
        $file = catfile($Selima::Session::DIR, "savestat_$statid");
        # Check if this status is available
        if (!-f $file || !-r $file || !-s $file) {
            # Remove expired cache
            delete $SAVESTATS{$file} if exists $SAVESTATS{$file};
            return;
        }
        
        # Parse the status
        $SAVESTATS{$statid} = eval xfread($file)
            if !exists $SAVESTATS{$statid};
        # Return the status
        return $SAVESTATS{$statid};
    }
}

# is_called_form: If this is a called form
sub is_called_form() {
    local ($_, %_);
    $_ = curform;
    return (defined $_->param("caller") && defined $_->param("cformid"));
}

# new_formid: Generate a new random form ID number
sub new_formid() {
    local ($_, %_);
    my ($min, $max, $int, $formid);
    
    $min = 10 ** (ID_LEN - 1);     # 100000000
    $max = (10 ** ID_LEN) - 1;     # 999999999
    $int = $max - $min + 1;
    
    # Using session is better
    if (defined $SESSION) {
        do {
            # Generate a random serial number
            $formid = $min + int rand $int;
        } until !exists ${$$SESSION{"saveforms"}}{$formid};
    
    # Not using session
    } else {
        do {
            # Generate a random serial number
            $formid = $min + int rand $int;
        } until !-e catfile($Selima::Session::DIR, "saveform_$formid");
    }
    
    return $formid;
}

# new_statid: Generate a new random status ID number
sub new_statid() {
    local ($_, %_);
    my ($min, $max, $int, $statid);
    
    $min = 10 ** (ID_LEN - 1);     # 100000000
    $max = (10 ** ID_LEN) - 1;     # 999999999
    $int = $max - $min + 1;
    
    # Using session is better
    if (defined $SESSION) {
        do {
            # Generate a random serial number
            $statid = $min + int rand $int;
        } until !exists ${$$SESSION{"savestats"}}{$statid};
    
    # Not using session
    } else {
        do {
            # Generate a random serial number
            $statid = $min + int rand $int;
        } until !-e catfile($Selima::Session::DIR, "savestat_$statid");
    }
    
    return $statid;
}

# form_this: Find the processing script
sub form_this() {
    local ($_, %_);
    return $CallForm_form_this if defined $CallForm_form_this;
    $_ = get_or_post;
    return ($CallForm_form_this = $_)
        if defined($_ = $_->param("referer"));
    return ($CallForm_form_this = $REQUEST_FILE);
}

return 1;