466 lines
14 KiB
Perl
466 lines
14 KiB
Perl
# 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;
|