用perl生成wml(转自httplyy00.yeah.net)2.txt

C&C++论坛精华

作者：asp2001
email: [e-mail]
日期：2000-08-03 20:59:06
wap_pollvote.pl
更新数据库中的内容，并显示结果 

#! /usr/bin/perl

use DBI;
use CGI;

do "somevars.pl";


$head = PrintHeader();
print $head;

print "<wml>";
print "<card id=\"poll\" title=\"Poll Results\">";
print "<do type=\"prev\">";
print "<prev/>";
print "</do>";
print "<do type=\"options\" label=\"PT Home\">";
print "<go href=\"/wml/index.wml\"/>";
print "</do>";



# parameters got from the query

$q = new CGI;
$pollNum = $q->param("num");
$vote = $q->param("v");
$doVote = $q->param("dv");


if ($dbh = DBI->connect($dbName, $dbUser, $dbPw))
{

  # param 'dv' means "do vote". If set the script updates the poll results
  # if not set the script only display the results

  if ($doVote eq "dv")
  {
    $sth = $dbh->prepare("update poll_votes set votes = votes + 1 where poll_id = $pollNum and c = $vote");
    $results = $sth->execute() or die "SQL-Error:: $DBI::errstr\n";
    $sth->finish();
  }

  # display the current poll results

  $sth = $dbh->prepare("select text, votes  from poll_votes where poll_id = $pollNum");
  $results = $sth->execute() or die "SQL-Error:: $DBI::errstr\n";
  while (@result = $sth->fetchrow_array)
  {
    print "<p>$result[1]: $result[0]</p>";
  }
  $dbh->disconnect();
}
else
{
  print "<p>SQL-Error:: $DBI::errstr</p>";
}

print "</card></wml>";


sub PrintHeader{
  my($header);

  $header = "Content-type: text/vnd.wap.wml\n\n";
  $header .= "<?xml version=\"1.0\"?>";
  $header .= "<!DOCTYPE wml PUBLIC \"-//WAPFORUM//DTD WML 1.1//EN\"";
  $header .= " \"http://www.wapforum.org/DTD/wml_1.1.xml\">\n";
  return $header;
}