#!/usr/bin/perl
package RVL::Request;
# WebSite: http://www.rvglobalsoft.com
# Unauthorized copying is strictly forbidden and may result in severe legal action.
# Copyright (c) 2013 RV Global Soft Co.,Ltd. All rights reserved.
#
# =====YOU MUST KEEP THIS COPYRIGHTS NOTICE INTACT AND CAN NOT BE REMOVE =======
# Copyright (c) 2013 RV Global Soft Co.,Ltd. All rights reserved.
# This Agreement is a legal contract, which specifies the terms of the license
# and warranty limitation between you and RV Global Soft Co.,Ltd. and RV2Factor Product for RV Global Soft.
# You should carefully read the following terms and conditions before
# installing or using this software. Unless you have a different license
# agreement obtained from RV Global Soft Co.,Ltd., installation or use of this software
# indicates your acceptance of the license and warranty limitation terms
# contained in this Agreement. If you do not agree to the terms of this
# Agreement, promptly delete and destroy all copies of the Software.
#
# ===== Grant of License =======
# The Software may only be installed and used on a single host machine.
#
# ===== Disclaimer of Warranty =======
# THIS SOFTWARE AND ACCOMPANYING DOCUMENTATION ARE PROVIDED "AS IS" AND
# WITHOUT WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR ANY OTHER
# WARRANTIES WHETHER EXPRESSED OR IMPLIED. BECAUSE OF THE VARIOUS HARDWARE
# AND SOFTWARE ENVIRONMENTS INTO WHICH RV SITE BUILDER MAY BE USED, NO WARRANTY OF
# FITNESS FOR A PARTICULAR PURPOSE IS OFFERED. THE USER MUST ASSUME THE
# ENTIRE RISK OF USING THIS PROGRAM. ANY LIABILITY OF RV GLOBAL SOFT CO.,LTD. WILL BE
# LIMITED EXCLUSIVELY TO PRODUCT REPLACEMENT OR REFUND OF PURCHASE PRICE.
# IN NO CASE SHALL RV GLOBAL SOFT CO.,LTD. BE LIABLE FOR ANY INCIDENTAL, SPECIAL OR
# CONSEQUENTIAL DAMAGES OR LOSS, INCLUDING, WITHOUT LIMITATION, LOST PROFITS
# OR THE INABILITY TO USE EQUIPMENT OR ACCESS DATA, WHETHER SUCH DAMAGES ARE
# BASED UPON A BREACH OF EXPRESS OR IMPLIED WARRANTIES, BREACH OF CONTRACT,
# NEGLIGENCE, STRICT TORT, OR ANY OTHER LEGAL THEORY. THIS IS TRUE EVEN IF
# RV GLOBAL SOFT CO.,LTD. IS ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. IN NO CASE WILL
# RV GLOBAL SOFT CO.,LTD.'S LIABILITY EXCEED THE AMOUNT OF THE LICENSE FEE ACTUALLY PAID
# BY LICENSEE TO RV GLOBAL SOFT CO.,LTD.
# ===============================
=head1 NAME
RVL::Request - Loads Request driver, provides a number of filtering methods.
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 METHODS
=cut
use strict 'vars';
use warnings;
use IO::Interactive qw(is_interactive interactive busy);
use CGI ':standard';
use Class::Std::Utils;
{
# class attribute
my ($props);
my ($type);
sub new {
my ($class, $opt) = @_;
my ($this) = bless anon_scalar(), $class;
# ตรวจหา Request driver
if ($this->isEmpty()) {
my ($ident) = ident($this);
$type->{$ident} = $this->getRequestType();
require "RVL/Request/$type->{$ident}.pm";
my ($class) = "RVL::Request::$type->{$ident}";
$this = $class->new();
}
return $this;
}
=head2 singleton()
Returns a singleton Request instance.
=cut
sub singleton {
my ($class) = __PACKAGE__;
if (!defined $RVL::INSTANCE{$class}) {
$RVL::INSTANCE{$class} = $class->new();
}
return $RVL::INSTANCE{$class}
}
=head2 get($key, $allowTags, $notRemoveTag)
Retrieves values from Request object.
=item *
$key <Srting> ชื่อคีย์ของข้อมูลที่เข้ามา
=item *
$allowTags <0|1> ต้องการลบ HTML ในข้อมูลที่เข้ามาหรือไม่ มีค่าเป็น 0 หรือ 1 ค่าเบื้องต้นเป็น 0
=item *
$notRemoveTag <Srting> กำหนดหากไม่ต้องการลบ HTML Tag
simple 1: get request key 'name' and not allow HTML Tag
$req->get('name');
simple 2: get request key 'name' and allow HTML Tag
$req->get('name', 1);
simple 3: get request key 'name' and allow HTML Tag <b> <p> only
$req->get('name', 0, '<b><p>');
=cut
sub get {
my ($this) = shift;
my ($key, $allowTags, $notRemoveTags) = @_;
my ($copy);
if (defined $this->{append}->{$key}) {
$copy = $this->{append}->{$key};
} else {
#$copy = param($key);
my @read;
if (defined &CGI::multi_param) {
my $q = CGI->new;
@read = $q->multi_param($key);
} else {
@read = param($key);
}
my $num = scalar @read;
if($num > 1){
$copy = \@read;
}else{
$copy = (defined $read[0])? $read[0] : scalar param($key);
}
}
return undef if (!$copy);
if (!$allowTags) {
$copy = RVL::String::cleanHTMLTag($copy, $notRemoveTags);
}
return $copy;
}
sub set{
my ($this) = shift;
my ($key, $value) = @_;
append(-name => $key, -value => $value);
$this->{append}->{$key} = $value;
RVL::logMessage("Set append $key = $value", __CONSTANT__::RVL_LOG_DEBUG);
}
=help
Used internally to determine request type before Request strategy instantiated.
=cut
sub getRequestType {
my ($this) = shift;
if ($this->_isAjax()) {
return 'Ajax';
} elsif ($this->_isBrowser()) {
return 'Browser';
} else {
return 'Cli';
}
}
sub _isAjax {
my ($this) = shift;
return (defined $ENV{'HTTP_X_REQUESTED_WITH'} && $ENV{'HTTP_X_REQUESTED_WITH'} eq 'XMLHttpRequest')
? 1
: 0;
}
sub _isBrowser {
my ($this) = shift;
#my $rvlScriptPath = __CONSTANT__::RVL_WWW_PATH . '/index.pl';
my $isBrowser = 0;
return (defined $ENV{'HTTP_USER_AGENT'}) ? 1 : 0;
# if (defined($ENV{'HTTP_USER_AGENT'}) && ($ENV{'SCRIPT_FILENAME'} =~ m/$rvlScriptPath/) ) {
# #call from RVLFramework
# $isBrowser = 1;
# }
# return $isBrowser;
}
sub isEmpty {
my ($this) = shift;
my ($ident) = ident($this);
if (!defined $props) {
return 1;
} else {
return 0;
}
}
sub getModuleName {
my ($this) = shift;
my ($ret);
if (defined $this->get('moduleName')) {
$ret = $this->get('moduleName');
} else {
$ret = 'default';
}
return $ret;
}
sub getManagerName {
my ($this) = shift;
my ($ret);
if (defined $this->get('managerName')) {
$ret = $this->get('managerName');
} else {
$ret = 'default';
}
return $ret;
}
sub getActionName {
my ($this) = shift;
my ($ret);
if ( defined $this->get('action')) {
$ret = $this->get('action');
} else {
$ret = 'default';
}
return $ret;
}
}
1;
Copyright 2K16 - 2K18 Indonesian Hacker Rulez