2

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

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

但是，如果我像这样指定不正确的被黑 url，GET www.domain.com/rest.pl/Object/123我也会返回 object 1234。

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

上述文章中的一项建议是替换my为our. 阅读our vs 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。该脚本主要取自此示例，用于使用 perl 设置基于 REST 的 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;

这里发生了什么？为什么我不断收到陈旧或缓存的值？

4

2 回答 2

3

试试这个：

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;
于 2012-06-15T22:17:45.000 回答
3

不要使用全局 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 ...
  ...
}
于 2012-06-19T15:48:14.567 回答