102 lines
2.9 KiB
Perl
102 lines
2.9 KiB
Perl
# Selima Website Content Management System
|
|
# AddGet.pm: The subroutines to manipulate the arguments in an URL.
|
|
|
|
# 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-30
|
|
|
|
package Selima::AddGet;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(Exporter);
|
|
use vars qw(@EXPORT @EXPORT_OK);
|
|
BEGIN {
|
|
@EXPORT = qw(DUP_OK DUP_NO add_get_arg rem_get_arg);
|
|
@EXPORT_OK = @EXPORT;
|
|
# Prototype declaration
|
|
sub add_get_arg($$$;$);
|
|
sub rem_get_arg($@);
|
|
}
|
|
|
|
use URI::Escape qw(uri_escape);
|
|
|
|
# Constant symbols
|
|
use constant DUP_OK => 1;
|
|
use constant DUP_NO => 0;
|
|
|
|
# add_get_arg: Add a get argument to the end of an url
|
|
sub add_get_arg($$$;$) {
|
|
local ($_, %_);
|
|
my ($url, $name, $value, $if_dup, $script);
|
|
($url, $name, $value, $if_dup) = @_;
|
|
$if_dup = DUP_NO if !defined $if_dup;
|
|
|
|
# Escape the name and value first
|
|
$name = uri_escape($name);
|
|
$value = uri_escape($value);
|
|
|
|
# No current arguments are appended yet
|
|
return "$url?$name=$value" if $url !~ /\?/;
|
|
|
|
# It is OK to have duplicated same arguments
|
|
return "$url&$name=$value" if $if_dup == DUP_OK;
|
|
|
|
# Have arguments already. We need to check if there is already
|
|
# a duplicated one and replace it if exists.
|
|
# Split the arguments
|
|
$url =~ /^(.*?)\?(.*)$/;
|
|
($script, $_) = ($1, $2);
|
|
@_ = split /&/, $_;
|
|
# Remove the matched ones
|
|
@_ = grep !/^$name=/, @_;
|
|
# Add our argument
|
|
push @_, "$name=$value";
|
|
return "$script?" . join("&", @_);
|
|
}
|
|
|
|
# rem_get_arg: Remove a get argument from the end of an url
|
|
sub rem_get_arg($@) {
|
|
local ($_, %_);
|
|
my ($url, @names, $script, $name);
|
|
($url, @names) = @_;
|
|
|
|
# No current arguments are appended yet
|
|
return $url if $url !~ /\?/;
|
|
|
|
# Escape the names
|
|
for ($_ = 0; $_ < @names; $_++) {
|
|
# Encode the name first
|
|
$names[$_] = uri_escape($names[$_]);
|
|
}
|
|
|
|
# Have arguments already. We need to check if there is already
|
|
# a duplicated one and remove it if exists.
|
|
# Split the arguments
|
|
$url =~ /^(.*?)\?(.*)$/;
|
|
($script, $_) = ($1, $2);
|
|
@_ = split /&/, $_;
|
|
# Check one by one
|
|
foreach $name (@names) {
|
|
@_ = grep !/^$name=/, @_;
|
|
}
|
|
# No arguments left
|
|
return $script if scalar(@_) == 0;
|
|
return "$script?" . join("&", @_);
|
|
}
|
|
|
|
return 1;
|