【问题标题】:Perl help: Can't call method "display" on an undefined valuePerl 帮助:无法在未定义的值上调用方法“显示”
【发布时间】:2012-11-07 17:10:20
【问题描述】:

让我们从基本的背景开始。我们最近将我们的网络托管带到了内部。 很少有旧网站仍然使用 Perl。我没有使用 Perl 的经验。 让我们开始。我们的主域上有一个这个子网站。

公共链接:http://www.gatewayrehab.org/eap/

当您转到网站时,我们会收到以下错误消息

 "Software error:

Can't call method "display" on an undefined value at /var/www/www.gatewayrehab.org/app/webroot/eap/index.cgi line 47."

查看 EAP 网站/目录,所有文件都在适当的权限下就位,我再次没有使用 Perl/Cgi 的经验。下面是 index.cgi 文件:

#!/usr/bin/perl -w

### the main control file used in the system
BEGIN { unshift @INC, qw(./cgi-bin/include/); }

### send all fatal errors to the browser
use CGI::Carp qw(fatalsToBrowser);
use CGI qw(:standard);
use Error_Handler;
use File_Handler;
use Cookie_Handler;

require "./cgi-bin/setup.cgi";
do "./cgi-bin/include/common.cgi";

### initialize the file handling module
my $File = new File_Handler;
### initialize the cookie handling module
my $Cookie = new Cookie_Handler;

###parse 
$ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/;
if ($ENV{'REQUEST_METHOD'} eq "POST"){
    read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
} else {
    $buffer = $ENV{'QUERY_STRING'};
}
@pairs = split(/&/, $buffer);

#&error_check;

foreach $pair (@pairs){
    ($name, $value) = split(/=/, $pair);
    $value =~ tr/+/ /;
    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    $name =~ tr/+/ /;
    $name =~ s/\breq\_//ig;
    $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    $name =~ tr/A-Z/a-z/;
    $name = trim($name);
    $FORM{$name} = trim($value);
}

my %cookiedata = $Cookie -> get_cookies();

### read the summary database
my $summary_ref = $File -> read($login_summary)|| $Error -> display("$!". __LINE__);
my (@summary) = @$summary_ref;

### read the companies database
my $companies_ref = $File -> read($companies_db)|| $Error -> display("$!". __LINE__);
my (@companies) = @$companies_ref;

my %COMP = ();
foreach (@companies) {
    $_ =~ s/\n|\r//g;
    my ($c_num, $c_name) = split(/\t/, $_);
    $COMP{$c_num} = $c_name;
}

if ( $cookiedata{'LOGIN'} != 1 ) {
    my $found = 0;
    my $company_number = $ENV{'REMOTE_USER'};
    $company_number =~ s/s|e|w//g;

    foreach (@summary) {
        $_ =~ s/\n|\r//g;
        my @field = split(/\t/, $_);
        $field[0] = &trim($field[0]);
        $field[2] = &trim($field[2]);       
        $field[3] = &trim($field[3]);
        $field[4] = &trim($field[4]);
        $field[5] = &trim($field[5]);
        $field[6] = &trim($field[6]);

        if ( $field[0] eq "$company_number" ) {
            $found = 1;

            my $firstletters = substr($ENV{'REMOTE_USER'}, 0, 2);
            $firstletters = trim($firstletters);
            if ( $firstletters ne "sw" && $firstletters ne "lf" ) {
                $firstletters = substr($firstletters, 0, 1);
            }
            if ( lc($firstletters) eq "e" ) {
                $field[3] = ($field[3] + 1);                
            } elsif ( lc($firstletters) eq "s" ) {
                $field[2] = ($field[2] + 1);
            } elsif ( lc($firstletters) eq "w" ) {
                $field[4] = ($field[4] + 1);
            } elsif ( lc($firstletters) eq "sw" ) {
                $field[5] = ($field[2] + 1);
            } elsif ( lc($firstletters) eq "lf" ) {
                $field[6] = ($field[6] + 1);
            } else {
                $field[3] = ($field[3] + 1);
            }           

            $_ = join("\t", @field);
        } 
    }

    if ( $found == 1 ) {
        # write data back to file
        # append to summary file
        open(LOG, ">$login_summary") || $Error -> display("$!". __LINE__);
        flock(LOG,2);
        foreach (@summary) {
            print LOG $_ ."\n";
        }
        flock(LOG,8);
        close(LOG);         
        #$File -> file($login_summary);
        #$File -> data(\@summary);
        #$File -> write() || $Error -> display("$!". __LINE__); 
    } else {
        $e = 0;
        $s = 0;
        $w = 0;
        $sw = 0;
        $lf = 0;

        my $firstletters = substr($ENV{'REMOTE_USER'}, 0, 2);
        $firstletters = trim($firstletters);
        if ( $firstletters ne "sw" && $firstletters ne "lf" ) {
            $firstletters = substr($firstletters, 0, 1);
        }
        if ( lc($firstletters) eq "e" ) {
            $e = 1;         
        } elsif ( lc($firstletters) eq "s" ) {
            $s = 1;
        } elsif ( lc($firstletters) eq "w" ) {
            $w = 1;
        } elsif ( lc($firstletters) eq "sw" ) {
            #$sw = 1;
            $s = 1;
        } elsif ( lc($firstletters) eq "lf" ) {
            $lf = 1;
        } else {
            $e = 1;
        }

        # append to summary file
        open(LOG, ">>$login_summary") || $Error -> display("$!". __LINE__);
        flock(LOG,2);
        print LOG $company_number ."\t". $COMP{$company_number} ."\t". $s ."\t". $e ."\t". $w . "\t". $sw ."\t". $lf ."\n";
        flock(LOG,8);
        close(LOG); 
    }

    my (@login_logs) = ();
    my $logline = "";
    $login_logs[0] = $ENV{'REMOTE_USER'};
    $login_logs[1] = $ENV{'REMOTE_ADDR'};
    $login_logs[2] = time();

    open(LOG, ">>$login_logs") || $Error -> display("$!". __LINE__);
    flock(LOG,2);
    print LOG $ENV{'REMOTE_USER'} ."\t". $ENV{'REMOTE_ADDR'} ."\t". time() ."\n";
    flock(LOG,8);
    close(LOG);

    print "Set-Cookie: LOGIN=1";
    print "; path=$cookiepath; domain=$cookiedomain;\n";    
}

my $firstletters = substr($ENV{'REMOTE_USER'}, 0, 2);
$firstletters = trim($firstletters);
if ( $firstletters ne "sw" && $firstletters ne "lf") {
    $firstletters = substr($firstletters, 0, 1);
}

if ( lc($firstletters) eq "e" ) {
    print "Location: http://www.gatewayrehab.org/eap/new/employee/member.htm\n\n";          
} elsif ( lc($firstletters) eq "s" ) {
    print "Location: http://www.gatewayrehab.org/eap/supervisor/\n\n";
} elsif ( lc($firstletters) eq "w" ) {
    print "Location: http://www.gatewayrehab.org/eap/new/worklife/member.htm\n\n";
} elsif ( lc($firstletters) eq "sw" ) {
    print "Location: http://www.gatewayrehab.org/eap/supervisor-wl/\n\n";
    exit;
} elsif ( lc($firstletters) eq "lf" ) {
    print "Location: http://www.gatewayrehab.org/eap/legalandfinancial/\n\n";
    exit;
} else {
    print "Location: http://www.gatewayrehab.org/eap/new/employee/member.htm\n\n";
}

#output html
print "Content-type: text/html\n\n";
print "<h1>hello world!</h1>";

$e = `perl -ver`;
$r = `whereis perl5`;
$z = `whereis sendmail`;#
$w = `top`;#
$d = `w`;

print "<pre>perl version:<br>$e<hr>perl path:<br>$r<hr>sendmail path:<br>$z<hr>top:<br>$w<hr>w:<br>$d<hr>environment vars:<br>";##

while (($key, $val) = each %ENV) {
    print "$key = $val\n";
}


$x= 'lowercase';
print "<hr>path tranlsated(NT)<br>$ENV{'PATH_TRANSLATED'}</pre>";
#$x = uc($x);
print "<br>$x";
exit;

请让我知道我缺少什么。如果您需要查看更多“包含”文件,请告诉我。

这里也是我们的 cgi 配置的链接。 http://www.gatewayrehab.org/eap/cgi-bin/cgi.cgi

谢谢。

【问题讨论】:

  • 虽然我对你的情况表示同情,但如果有一个“帮助我学习足够的 Perl 来解决这个问题”而不是“这是我所看到的一切;告诉我该怎么做”,这个问题会更适合这个网站"。
  • @ysth:非常正确。但是你有人要学习 Perl,那么我真的希望他们不会从这个看起来像是 1996 年左右编写的程序的怪物开始:-/
  • @Dave Cross:先生,您不是维护程序员 :)
  • 其实很多时候我都是。但是一个永远乐观的人:)

标签: linux perl cgi


【解决方案1】:

错误来自这一行:my $summary_ref = $File -&gt; read($login_summary)|| $Error -&gt; display("$!". __LINE__);。这意味着$Error 不存在或其值为undef。事实上,我没有看到这样的变量被声明或初始化。也许它应该是由Error_Handler导出的???

在尝试报告另一个错误时发生此错误。您可以尝试用die($!) 替换(如果只是暂时的)$Error -&gt; display("$!". __LINE__); 并检查服务器的错误日志以获取错误消息。也就是说,肯定是“没有这样的文件或目录”或“权限被拒绝”,所以也许不值得花时间找出确切的消息。 (更新:实际上,我认为消息将被“重定向”到您的浏览器,这样会更容易。)

我在这里猜测,但它似乎正在尝试读取以$login_summary 命名的文件。我不知道这是在哪里设置的(如果有的话!),所以你可能想找出它的价值,也许它是在哪里设置的。

【讨论】:

  • 感谢您的回复。我尝试用 die($!) 换行。得到错误回复说“没有这样的文件或目录”。让我补充一下,我确实在文件夹名称“logs”中找到了 login_summery.cgi。请告诉我在哪里可以找到 ($login_summery) 的值
【解决方案2】:

正如 ikegami 指出的那样,您看到的错误表明 $Error 没有被初始化,并且查看脚本的其余部分,我猜想(首先)需要的是在与$File$Cookie 变量的方式相同。在脚本的第 20 行之后添加这一行:

my $Error = new Error_Handler;

这可能会给您一个更好的错误消息,但它可能只会告诉您在添加 die($!); 行时已经发现的内容:“没有这样的文件或目录”。

您的脚本也是doing 一个名为./cgi-bin/include/common.cgi 的文件。检查此文件中的 $login_summary 变量,以了解它试图访问的文件。

【讨论】:

    【解决方案3】:

    我已经通过快速修复解决了这个问题。我不知道它为什么起作用,但它对我有用。 这是我所做的......在网上阅读后,我发现在所有 .(dot)cgi 文件的标题上添加“-w”可以使其工作。 我确实希望有一种更好的方法可以在一个地方添加“-w”,然后将它添加到所有 .cgi 文件中。

    简而言之,将#!/usr/bin/perl 更改为#!/usr/bin/perl -w

    谢谢大家。

    【讨论】:

    猜你喜欢
    • 1970-01-01
    • 2016-12-22
    • 1970-01-01
    • 1970-01-01
    • 2019-03-27
    • 1970-01-01
    • 1970-01-01
    • 2016-12-10
    • 2012-08-24
    相关资源
    最近更新 更多