Perl cgi没有将哈希传递给mysql

【问题标题】：Perl cgi not passing the hash to mysqlPerl cgi没有将哈希传递给mysql
【发布时间】：2017-02-19 11:27:41
【问题描述】：

我有一个任务，要求我们在 perl cgi 中创建一个测验表格，接受来自本地 Web 浏览器的新问题。每次插入问题都需要在状态表中更新，最后应该显示数据库中存在的问题数量以及每个会话中插入的新问题。我使用 HTML 表单和 Mysql 作为我的数据库并在 localhost 上运行。当我尝试添加一个新问题时，唯一进入表格的就是问题，没有其他任何东西被添加。我可以看到 URL 中的值被传递给了服务器，但数据永远不会进入 SQL 语句。请帮忙。

#! /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;
}

【问题讨论】：

  • 启用 strict、warnings 和 diagnostics 编译指示。解决他们抱怨的问题。使用debugger 或放置良好的打印语句来了解您执行插入的代码部分中发生了什么（是您期望的数据）。如果您发现问题，请向后工作直到事情看起来正确，然后向前工作直到再次看起来错误。这两个状态之间的区域是您的错误所在。
  • 如果你必须做 CGI，请use the CGI module。这段代码是 1990 年代初期的风格。

标签： mysql perl


【解决方案1】：

您说这是“作业”让我非常担心，因为它暗示这是您在学校或大学学习的东西。我不知道你的老师给了你多少代码，或者你从互联网上阅读过时的信息拼凑了多少，但这是一种用 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 相去甚远，以至于本课程几乎毫无用处。如果贵校的任何人有兴趣提高本课程的质量，我很乐意尽我所能提供帮助。

【讨论】：

  • 我认为您在这里夸大了一些技术，尤其是 DBIx::Class。 DBI 可以保护您免受 SQL 注入（但前提是您明智地使用它）。让我担心的是，这种充满敌意且无益的愤怒会被误导给不了解情况的人。这不是你真正生气的海报。
  • @briandfoy：我同意 DBI 可以保护您免受 SQL 注入，但您需要知道如何正确使用它。但是使用 DBIC 的默认方式可以保护您，无需您考虑。重新阅读我的答案，我真的没有看到任何愤怒。我看到我说我担心他们正在学习和提供帮助改进课程的内容。我真的希望OP不认为我生他的气。这远非事实。
【解决方案2】：

问题是唯一进入数据库的原因是您从不存在的%fromHash 获取所有其他值。您将数据放入%formHash，而不是%fromHash。

这是strict pragma 捕获的（许多！）类型的问题之一。 use strict 和 use warnings 应该绝对不被注释掉。 曾经。当您学习 Perl 时，它们可能看起来有点苛刻，但它们实际上是您最好的朋友。即使作为一名经验丰富的 Perl 程序员，我总是启用它们，除非在极少数情况下，在非常小的代码部分中，我知道他们抱怨的确切原因和确切的原因该投诉不适用的原因。

还有：

  • 不要在子呼叫前加上&amp;。这是一个过时的 Perl 4-ism。在 Perl 5 中，它具有您可能不知道或不想要的副作用。
  • 如果您已经在使用CGI，让它为您处理表单/参数解码（使用param 方法），而不是手动进行。 （在实际生产代码中，我会说使用适当的 Web 框架，例如 Dancer 或 Mojolicious，而不是 CGI，但我假设 CGI 的选择是由您的任务决定的。）
  • 请注意，此代码易受 SQL 注入攻击。这通常是我非常重视的事情，但是，由于这是学习语言的介绍性作业，如果您继续进行 Web 编程，我将仅提及它作为稍后研究的内容。您可以查看Bobby Tables 了解有关 SQL 注入的更多详细信息，包括如何保护 Perl 代码免受此类攻击的示例。

【讨论】：

    猜你喜欢
    • 2013-09-27
    • 1970-01-01
    • 2014-02-14
    • 2011-02-01
    • 2017-01-22
    • 2023-03-28
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多
    热门标签
    Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode