Initial commit.
This commit is contained in:
465
lib/perl5/Selima/CallForm.pm
Normal file
465
lib/perl5/Selima/CallForm.pm
Normal file
@@ -0,0 +1,465 @@
|
||||
# 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;
|
||||
Reference in New Issue
Block a user