Question

我正在通过mod_perl与Apache运行perl脚本。我试图以一种宁静的方式解析参数（又名GET www.domain.com/rest.pl/Object/ID）。

如果我像这样指定ID：GET www.domain.com/rest.pl/Object/1234我将按预期返回对象1234。

但是，如果我指定了一个不正确的被黑网状网址GET www.domain.com/rest.pl/Object/123，我还会找回对象1234。

我很确定this question中的问题正在发生，所以我将我的方法打包并从我的核心脚本中调用它。即使在那之后，我仍然看到线程返回看似缓存的数据。

上述文章中的一项建议是将my替换为our。通过阅读our与my，我的印象是our是全球性的，my是本地的。我的假设是局部变量每次都重新初始化。也就是说，就像我下面的代码示例中一样，我每次都使用新值重置变量。

Apache Perl配置设置如下：

PerlModule ModPerl::Registry

<Directory /var/www/html/perl/>
   SetHandler perl-script
   PerlHandler ModPerl::Registry
   Options +ExecCGI
</Directory>

以下是直接调用的perl脚本：

#!/usr/bin/perl -w
use strict;
use warnings;
use Rest;

Rest::init();

这是我的包Rest。该文件包含用于处理其余请求的各种函数。

#!/usr/bin/perl -w

package Rest;

use strict;
# Other useful packages declared here.

our @EXPORT = qw( init );

our $q = CGI->new;

sub GET($$) {
    my ($path, $code) = @_;
    return unless $q->request_method eq 'GET' or $q->request_method eq 'HEAD';
    return unless $q->path_info =~ $path;
    $code->();
    exit;
}

sub init()
{
eval {
        GET qr{^/ZonesByCustomer/(.+)$} => sub {
            Rest::Zone->ZonesByCustomer($1);
        }
    }
}

# packages must return 1
1;

作为旁注，我不完全理解这个eval语句是如何工作的，或者qr命令解析了什么字符串。此脚本主要来自this example，用于使用perl设置基于休息的Web服务。我怀疑它是从那个神奇的$_变量中被拉出来的，但是我不确定它是不是，或者它被填充了什么（显然是查询字符串或url，但它似乎只是它的一部分）？）。

这是我的包Rest::Zone，它将包含功能操作的内容。我忽略了我如何操作数据的细节，因为它正在工作并将其作为抽象存根。主要问题似乎是参数传入此函数，或者函数的输出。

#!/usr/bin/perl -w

package Rest::Zone;

sub ZonesByCustomer($)
{
    my ($className, $ObjectID) = @_;

    my $q = CGI->new;
    print $q->header(-status=>200, -type=>'text/xml',expires => 'now', -Cache_control => 'no-cache', -Pragma => 'no-cache');
    my $objectXML = "<xml><object>" . $ObjectID . "</object></xml>";
    print $objectXML;
}

# packages must return 1
1;

这里发生了什么？为什么我会继续获取陈旧或缓存的值？

Answer 1

试试这个：

my $q = CGI->new; 
print $q->header(-status => 200,
                 -type => 'text/xml',
                 -Cache_control => 'no-cache, no-store, must-revalidate'); 

my $ID = $q->path_info();
$ID =~ s/^.*\/(.*)$/$1/;

my $objectXML = "<xml><object>$ID</object></xml>"; 

print $objectXML;

Answer 2

不要使用全局CGI对象。

package Rest;

...

#our $q = CGI->new; 
# Remove that, it is only going to be executed once when the pacakge is loaded (use'd)

sub GET($$) {
    my ($path, $code) = @_;
    my $q = CGI->new; # Add this line (you can call CGI->new multiple times)
    return unless $q->request_method eq 'GET' or $q->request_method eq 'HEAD';
    return unless $q->path_info =~ $path;
    $code->();
    exit;
}

您可以将其保留为our全局，并在每次请求时刷新它。由于为每个请求调用了init（），所以将它放在那里：

package Rest;
our $q;
...
sub GET ....
...
sub init
{
  $q = CGI->new;
  eval ...
  ...
}

Perl Scripts似乎是缓存？

2 个答案: