的Perl CGI没有通过哈希到MySQL

我这就要求我们建立在Perl CGI测验形式接受来自我们的本地Web浏览器的新问题的任务。每个问题的插入都需要在状态表中更新，最后应显示数据库中存在的问题数量以及每个会话中插入的新问题。我使用HTML作为数据库并在本地主机上运行表单和Mysql。当我尝试添加一个新问题时，唯一使问题进入问题的是问题，没有其他问题会被添加。我可以看到URL中的值被传递给seerver，但数据永远不会使它成为SQL语句。请帮忙。的Perl CGI没有通过哈希到MySQL

#! /usr/bin/perl 
#use strict; 
#use warnings; 
#use diagnostics; 
print "Content-type: text/html\n\n"; 

if ($ENV{"REQUEST_METHOD"} eq "POST") { 
    read(STDIN, $datastring, $ENV{"CONTENT_LENGTH"});  
} 
elsif (exists $ENV{"REQUEST_METHOD"}) {  # data from GET transaction (or HEAD or other) 
    $datastring = $ENV{"QUERY_STRING"}; 
} 
else { 
    print "Offline execution detected\n"; 
    print "Please enter some data.\n"; 
    $datastring = <>; 
    chomp $datastring; 
    print "== data accepted == HTML output follows ==\n\n"; 
} 

###decode###################################################### 
$datastring =~s/%0D%0A/\n/g;      #step to deal with line 
                #breaks in text areas 
@nameValuePairs = split(/&/, $datastring);   #step 1 
foreach $pair (@nameValuePairs) { 
    ($name, $value) = split(/=/, $pair);    #step 2 
    $name =~tr/+/ /;         #step 3 
    $name =~s/%([\da-fA-F]{2})/pack("C",hex($1))/eg; #step 3 
    $value =~tr/+/ /;         #step 3 
    $value =~s/%([\da-fA-F]{2})/pack("C",hex($1))/eg; #step 3 

    if(exists $formHash{$name}) {      #improved step 4, 
    $formHash{$name} = $formHash{$name}.";".$value; #now handles multiple 
    }             #select menus 
    else { 
    $formHash{$name} = $value; 
    } 
} 
###done decoding############################################### 

### global variables ########################################## 
use DBI; 
$dbhandle = DBI->connect("DBI:mysql:databasexx", "idyy", "passzz") 
    or &errorPage("Can't connect to database". DBI->errstr()); 
$file_life_span = 1.0/24; # in days (so is 1 hours) 
$time_out = 1.0/24; 
$time_out = 1.0/24; # in days 
$cache_limit = 300; 
$state_table_name = "stable"; # name of state table 
$quiz_table_name = "qtable";  # name of quiz table 
%stateHash=(); 
### end of global variables ##################################### 

### app logiC################################################### 
if($formHash{"request"} eq "menu") { 
    &menu; 
} 
elsif($formHash{"request"} eq "add") { 
    &add; 
} 
elsif($formHash{"request"} eq "add2") { 
    &add2; 
} 
elsif($formHash{"request"} eq "list") { 
    &list; 
} 
else { 
    &welcome; 
} 
### end app logiC################################################ 

################################################################## 
sub welcome{ 
my $sessionID = &get_long_id_db($dbhandle, $state_table_name, $cache_limit, $file_life_span); 
$qnumber=1; 
%stateHash = ("qnumber"=>$qnumber); 
&write_state_db($dbhandle, $state_table_name, $sessionID, %stateHash); 

print <<PAGE; 
<html><head><title>Welcome</title></head> 
    <body> 
    <h2>Welcome</h2> 
    <form action="$ENV{SCRIPT_NAME}" method="GET"> 
    <input type="hidden" name="qnumber" value="$qnumber"> 
    <input type="hidden" name="id" value="$sessionID"/> 
    <input type="hidden" name="request" value="menu"> 
    <input type="submit" value="Main Menu"> 
    </form> 
</body> 
</html> 
PAGE 
} 

################################################################## 
sub menu{ 
    my $sessionID = $formHash{"id"}; 
    my $qnumber = $fromHash{"qnumber"}; 
print <<PAGE; 
<html><head><title>Menu</title></head> 
    <body> 
    <form action="$ENV{SCRIPT_NAME}" method="GET"> 
    <input type="hidden" name="qnumber" value="$qnumber"/> 
    <input type="hidden" name="id" value="$sessionID"/> 
    List the questions.<br> 
    <button type="submit" name="request" value="list">List Questions</button> 
    <br><br> 
    Add a question.<br> 
    <button type="submit" name="request" value="add">Add Question</button> 
    <br><br> 
    </form> 
</body> 
</html> 
PAGE 
} 

################################################################## 
sub add{ 
    my $sessionID = $formHash{"id"}; 
    my $qnumber = $fromHash{"qnumber"}; 
    $sql = "SELECT * from $quiz_table_name"; 
    $qObj = $dbhandle -> prepare($sql); 
    $qObj -> execute() or &errorPage("Can't execute " . $qObj->errstr()); 
    $qObj -> fetchall_arrayref(); # Fetch all rows, no need to use them 
    my $number_of_questions = $qObj->rows(); 
    $qObj -> finish(); 

print <<PAGE; 
<html><head><title>Add Question</title></head> 
    <body> 
    There are $number_of_questions in the database now.<br> 
    This will be your $qnumber question this session. 
    <form action="$ENV{SCRIPT_NAME}" method="GET"> 
    <input type="hidden" name="qnumber" value="$qnumber"/> 
    <input type="hidden" name="id" value="$sessionID"/> 
    <input type="hidden" name="request" value="add2"> 
    <br/> 
    Enter the Question.<br> 
    <INPUT TYPE="text" NAME="question" VALUE="Question"><br> 
    Correct Answer.<br> 
    <INPUT TYPE="text" NAME="answer" VALUE="Answer"><br> 
    Choce #1.<br> 
    <INPUT TYPE="text" NAME="choice1" VALUE="1"><br> 
    Choce #2.<br> 
    <INPUT TYPE="text" NAME="choice2" VALUE="2"><br> 
    Choce #3.<br> 
    <INPUT TYPE="text" NAME="choice3" VALUE="3"><br> 
    Choce #4.<br> 
    <INPUT TYPE="text" NAME="choice4" VALUE="4"><br> 
    Choce #5.<br> 
    <INPUT TYPE="text" NAME="choice5" VALUE="5"><br> 
    <br/> 
    <input type="submit" value="Submit"> 
    </form> 
</body> 
</html> 
PAGE 
} 

################################################################## 
sub add2{ 
    my $sessionID = $formHash{"id"}; 
    my $qnumber = $fromHash{"qnumber"}; 
    my $question = $formHash{"question"}; 
    my $answer = $fromHash{"answer"}; 
    my $choice1 = $fromHash{"choice1"}; 
    my $choice2 = $fromHash{"choice2"}; 
    my $choice3 = $fromHash{"choice3"}; 
    my $choice4 = $fromHash{"choice4"}; 
    my $choice5 = $fromHash{"choice5"}; 
    $stateHash{"qnumber"}++; # The next question number. 
    &write_state_db($dbhandle, $state_table_name, $sessionID, %stateHash); 
    $sql = "INSERT INTO $quiz_table_name(question, answer, choice1, choice2, choice3, choice4, choice5) VALUES(?,?,?,?,?,?,?)"; 
    $qObj = $dbhandle -> prepare($sql) or &errorPage("Can't prepare"); 
    $qObj -> execute($question, $answer, $choice1, $choice2, $choice3, $choice4, $choice5) or &errorPage("Can't execute " . $qObj->errstr()); 
    $qObj -> finish(); 
    $request = menu; 
} 

################################################################## 
sub list { 
    my $sessionID = $formHash{"id"}; 
    my $qnumber = $fromHash{"qnumber"}; 
print <<PAGE; 
    <html><head><title>List Questions</title></head> 
    <body> 
    <h2>List Questions</h2><br/> 

    <style> 
    table, th, td { 
    border: 1px solid black; 
    } 
    th { 
    text-align: left; 
    } 
    </style> 
    <table> 
    <tr><th>Number</th><th>Question</th><th>Answer</th><th>Choice 1</th><th>Choice 2</th><th>Choice 3</th><th>Choice 4</th><th>Choice 5</th></tr> 
PAGE 
    # DEFINE A MySQL QUERY 
    $sql = "SELECT qnumber, question, answer, choice1, choice2, choice3, choice4, choice5 FROM $quiz_table_name"; 
    $qObj = $dbhandle -> prepare($sql) or &errorPage("Can't prepare"); 
    $qObj -> execute() or &errorPage("Can't execute " . $qObj->errstr()); 
    my $arry_ref = $qObj->fetchall_arrayref(); 
    $qObj -> finish(); 
    foreach my $row(@$arry_ref) 
    { 
     my ($qnumber, $question, $answer, $choice1, $choice2, $choice3, $choice4, $choice5) = @$row; 
     print "<tr><th>$qnumber</th><th>$question</th><th>$answer</th><th>$choice1</th><th>$choice2</th><th>$choice3</th><th>$choice4</th><th>$choice5</th></tr>"; 
    } 
    # PRINT THE RESULTS 
    print <<BOTTOM; 
    </table> 

</body> 
</html> 
<form action="$ENV{SCRIPT_NAME}" method="POST"> 
<input type="hidden" name="qnumber" value="$qnumber"/> 
<input type="hidden" name="id" value="$sessionID"/> 
<input type="hidden" name="request" value="menu"> 
<input type="submit" value="Main Menu"> 
    </form> 
</body> 
</html> 
BOTTOM 
} 


################################################################# 
################################################################# 
# end app logic functions 
# begin toolkit functions 
################################################################# 
################################################################# 

################################################################# 
sub write_state_db { 
    my ($dbhandle, $table_name, $sessionID, %states) = @_; 
    ### add the updated last-modified time to the front of the incoming state hash 
    my $currtime = time; 
    my @updates = ("last_modified = '$currtime'"); 
    foreach $key (keys %states){ 
    push @updates, "$key = '$states{$key}'"; 
    } 

    ### update the state record 
    $sql = "UPDATE $table_name set " . join(",", @updates) . " WHERE id = '$sessionID'"; 
    $qObj = $dbhandle -> prepare($sql); 
    $qObj -> execute() or &errorPage("Can't execute " . $qObj->errstr()); 
    $qObj -> finish(); 
} 

################################################################# 
sub read_state_db { 
    my ($dbhandle, $table_name, $sessionID, $time_out, 
     $time_out_function, $time_out_message) = @_; ### $time_out is in days 

    ### read the desired state record into the query object 
    $sql = "SELECT * FROM $table_name WHERE ID = '$sessionID'"; 
    $qObj = $dbhandle -> prepare($sql) or &errorPage("Can't prepare."); 
    $qObj -> execute() or &errorPage("Can't execute " . $qObj->errstr()); 
    my $rowhashref = $qObj->fetchrow_hashref(); 
    $qObj -> finish(); 

    if(! $rowhashref) { ### $rowhashref is an empty reference, which means no such id... 
    &errorPage("No such session."); 
    } 
    my %hash = %$rowhashref; ### get the actual hash containing the state record 
    ### timeout test 
    if(($time_out > 0) && ($hash{"last_modified"} < time - $time_out*24*60*60)){ 
    ### timed out... 
    if($time_out_function) { 
     &$time_out_function($time_out_message); 
      exit; 
    } 
     else{ 
     &errorPage("Your session has timed out"); 
    } 
    } 
    ### touch the record 
    $sql = "UPDATE $table_name SET last_modified = " . time . " WHERE ID = '$sessionID'"; 
    $qObj = $dbhandle -> prepare($sql) or &errorPage("Can't prepare."); 
    $qObj -> execute() or &errorPage("Can't execute " . $qObj->errstr()); 
    $qObj -> finish(); 
    ### only need to return the actual state data 
    delete $hash{"id"}; 
    delete $hash{"last_modified"}; 
    return %hash;   
} 

################################################################# 
sub get_long_id_db { 
    my ($dbhandle, $table_name, $cache_limit, $file_life_span) = @_; 

    ### count number of sessions 
    my $sql = "SELECT id FROM $table_name"; 
    my $qObj = $dbhandle -> prepare($sql) or &errorPage("Can't prepare."); 
    $qObj -> execute() or &errorPage("Can't execute " . $qObj->errstr()); 
    $qObj -> fetchall_arrayref(); 

    if($qObj->rows() >= $cache_limit) {  ### Need to police table? 
    my $expiredtime = int(time - $file_life_span*24*60*60); ### in seconds ### 
    $qObj -> finish(); 

    ### police the table 
    $sql = "DELETE FROM $table_name WHERE last_modified < $expiredtime"; 
    $qObj = $dbhandle -> prepare($sql) or &errorPage("Can't prepare.");; 
    $qObj -> execute() or &errorPage("Can't execute " . $qObj->errstr()); 
    $qObj -> finish(); 

    ### count number of sessions again 
    $sql = "SELECT id FROM $table_name";   
    $qObj = $dbhandle -> prepare($sql) or &errorPage("Can't prepare.");; 
    $qObj -> execute() or &errorPage("Can't execute " . $qObj->errstr()); 
    $qObj -> fetchall_arrayref(); 

    if($qObj->rows() >= $cache_limit) { ### still over limit? 
     # should generate e-mail message to warn administrator 
     &errorPage("Site busy. Please try again later."); 
    } 
    } 
    $qObj -> finish(); 

    my $id = &generate_random_string(32); 
    my $currtime = time; 

    ### create new state record 
    $sql = "INSERT INTO $table_name (id, last_modified) values ('$id', $currtime)"; 
    $qObj = $dbhandle -> prepare($sql) or &errorPage("Can't prepare.");; 
    $qObj -> execute() or &errorPage("Can't execute " . $qObj->errstr()); 

    return $id; 
} 

################################################################# 
sub generate_random_string { 
    my $n = $_[0]; 
    my $result = ""; 
    my @chars = (0..9, 'a'..'z', 'A'..'Z'); 
    my $which; 
    for($i = 1 ; $i <= $n ; $i++) { 
    $which=int rand 62; 
    $result = $result . $chars[$which]; 
    } 
    return $result; 
} 

################################################################# 
sub errorPage { 
my $message = $_[0]; # the incoming parameter, store in localized variable 
print<<ALL; 
<html> 
<head> 
    <title>Error encountered</title> 
</head> 
<body> 
    <h1>Error Encountered</h1> 
    <h3>$message</h3> 
    Please try again, or report the problem to the webmaster. 
</body> 
</html> 
ALL 
exit; 
}

来源

2016-10-10 Keg

启用'strict'，'warnings'和'diagnostics'编译指示。修复他们抱怨的事情。使用[debugger]（http://perldoc.perl.org/perldebug.html）或者精心设计的打印语句来了解你的代码中插入内容的部分发生了什么（数据是你的期待）。如果您发现问题，请向后进行操作，直到看起来正确，然后转发，直到再次出现错误。这两个州之间的区域就是你的错误所在。 –

如果您*必须*执行CGI，请[使用CGI模块]（http://perldoc.perl.org/CGI.html）。这个代码是从90年代初的风格。 – tadman

的原因，问题是，这使得它到数据库中唯一的事情是，你从%fromHash，不存在让其他所有的值。你把你的数据写入%formHash，而不是%fromHash。

这是（多！）类型的问题，这些问题得到由strict编译抓之一。 use strict和use warnings应该绝对不注释掉。 永远。当你学习Perl时，他们可能看起来有点苛刻，但他们实际上是你最好的朋友。即使作为一个有经验的Perl程序员，我总是已经他们启用，除了在极少数情况下的代码非常小的部分，我知道为什么他们抱怨和的确切原因为什么抱怨是不适用的确切原因。

另外：

不要前缀&您的通话子。这是一个过时的Perl 4主题。在Perl 5中，它有你可能不知道或想要的副作用。
如果你已经在使用CGI，让它处理，而不是做手工为你的表格/参数解码（用param方法）。（在实际生产代码中，我会说使用适当的Web框架，例如Dancer或Mojolicious，而不是CGI，但我认为CGI的选择取决于您的分配。）
请注意，此代码容易受到SQL注入攻击。这通常是我要做的一件大事，但是，由于这是学习语言的入门任务，如果您继续进行网络编程，我会在稍后提及它作为一些事情。有关SQL注入的更多详细信息，请参阅Bobby Tables，其中包括如何保护Perl代码免受此类攻击的示例。

来源

2016-10-11 07:42:17

它令我非常担心，你说这是“一项任务”，因为这意味着这是你在学校或大学学习的东西。我不知道你的老师给你的这段代码有多少，也不知道你从网上读了多少日期信息拼凑了多少代码，但这是用Perl编写的Web应用程序的一种风格，至少是15年过时了。

这些天，我们不使用CGI在Perl中编写Web应用程序。现代Perl Web应用程序基于PSGI and Plack。
如果你坚持使用CGI编写Web应用程序，那么CGI module已经出现了自90年代中期，将让您的生活更轻松。特别是，您应该使用它的param()函数，而不是您的手写和错误的表单解析代码。
从任何人推荐将原始HTML放入Perl程序已有15年了。您应该改用templating engine。

除了网络特定的东西，还有其他的东西，你在做什么，这表明你正在从过时的来源学习。没有必要在子程序调用

＆符号因为Perl 5在1994年被释放，他们有一对夫妇的“有趣”的效果这意味着大多数人不应该使用它们的大部分时间。
这些天大部分数据库访问都是使用DBIx::Class写成的，它是您正在使用的原始DBI之上的包装。除了它提供的其他优势之外，它还可以保护您免受您无意中包含在代码中的SQL注入漏洞。

最后，如果你没有在你的代码中注释掉use strict，你会自己发现你的问题。这迫使你声明你的变量，并且在它会发现的（许多）错误当中，你会忘记%formHash为%fromHash。

你在这里学到的东西离Perl很远，在工作场所对你来说很有用，这门课很接近无用。如果你所在学院的任何人对提高本课程的质量感兴趣，我会很乐意以任何方式提供帮助。

来源

2016-10-11 09:32:55

我想你夸大了这里的一些技术，特别是DBIx :: Class。它是DBI，可以保护您免受SQL注入（但只有在您明智地使用它时）。让我担心的是这种敌意，而且毫无益处的愤怒会被误导给那些不了解情况的人。这不是你生气的海报。 –

@briandfoy：我同意DBI可以保护您免受SQL注入攻击，但您需要知道如何正确使用它。但是，使用DBIC的默认方式在没有您不必考虑的情况下就可以保护您。重新阅读我的答案，我真的没有看到任何愤怒。我看到我说我担心他们正在学习并提供帮助改善课程。我真的希望OP能认为我不生他的气。这与事实不符。 –

的Perl CGI没有通过哈希到MySQL

回答

相关问题