Update of /cvsroot/curl/curl-www/feedback
In directory labb:/tmp/cvs-serv21050
Added Files:
add.cgi addentry.cgi addremark.cgi addsupport.cgi change.cgi
date.pm display.cgi edit.cgi editcomm.cgi editsupp.cgi
feedback.pm fixsupp.cgi list.cgi pbase.pm remark.cgi
support.cgi
Log Message:
the feedback "forum" scripts
--- NEW FILE: editsupp.cgi ---
#!/usr/bin/perl
require "CGI.pm";
require "pbase.pm";
require "date.pm";
use feedback;
Top();
Header("Edit Supporting Comments");
$req = new CGI;
$id = $req->param('id');
$support = $req->param('support');
$db = new pbase;
$db->open("data/ideas");
%row=%{$db->get("id", $id)};
print <<SLUT
<p>
Edit the supporter stuff below
<p>
SLUT
;
print "<table bgcolor=\"#000000\" cellspacing=2 cellpadding=2
border=0><tr><td>\n";
print "<table bgcolor=\"#ffffff\" cellspacing=0 cellpadding=2 border=0>\n";
$when = $row{"when"};
if($when =~ /^(\d\d\d\d)-(\d\d)-(\d\d)$/) {
$nicedate = sprintf("%s %d, %d",
&MonthNameEng($2), $3, $1);
}
else {
$nicedate = $when;
}
$edit = $row{"edit"};
if($edit) {
$editwhen=$row{"editdate"};
if($editwhen =~ /^(\d\d\d\d)-(\d\d)-(\d\d)$/) {
$nicewhen = sprintf("on %s %d, %d",
&MonthNameEng($2), $3, $1);
}
$editmsg = "<small>(edited by $edit $nicewhen)</small>";
}
$supps = $row{"numsupports"};
$cl = "bgcolor=#cccccc";
print "<tr><td $cl valign=top>Name</td><td>".$row{"name"}."
<<i>".$row{"email"}."</i>> $editmsg</td></tr>\n";
print "<tr><td $cl>Category</td><td>".$row{"category"}."</td></tr>\n";
print "<tr><td $cl>When</td><td>$nicedate</td></tr>\n";
print "<tr><td valign=top $cl>Text</td><td valign=top><i><font
size=+1>".$row{"idea"};
print "</i></font></td></tr>\n";
print "</table>\n";
print "</td></tr></table>\n";
if($supps) {
print "<h2>Supporters</h2>\n";
print "<table bgcolor=\"#000000\" cellspacing=2 cellpadding=2
border=0><tr><td>\n";
print "<table bgcolor=\"#ffffff\" cellspacing=0 cellpadding=2 border=0>\n";
for(1 .. $supps) {
$si = $_-1;
$na = " ".$row{"suppname$si"};
$em = " ".$row{"suppemail$si"};
$da = " ".$row{"suppdate$si"};
$co = " ".$row{"suppcomment$si"};
$cl = "bgcolor=#cccccc";
print "<tr><td $cl valign=top>Name</td><td>$na
<<i>$em</i>></td></tr>\n";
print "<tr><td $cl>Date</td><td>$da</td></tr>\n";
print "<tr><td $cl>Comment</td><td>$co</td></tr>\n";
print "<tr><td $cl> </td><td> <a
href=\"fixsupp.cgi?id=$id&supp=$si\">[EDIT]</a> </td></tr>\n";
}
print "</table>\n";
print "</td></tr></table>\n";
}
$db->close();
print "<p><small><a href=\"edit.cgi?id=$id\">edit</a></small>\n";
Footer;
--- NEW FILE: addremark.cgi ---
#!/usr/bin/perl
require "CGI.pm";
require "pbase.pm";
require "date.pm";
use feedback;
$req = new CGI;
$permit = $req->param('passwd');
$remark = $req->param('remark');
$id = $req->param('id');
$remarkdate = sprintf("%04d-%02d-%02d", &ThisYear, &ThisMonth, &ThisDay);
# convert < and > first
$remark =~ s/</</g;
$remark =~ s/>/>/g;
# insert <p> to make new paragraphs
$remark =~ s/\r\n\r\n/\r\n<p>\r\n/g;
# replace http://-specified URLs
$remark =~ s/(http:\/\/[^ \r\n]*)/<a href=\"$1\">$1<\/a>/gi;
# replace www.-specified sites
$remark =~ s/([ \t\n]|)(www.[^ \r\n]*)/$1<a
href=\"http:\/\/$2\">http:\/\/$2<\/a>/g;
# replace blabla@blabla mailtos
$remark =~ s/([ \t\n]|)(([^ \r\n]+)\@([^ \r\n]+))/$1<a
href=\"mailto:$2\";>$2<\/a>/g;
$db = new pbase;
$db->open("data/ideas");
%row=%{$db->get("id", $id)};
if($permit ne $row{"passwd"}) {
&Header("Bad Password");
print "<p> I insist on getting the real actual password.";
&Footer;
exit;
}
$row{"remark"}= "$remark";
$row{"remarkdate"}= "$remarkdate";
$db->change("id", "$id", %row);
$db->save();
print "Location: display.cgi?id=$id&support=yes\n\n";
--- NEW FILE: pbase.pm ---
# _
# _ __ | |__ __ _ ___ ___
# | '_ \| '_ \ / _` / __|/ _ \
# | |_) | |_) | (_| \__ \ __/
# | .__/|_.__/ \__,_|___/\___|
# |_|
#
# A simple database in pure perl.
#
# Main author: Kjell.Ericson@xxxxxxx
#
# Non-commercial use: Do whatever you want with it. If you add something
# usefull then send me a copy of it so I can replace the current version.
#
# Commercial use: Send me an email and tell me that you use it.
#
# pbase has borrowed main functionality, the database file format and some
# other ideas of "dbase" made by Bjorn.Stenberg@xxxxxxxx dbase is an
# executable standalone database handler, while pbase is a perl-included
[...1243 lines suppressed...]
{
my($self, $subroutine)=@_;
@{$self->{selectionlist}[$self->{selection}]} =
sort {&$subroutine(\%{$self->{Database}[$a]},
\%{$self->{Database}[$b]}) }
@{$self->{selectionlist}[$self->{selection}]};
}
# _
# __ _____ _ __ ___(_) ___ _ __
# \ \ / / _ \ '__/ __| |/ _ \| '_ \
# \ V / __/ | \__ \ | (_) | | | |
# \_/ \___|_| |___/_|\___/|_| |_|
# Returning version of pbase
sub version
{
return $version;
}
--- NEW FILE: feedback.pm ---
require "../curl.pm";
$adminpasswd="ninja";
# -----------------------------
# Make the suggestion look better. Cut off all HTML, then add our HTML!
sub cleantext {
my $idea = $_[0];
my $html = $_[1]; # non-zero if we allow converted HTML
# replace & with html-text
$idea =~ s/&/&/g;
# convert < and > first
$idea =~ s/</</g;
$idea =~ s/>/>/g;
if($html) {
# insert <p> to make new paragraphs
$idea =~ s/\r\n\r\n/\r\n<p>\r\n/g;
# replace http://-specified URLs
$idea =~ s/(http:\/\/[^ \r\n]*)/<a href=\"$1\">$1<\/a>/gi;
# replace www.-specified sites
$idea =~ s/([^\/]|^)(www.[^ \r\n]*)/$1<a href=\"http:\/\/$2\">$2<\/a>/g;
# replace blabla@blabla mailtos
$idea =~ s/([ \t\n]|^)(([^ \r\n]+)\@([^ \r\n]+))/$1<a
href=\"mailto:$2\";>$2<\/a>/g;
}
return $idea;
}
sub showit {
$file = $_[0];
open(MENU, "<$file");
while(<MENU>) {
print $_;
}
close(MENU);
}
sub Top {
print "Content-Type: text/html\n\n";
showit("../feedback.html");
}
sub Header {
my $title = $_[0];
title($title);
print <<SLUT
<p>
[<a href="list.cgi">List Suggestions</a>]
[<a href="addentry.cgi">Add Suggestion</a>]
[<a href="/bugreport.html">Add Bug Report</a>]
SLUT
;
# print "<h1>$title</h1>\n";
}
sub Footer {
&showit("../foot.html");
}
sub GetCategories {
my @cats;
open(CATS, "<info/categories");
while(<CATS>) {
if($_ !~ /^ *\#/) {
# not a comment, it's a category
chomp $_;
push @cats, $_;
}
}
close(CATS);
return @cats;
}
sub ShowInput {
print <<EOD
<form action="add.cgi" method="post">
<center>
<table bgcolor="#000000" cellspacing=2 cellpadding=2 border=0><tr><td>
<table bgcolor="#cccccc" cellspacing=0 cellpadding=3 border=0>
<tr><td>Name </td><td> <input type=text name=name value="$name"
size=50></tr>
<tr><td>Email </td><td> <input type=text name=email value="$email"
size=50></tr>
<tr><td>Password </td><td> <input type=text name=passwd value="$passwd"
size=10> (read explanation above) </tr>
<tr><td>Category </td><td> <select name=category>$cats</select> </td></tr>
<tr><td>Title </td><td> <input type=text name=title value="$title"
size=50></tr>
<tr><td colspan=2>Suggestion</td></tr>
<tr><td colspan=2>
<textarea name=idea rows=10 cols=60 wrap=virtual>$idea</textarea></td></tr>
<tr><td><input type=submit value="submit" name=submit><input type=submit
value="preview" name=preview></td>
<td align=right><input type=submit value="cancel" name=cancel></td></tr>
</table>
</td></tr></table>
</center>
</form>
EOD
;
}
1;
--- NEW FILE: display.cgi ---
#!/usr/bin/perl
require "CGI.pm";
require "pbase.pm";
require "date.pm";
use feedback;
$maxcommperpage = 5;
Top();
&where("Feedback", "/feedback/", "Display Suggestion");
Header("A suggestion");
$req = new CGI;
$id = $req->param('id');
$support = $req->param('support');
$single = $req->param('single');
$start = 0+$req->param('start');
if($start < 1) {
$start = 1;
}
$db = new pbase;
$db->open("data/ideas");
%row=%{$db->get("id", $id)};
print <<SLUT
<p>
This is a single suggestion. Use the list option above to see other.
<p> To comment this suggestion, press the "<i>I wanna comment this
suggestion</i>" button and follow the instructions on the next page.
<p>
SLUT
;
print "<table bgcolor=\"#000000\" cellspacing=2 cellpadding=2
border=0><tr><td>\n";
print "<table bgcolor=\"#ffffff\" cellspacing=0 cellpadding=2 border=0>\n";
$when = $row{"when"};
if($when =~ /^(\d\d\d\d)-(\d\d)-(\d\d)$/) {
$nicedate = sprintf("%s %d, %d",
&MonthNameEng($2), $3, $1);
}
else {
$nicedate = $when;
}
$edit = $row{"edit"};
if($edit) {
$editwhen=$row{"editdate"};
if($editwhen =~ /^(\d\d\d\d)-(\d\d)-(\d\d)$/) {
$nicewhen = sprintf("on %s %d, %d",
&MonthNameEng($2), $3, $1);
}
$editmsg = "<small>(edited by $edit $nicewhen)</small>";
}
$supps = $row{"numsupports"};
$cl = "bgcolor=#cccccc";
$emai = $row{"email"};
$emai =~ s/@/ at /;
$emai =~ s/\./ dot /;
print "<tr><td $cl>Title</td><td><b>".$row{"title"}."</b></td></tr>\n";
print "<tr><td $cl valign=top>Name</td><td>".$row{"name"}." <<a
href=\"mailto:$emai\";>$emai</a>> $editmsg</td></tr>\n";
print "<tr><td $cl>Category</td><td>".$row{"category"}."</td></tr>\n";
print "<tr><td $cl>When</td><td>$nicedate</td></tr>\n";
print "<tr><td valign=top $cl>Text</td><td valign=top><i><font
size=+1>".$row{"idea"},
"</i></font></td></tr>\n";
$rem =$row{"remark"};
if($rem ne "") {
print "<tr><td valign=top $cl>Remark</td><td valign=top><b>$rem",
"</b></td></tr>\n";
}
if($supps>0) {
print "<tr><td $cl>Commented by</td><td>$supps persons";
if($support eq "") {
print " [<a href=\"display.cgi?id=$id&support=yes\">display
comments</a>]";
}
else {
print " [<a href=\"display.cgi?id=$id\">hide comments</a>]";
}
print "</td></tr>";
}
print "</table>\n";
print "</td></tr></table>\n";
print "<table><tr>\n";
print "<td><form action=\"support.cgi\" method=\"GET\">\n",
"<input type=submit name=comment value=\"I wanna comment this
suggestion!\">\n",
"<input type=hidden name=id value=\"$id\">\n",
"</form></td>\n";
print "<td><form action=\"remark.cgi\" method=\"GET\">\n",
"<input type=submit name=comment value=\"I'm the author, I'd like to ",
($rem eq ""?"add a ":"edit my"),
" remark!\">\n",
"<input type=hidden name=id value=\"$id\">\n",
"</form></td>\n";
print "</tr></table>\n";
#print "<tr><td $cl>Comment</td><td>\n",
# "<a href=\"support.cgi?id=$id\">I wanna comment this suggestion!</a>",
# "</td></tr>\n";
if(($support eq "yes") && $supps) {
if($start + $maxcommperpage >= $supps) {
$end = $supps;
}
else {
$end = $start + $maxcommperpage-1;
}
if($single ne "") {
$end = $start;
}
print "<h2>Comments</h2>\n",
"<p><b> $supps comments found</b>\n";
$addurl="id=$id&support=$support";
if($single) {
print "<a href=\"./display.cgi?$addurl\">view all</a>";
}
if( $supps > $maxcommperpage) {
my $pages = int($supps/$maxcommperpage);
$thispage = int($start/$maxcommperpage)+1; # 1 is the first page
if($supps % $maxcommperpage) {
$pages += 1;
}
print "<p> Goto page :";
$st = 1;
for(1 .. $pages) {
if($thispage == $_) {
# we display this page now
print "[$_] ";
}
else {
print "<a href=\"display.cgi?start=$st&$addurl\">[$_]</a> ";
}
$st += $maxcommperpage;
}
print "\n";
}
print "<table bgcolor=\"#000000\" cellspacing=2 cellpadding=2
border=0><tr><td>\n";
print "<table bgcolor=\"#ffffff\" cellspacing=0 cellpadding=2 border=0>\n";
for($start .. $end) {
$si = $_-1;
$num = $_;
$na = $row{"suppname$si"};
$na = " " if($na eq "");
$em = $row{"suppemail$si"};
$da = $row{"suppdate$si"};
$da = " " if($da eq "");
if($da =~ /^(\d\d\d\d)-(\d\d)-(\d\d)$/) {
$da = sprintf("%s %d, %d",
&MonthNameEng($2), $3, $1);
}
$co = $row{"suppcomment$si"};
$co = " " if($co eq "");
$cl = ($num&1)?"bgcolor=#ffffff":"bgcolor=#cccccc";
print "<tr $cl><td>$num</td><td>$na <<a
href=\"mailto:$em\";>$em</a>> posted $da (<a
href=\"display.cgi?id=$id&support=yes&start=$num&single=yes\">direct-link</a>)</td></tr>",
"<tr $cl><td valign=top>  </td><td><i>$co</i></td></tr>\n",
}
print "</table>\n";
print "</td></tr></table>\n";
}
$db->close();
print "<p><small><a href=\"edit.cgi?id=$id\">admin</a></small>\n";
Footer;
--- NEW FILE: fixsupp.cgi ---
#!/usr/bin/perl
require "CGI.pm";
require "pbase.pm";
require "date.pm";
use feedback;
Top();
Header("Correct A Comment");
$req = new CGI;
$id = $req->param('id');
$supp = $req->param('supp');
$db = new pbase;
$db->open("data/ideas");
%row=%{$db->get("id", $id)};
print <<SLUT
<p>
The form below is to be used to edit or delete a comment to a posted
suggestion.
<p>
SLUT
;
$supps = $row{"numsupports"};
if($supps) {
print "<table bgcolor=\"#000000\" cellspacing=2 cellpadding=2
border=0><tr><td>\n";
print "<table bgcolor=\"#ffffff\" cellspacing=0 cellpadding=2 border=0>\n";
for(1 .. $supps) {
$si = $_-1;
if($si == $supp) {
$na = $row{"suppname$si"};
$em = $row{"suppemail$si"};
$co = $row{"suppcomment$si"};
$cl = "bgcolor=#cccccc";
print "<form action=\"editcomm.cgi\" method=post>",
"<tr><td $cl valign=top>Name</td><td><input type=text name=name
value=\"$na\" size=50></td></tr>\n",
"<tr><td $cl valign=top>Email</td><td><input type=text name=email
value=\"$em\" size=50></td></tr>\n",
"<tr><td $cl>Comment</td><td><textarea name=comment rows=10
cols=60>$co</textarea></td></tr>\n",
"<tr><td $cl valign=top>Password</td><td><input type=password
name=passwd value=\"\"></td></tr>\n",
"<tr><td colspan=2 align=center><input type=submit name=save
value=\"save\"> \n",
"<input type=submit name=delete value=\"delete\"></td></tr>\n",
"<input type=hidden name=id value=\"$id\">",
"<input type=hidden name=supp value=\"$supp\">",
"</form>";
}
}
print "</table>\n";
print "</td></tr></table>\n";
}
$db->close();
print "<p><a href=\"display.cgi?id=$id\">display suggestion</a></small>\n";
Footer;
--- NEW FILE: list.cgi ---
#!/usr/bin/perl
require "CGI.pm";
require "pbase.pm";
require "date.pm";
use feedback;
Top();
&where("Feedback", "/feedback/", "List Suggestions");
Header("List Suggestions");
$ideasperpage = 25;
$req = new CGI;
$sort = $req->param('sort');
$sortword = $req->param('dir');
$pagesize = $req->param('page');
if($pagesize) {
$ideasperpage = $pagesize;
}
else {
# default entries per page
$ideasperpage = 25;
}
if($sort eq "") {
# set default, swapped date order
$sort = "modified";
$sortword="swap";
}
elsif($sort eq "supporters") {
$sort = "numsupports";
}
if($sortword eq "swap") {
$sortdir = "-";
}
else {
$sortdir = "";
}
$start=0+$req->param('start');
#$length=0+$req->param('length');
if($length == 0) {
$length = $ideasperpage; # default
}
$db = new pbase;
$db->open("data/ideas");
my @allf=$db->find_all("modified" => "^\$");
foreach $f (@allf) {
if(!$$f{'modified'}) {
$$f{'modified'} = $$f{'when'};
}
}
$db->sort($sortdir.$sort); # date-order
$amount = $db->size();
print <<STOPP
<p> Do you have an idea for improving curl, the tool, the lib, the docs or the
web site? Want to suggest a new feature or an improvement to an existing
one? Is there aditional documentation you\'d like to see? For complete
discussions and talks, <a href="http://curl.haxx.se/mail/";>join a mailing
list</a> and take it there!
<p>
This is the $amount suggestions submitted so far.
STOPP
;
if($amount == 0) {
print "<p> <b>There doesn't seem to exist <i>any</i> suggestion right
now!</b>";
}
else {
$thispage = int($start/$ideasperpage)+1; # 1 is the first page
$pages = int($amount/$ideasperpage);
if($amount > $ideasperpage) {
if($amount % $ideasperpage) {
$pages += 1;
}
print "<p> Goto page :";
$st = 0;
$addurl="sort=$sort&dir=$sortword&page=$ideasperpage";
#&length=$length";
for(1 .. $pages) {
if($thispage == $_) {
# we display this page now
print "<b>$_</b> ";
}
else {
print "<a href=\"list.cgi?start=$st&$addurl\">[$_]</a> ";
}
$st += $ideasperpage;
}
print "\n Page size: ";
foreach $page (25,50,75,100,500) {
if($page != $ideasperpage) {
$addurl="sort=$sort&dir=$sortword&page=$page";
#&length=$length";
print "<a href=\"list.cgi?start=$start&$addurl\">$page</a>
";
}
else {
print "$page ";
}
}
backwardsfowards();
}
$listit="list.cgi?page=$ideasperpage&";
print "<table cellspacing=0 cellpadding=2 border=0>\n";
print "<tr class=\"tabletop\">",
"<th><a href=\"${listit}sort=name\">Name</a>",
"</th>",
"<th><a href=\"${listit}sort=category\">Category</a>",
"</th>",
"<th><a href=\"${listit}\">Updated</a>",
"</th>",
"<th>Replies",
"</th>",
"<th><a href=\"${listit}sort=title\">Subject</a>",
"</th>",
"</tr>\n";
if($start + $length > $amount) {
$end = $amount;
}
else {
$end = $start + $length;
}
for ($i=$start;$i<$end; $i++) {
my %row=%{$db->get($i)};
$cl = ($i&1)?"even":"odd";
$when = $row{"modified"} || $row{"when"};
if($when =~ /(\d*)-(\d*)-(\d*)/) {
# $nicedate= &MonthNameEng($2)." ".$3.", ".$1;
$nicedate = sprintf("%.3s %d %d",
&MonthNameEng($2), $3, $1);
}
else {
$nicedate = $when;
}
$id = $row{"__id"};
$supps = 0 + $row{"numsupports"};
$emai = $row{"email"};
$emai =~ s/@/ at /;
$emai =~ s/\./ dot /;
print "<tr class=\"$cl\" valign=\"top\">\n",
"<td><a href=\"mailto:$emai\";>".$row{"name"}."</a></td>",
"<td>".$row{"category"}."</td>",
"<td nowrap>$nicedate</td>",
"<td align=\"center\">$supps</td>\n";
print "<td valign=\"top\" nowrap>",
"<a href=\"display.cgi?id=$id&support=yes\">";
$t= $row{"title"};
if(length($t) > 45) {
print substr($t, 0, 43)."...";
}
else {
if($t) {
print "$t";
}
else {
print "(no title)";
}
}
print "</a></td>\n";
print "</tr>"; # end of info-line
if($verbose) {
print "<tr bgcolor=\"$cl\">",
"<td> </td><td colspan=5><i><font size=+1>".$row{"idea"};
print "</i></font></td></tr>\n";
}
}
$db->close();
print "</table>\n";
}
backwardsfowards();
sub backwardsfowards {
print "<table width=\"100%\"><tr><td align=\"left\">\n";
$addurl="sort=$sort&dir=$sortword&page=$ideasperpage";
#&length=$length";
if($thispage > 1) {
$st = ($thispage -2)*$ideasperpage;
if($st < 0) {
$st = 0;
}
print "<a href=\"list.cgi?start=$st&$addurl\">[<= Previous
$ideasperpage Entries]</a> ";
}
else {
print " ";
}
printf "</td><td align=\"center\">%d - %d</td><td align=\"right\">\n",
($thispage-1) * $ideasperpage + 1,
($thispage * $ideasperpage);
if($thispage < $pages) {
$st = ($thispage ) * $ideasperpage;
if($st < $amount) {
print "<a href=\"list.cgi?start=$st&$addurl\">[Next
$ideasperpage Entries =>]</a> ";
}
}
print "</td></tr></table>\n";
}
Footer;
--- NEW FILE: addsupport.cgi ---
#!/usr/bin/perl
require "CGI.pm";
require "pbase.pm";
require "date.pm";
use feedback;
$req = new CGI;
$suppname = $req->param('name');
$suppemail = $req->param('email');
$comment = $req->param('comment');
$id = $req->param('id');
$now = sprintf("%04d-%02d-%02d", &ThisYear, &ThisMonth, &ThisDay);
# clean up possible user mess:
$comment = &cleantext($comment, 1);
$db = new pbase;
$db->open("data/ideas");
%row=%{$db->get("id", $id)};
$suppindex = 0+$row{"numsupports"};
$numsupports = 1 + $suppindex;
$row{"suppname$suppindex"}= "$suppname";
$row{"suppemail$suppindex"}= "$suppemail";
$row{"numsupports"} = "$numsupports";
$row{"suppdate$suppindex"}= "$now";
$row{"suppcomment$suppindex"}= "$comment";
$row{"modified"}="$now";
$db->change("id", "$id", %row);
$db->save();
print "Location: display.cgi?id=$id&support=yes\n\n";
--- NEW FILE: support.cgi ---
#!/usr/bin/perl
require "CGI.pm";
require "pbase.pm";
require "date.pm";
use feedback;
Top();
Header("Comment a Suggestion");
$req = new CGI;
$id = $req->param('id');
$db = new pbase;
$db->open("data/ideas");
%row=%{$db->get("id", $id)};
print <<SLUT
<p> This is a suggestion. You can comment this particular suggestion by adding
text in the form below. <b>Please</b> do not comment your own suggestions, it
effectively ruins this system.
<p>
Do <b>not</b> use HTML in the comment, it will get cut off anyway.
<p>
You will <b>not</b> be able to modify your comment once you've posted it. Be
polite and try to be constructive.
<p>
<h3>Suggestion You Are About To Comment</h3>
SLUT
;
print "<table bgcolor=\"#000000\" cellspacing=2 cellpadding=2
border=0><tr><td>\n";
print "<table bgcolor=\"#ffffff\" cellspacing=0 cellpadding=2 border=0>\n";
$when = $row{"when"};
if($when =~ /(\d*)-(\d*)-(\d*)/) {
$nicedate = sprintf("%s %d, %d",
&MonthNameEng($2), $3, $1);
}
else {
$nicedate = $when;
}
$cl = "bgcolor=#cccccc";
$rem =$row{"remark"};
print "<tr><td $cl>Title</td><td><b>".$row{"title"}."</b></td></tr>";
print "<tr><td $cl valign=top>Name</td><td>".$row{"name"}."
<<i>".$row{"email"}."</i>> $editmsg</td></tr>";
print "<tr><td $cl>Category</td><td>".$row{"category"}."</td></tr>";
print "<tr><td $cl>When</td><td>$nicedate</td></tr>";
print "<tr><td valign=top $cl>Text</td><td valign=top><i><font
size=+1>".$row{"idea"};
print "</i></font></td></tr>\n";
if($rem ne "") {
print "<tr><td valign=top $cl>Remark</td><td valign=top><b>$rem",
"</b></td></tr>\n";
}
$db->close();
print "</table>\n";
print "</td></tr></table>\n";
print <<EOD
<form action="addsupport.cgi" method="post">
<center>
<table bgcolor="#000000" cellspacing=2 cellpadding=2 border=0><tr><td>
<table bgcolor="#cccccc" cellspacing=0 cellpadding=3 border=0>
<tr><td>Name </td><td> <input type=text name=name value="" size=50></tr>
<tr><td>Email </td><td> <input type=text name=email value="" size=50></tr>
<tr><td colspan=2>Comment</td></tr>
<tr><td colspan=2>
<textarea name=comment rows=6 cols=60 wrap=virtual></textarea></td></tr>
<tr><td align=center colspan=2><input type=submit value="save"
name=submit></td></tr>
</table>
</td></tr></table>
</center>
<input type=hidden name=id value="$id">
</form>
EOD
;
Footer;
--- NEW FILE: date.pm ---
sub MonthLen {
$month = $_[0]; # month index (1-12)
local $year;
$year = $_[1]; # year to check (for leap)
while($month>12) {
$month-=12;
}
if($month<1) {
$month=1;
}
@mlens = (31,
28, # checked especially
31,
30,
31,
30,
31,
31,
30,
31,
30,
31);
if( $month eq 2) {
# February mean leap year troubles...
local $len = 28;
if( (int($year/4)*4 eq $year) &&
(!(int($year/100)*100 eq $year) ||
int($year/400)*400 eq $year)) {
$len = 29;
}
return $len;
}
else {
return $mlens[$month-1];
}
}
# Return the month name of the index given
sub MonthName {
my $num=$_[0];
my @mname = ('januari',
'februari',
'mars',
'april',
'maj',
'juni',
'juli',
'augusti',
'september',
'oktober',
'november',
'december' );
while( $num > 12 ) {
$num -= 12;
}
if ($num < 1) {
$num = 1;
}
return $mname[$num-1];
}
# Return the month name of the index given, in english
sub MonthNameEng {
my $num=$_[0];
my @mname = ('January',
'February',
'March',
'April',
'May',
'June',
'July',
'August',
'September',
'October',
'November',
'December' );
while( $num > 12 ) {
$num -= 12;
}
if ($num < 1) {
$num = 1;
}
return $mname[$num-1];
}
# Return the day name of the index given
sub DayName {
my $num=$_[0];
my @dname = ('måndag',
'tisdag',
'onsdag',
'torsdag',
'fredag',
'lördag',
'söndag');
while( $num > 7 ) {
$num -= 7;
}
if ($num < 1) {
$num = 1;
}
return $dname[$num-1];
}
# Return the english day name of the index given
sub DayNameEng {
my $num=$_[0];
my @dname = ('Monday',
'Tuesday',
'Wednesday',
'Thursday',
'Friday',
'Saturday',
'Sunday');
while( $num > 7 ) {
$num -= 7;
}
if ($num < 1) {
$num = 1;
}
return $dname[$num-1];
}
# Display a full range of all months as listview options
# The argument number sets the one to be selected
sub MonthOptions {
local $select = $_[0];
local $i;
local $result="";
for($i=1; $i<=12; $i++) {
my $name = MonthName($i);
if( $i == $select) {
$result=$result."<option value=".$i." SELECTED>$name\n";
}
else {
$result=$result."<option value=".$i.">$name\n";
}
}
return $result;
}
# Display a full range of all months as listview options
# The argument number sets the one to be selected
sub MonthOptionsEng {
local $select = $_[0];
local $i;
local $result="";
for($i=1; $i<=12; $i++) {
my $name = MonthNameEng($i);
if( $i == $select) {
$result=$result."<option value=".$i." SELECTED>$name\n";
}
else {
$result=$result."<option value=".$i.">$name\n";
}
}
return $result;
}
# Display a full range of all (supported) years as listview options
# The argument number sets the one to be selected
sub YearOptions {
local $select = $_[0];
local $i;
$result="";
for($i=0; $i<5; $i++) {
local $year = 1998 + $i;
if( $year == $select) {
$result=$result."<option SELECTED>$year\n";
}
else {
$result=$result."<option>$year\n";
}
}
return $result;
}
# Display a full range of all days as listview options
# The argument number sets the one to be selected
sub DayOptions {
local $select = $_[0];
local $i;
$result="";
for($i=1; $i<32; $i++) {
if( $i == $select) {
$result=$result."<option SELECTED>$i\n";
}
else {
$result=$result."<option>$i\n";
}
}
return $result;
}
sub ThisDay {
$time = time();
@thistime=localtime($time);
return $thistime[3];
}
sub ThisMonth {
$time = time();
@thistime=localtime($time);
return ++$thistime[4];
}
sub ThisYear {
$time = time();
@thistime=localtime($time);
return $thistime[5]+1900;
}
sub TodayNicely {
return &ThisDay." ".&MonthName(&ThisMonth)." ".&ThisYear;
}
sub TodayNicelyEng {
return &MonthNameEng(&ThisMonth)." ".&ThisDay." ".&ThisYear;
}
1;
--- NEW FILE: edit.cgi ---
#!/usr/bin/perl
require "CGI.pm";
require "pbase.pm";
require "date.pm";
use feedback;
Top();
Header("Edit suggestion");
$req = new CGI;
$id = $req->param('id');
$db = new pbase;
$db->open("data/ideas");
%row=%{$db->get("id", $id)};
print <<SLUT
<p> Using this form, a suggestion can be changed. It <b>requires</b> you to
know the edit password, so <i>if you're not the admin, forget about this!</i>
SLUT
;
$name=$row{"name"};
$email=$row{"email"};
$category=$row{"category"};
$idea=$row{"idea"};
$when=$row{"when"};
$title=$row{"title"};
$passwd=$row{"passwd"};
@allcats = &GetCategories;
for(@allcats) {
if($_ eq $category) {
$cats .= "<option selected>$_</option>";
}
else {
$cats .= "<option>$_</option>";
}
}
$rem=$row{"remark"};
if($rem ne "") {
$remtext=sprintf("<tr><td colspan=2>Remark</td></tr>%s%s",
"<tr><td colspan=2>",
"<textarea name=remark rows=10 cols=60 wrap=virtual>$rem</textarea></td></tr>");
}
print <<EOD
<form action="change.cgi" method="post">
<center>
<table bgcolor="#000000" cellspacing=2 cellpadding=2 border=0><tr><td>
<table bgcolor="#cccccc" cellspacing=0 cellpadding=3 border=0>
<tr><td>Name </td><td> <input type=text name=name value="$name"
size=50></tr>
<tr><td>Email </td><td> <input type=text name=email value="$email"
size=50></tr>
<tr><td>New passwd</td><td> <input type=text name=passwd value="" size=20></tr>
<tr><td>Category </td><td> <select name=category>$cats</select> </td></tr>
<tr><td>Title </td><td> <input type=text name=title value="$title"
size=50></tr>
<tr><td colspan=2>Suggestion</td></tr>
<tr><td colspan=2>
<textarea name=idea rows=10 cols=60 wrap=virtual>$idea</textarea></td></tr>
$remtext
<tr><td align=center colspan=2><input type=submit value="submit"
name=submit><input type=submit value="delete" name=delete></td></tr>
<tr><td>Edited by</td><td> <input type=text name=edit value=""></tr>
<tr><td>Password </td><td> <input type=password name=permit value=""></tr>
</table>
</td></tr></table>
</center>
<input type=hidden name=id value="$id">
<input type=hidden name=when value="$when">
</form>
EOD
;
print "<h3>Posted suggestion:</h3>\n";
print "<table bgcolor=\"#000000\" cellspacing=2 cellpadding=2
border=0><tr><td>\n";
print "<table bgcolor=\"#ffffff\" cellspacing=0 cellpadding=2 border=0>\n";
{
$cl = "bgcolor=#cccccc";
$when = $row{"when"};
if($when =~ /(\d*)-(\d*)-(\d*)/) {
$nicedate = sprintf("%s %d, %d",
&MonthNameEng($2), $3, $1);
}
else {
$nicedate = $when;
}
print "<tr><td $cl valign=top>Name</td><td>".$row{"name"}."
<<i>".$row{"email"}."</i>></td></tr>";
print "<tr><td $cl>Category</td><td>".$row{"category"}."</td></tr>";
print "<tr><td $cl>When</td><td>$nicedate</td></tr>";
print "<tr><td $cl>Title</td><td>".$row{"title"}."</td></tr>";
print "<tr><td valign=top $cl>Text</td><td valign=top><i><font
size=+1>".$row{"idea"};
print "</i></font></td></tr>\n";
}
$db->close();
print "</table>\n";
print "</td></tr></table>\n";
if($row{"numsupports"}) {
print "<p><small><a href=\"editsupp.cgi?id=$id\">edit support
comments</a></small>\n";
}
Footer;
--- NEW FILE: add.cgi ---
#!/usr/bin/perl
require "CGI.pm";
require "pbase.pm";
require "date.pm";
use feedback;
$req = new CGI;
$name = $req->param('name');
$email = $req->param('email');
$category = $req->param('category');
$idea = $req->param('idea');
$title = $req->param('title');
$passwd = $req->param('passwd');
$preview = $req->param('preview');
$cancel = $req->param('cancel');
if($cancel ne "") {
print "Location: ./\n\n";
exit;
}
$now = sprintf("%04d-%02d-%02d", &ThisYear, &ThisMonth, &ThisDay);
# Get versions of these fields that are non-offensive
$cleantitle = &cleantext($title, 0);
$cleanname = &cleantext($name, 0);
$cleanemail = $email;
$cleanidea = &cleantext($idea, 1);
if($preview ne "") {
Top();
# This is a preview-only!
Header("Suggestion Preview!");
print <<POO
<p>
This is how your entered suggestion will look like when posted for real!
<p>
The password field is there to allow you to add a remark to your suggestion
at a later time. The suggested password may be changed at will. <b>You will
not see it again, remember it!</b> You cannot change the suggestion after it
has been posted. Stay polite and focused.
<p>
POO
;
print "<table bgcolor=\"#000000\" cellspacing=2 cellpadding=2
border=0><tr><td>\n";
print "<table bgcolor=\"#ffffff\" cellspacing=0 cellpadding=2 border=0>\n";
$when = $now;
if($when =~ /^(\d\d\d\d)-(\d\d)-(\d\d)$/) {
$nicedate = sprintf("%s %d, %d",
&MonthNameEng($2), $3, $1);
}
else {
$nicedate = $when;
}
$cl = "bgcolor=#cccccc";
print "<tr><td $cl>Title</td><td><b>$cleantitle</b></td></tr>\n";
print "<tr><td $cl valign=top>Name</td><td>$name <<a
href=\"mailto:$cleanemail\";>$cleanemail</a>></td></tr>\n";
print "<tr><td $cl>Category</td><td>$category</td></tr>\n";
print "<tr><td $cl>When</td><td>$nicedate</td></tr>\n";
print "<tr><td valign=top $cl>Text</td><td valign=top><i><font
size=+1>$cleanidea</i></font></td></tr>\n";
print "</table>\n";
print "</td></tr></table>\n";
@allcats = &GetCategories;
for(@allcats) {
my $sel = ($_ eq $category)?" SELECTED":"";
$cats .= "<option$sel>$_</option>\n";
}
print <<ENTER
<p><b>Edit in your suggestion/idea:</b>
ENTER
;
&ShowInput;
print <<POO
<p>
You can still avoid posting this suggestion by simply follow another link away
from this page.
POO
;
Footer;
exit;
}
if(length($passwd) < 4) {
&Top();
&Header("bad password");
print "<p> I insist on getting a <b>longer</b> password.";
&Footer;
exit;
}
$db = new pbase;
$db->open("data/ideas");
$id = $db->add("name", "$cleanname",
"email", "$cleanemail",
"category", "$category",
"idea", "$cleanidea",
"title", "$cleantitle",
"when", "$now",
"modified", "$now",
"passwd", "$passwd");
$db->save();
print "Location: display.cgi?id=$id\n\n";
--- NEW FILE: remark.cgi ---
#!/usr/bin/perl
require "CGI.pm";
require "pbase.pm";
require "date.pm";
use feedback;
Top();
Header("Add a Remark to Your Suggestion");
$req = new CGI;
$id = $req->param('id');
$db = new pbase;
$db->open("data/ideas");
%row=%{$db->get("id", $id)};
print <<SLUT
<p> This must be your suggestion. You can add a remark to it, that will then
be visible next to the suggestion text in all suggestion displays. You can
and use this remark field to update your suggestion based on comments or on
new knowledge in the field.
<p> You cannot change the original suggestion text, and you must remember the
password to specified when you added the suggestion.
<p>
Do <b>not</b> use HTML in the comment, it will get cut off anyway.
<p>
<h3>Your Suggestion You Add A Remark For</h3>
SLUT
;
print "<table bgcolor=\"#000000\" cellspacing=2 cellpadding=2
border=0><tr><td>\n";
print "<table bgcolor=\"#ffffff\" cellspacing=0 cellpadding=2 border=0>\n";
$when = $row{"when"};
if($when =~ /(\d*)-(\d*)-(\d*)/) {
$nicedate = sprintf("%s %d, %d",
&MonthNameEng($2), $3, $1);
}
else {
$nicedate = $when;
}
$cl = "bgcolor=#cccccc";
print "<tr><td $cl valign=top>Name</td><td>".$row{"name"}."
<<i>".$row{"email"}."</i>> $editmsg</td></tr>";
print "<tr><td $cl>Category</td><td>".$row{"category"}."</td></tr>";
print "<tr><td $cl>When</td><td>$nicedate</td></tr>";
print "<tr><td valign=top $cl>Text</td><td valign=top><i><font
size=+1>".$row{"idea"};
print "</i></font></td></tr>\n";
$db->close();
print "</table>\n";
print "</td></tr></table>\n";
$rem=$row{"remark"};
print <<EOD
<form action="addremark.cgi" method="post">
<center>
<table bgcolor="#000000" cellspacing=2 cellpadding=2 border=0><tr><td>
<table bgcolor="#cccccc" cellspacing=0 cellpadding=3 border=0>
<tr><td>Password </td><td> <input type=password name=passwd value=""
size=10></tr>
<tr><td colspan=2>Remark</td></tr>
<tr><td colspan=2>
<textarea name=remark rows=6 cols=60 wrap=virtual>$rem</textarea></td></tr>
<tr><td align=center colspan=2><input type=submit value="save"
name=submit></td></tr>
</table>
</td></tr></table>
</center>
<input type=hidden name=id value="$id">
</form>
EOD
;
Footer;
--- NEW FILE: editcomm.cgi ---
#!/usr/bin/perl
require "CGI.pm";
require "pbase.pm";
require "date.pm";
use feedback;
$req = new CGI;
$supp = $req->param('supp');
$passwd = $req->param('passwd');
$id = $req->param('id');
$delete = $req->param('delete');
$save = $req->param('save');
if($adminpasswd ne $passwd) {
&Header("bad password");
print "<p> I insist on getting the actual password.";
&Footer;
exit;
}
$db = new pbase;
$db->open("data/ideas");
%row=%{$db->get("id", $id)};
if($delete ne "") {
$nums = $row{"numsupports"}-1;
for($i=$supp; $i<nums; $i++) {
$j=$i+1;
$row{"suppname$i"}= $row{"suppname$j"};
$row{"suppemail$i"}= $row{"suppemail$j"};
$row{"suppdate$i"}= $row{"suppdate$j"};
$row{"suppcomment$i"}= $row{"suppcomment$j"};
}
$row{"numsupports"}=$nums;
}
else {
$i=$supp;
$row{"suppname$i"}=$req->param('name');
$row{"suppemail$i"}= $req->param('email');
$row{"suppcomment$i"}= $req->param('comment');
if($row{"suppdate$i"} eq "") {
$row{"suppdate$i"}=
sprintf("%04d-%02d-%02d", &ThisYear, &ThisMonth, &ThisDay);
}
}
$db->change("id", "$id", %row);
$db->save();
print "Location: editsupp.cgi?id=$id\n\n";
--- NEW FILE: addentry.cgi ---
#!/usr/bin/perl
use feedback;
Top();
&where("Feedback", "/feedback/", "Add Suggestion");
Header("Post A Suggestion");
print <<POO
<p> Feel free to submit a suggestion or an idea about what you think should be
improved, added, changed, fixed or corrected... Do not use this form to file
<a href="/bugreport.html">bug reports</a>.
<p>
<b>HTML is not allowed</b> in the suggestion text! Tags will become visible.
<p>
The password field is there to allow you to add a remark to your suggestion
at a later time. The suggested password may be changed at will. <b>You will
not see it again, remember it!</b> You cannot change the suggestion after it
has been posted. Stay polite and focused.
POO
;
@words1 = ('a','e','o','u','y','i','u');
@words2 = ('b','c','d','f','g','k','l','m','t','q','r','s');
$passwd = sprintf("%s%s%s%s%s%d",
$words2[rand()*$#words2],
$words1[rand()*$#words1],
$words2[rand()*$#words2],
$words2[rand()*$#words2],
$words1[rand($#words1+1)],
rand(100));
@allcats = &GetCategories;
for(@allcats) {
$cats .= "<option>$_</option>";
}
print <<ENTER
<p><b>Fill in your suggestion/idea:</b>
ENTER
;
&ShowInput;
Footer;
--- NEW FILE: change.cgi ---
#!/usr/bin/perl
require "CGI.pm";
require "pbase.pm";
require "date.pm";
use feedback;
$req = new CGI;
$name = $req->param('name');
$email = $req->param('email');
$category = $req->param('category');
$idea = $req->param('idea');
$remark = $req->param('remark');
$when = $req->param('when');
$title = $req->param('title');
$id = $req->param('id');
$edit = $req->param('edit');
$delete = $req->param('delete');
$passwd = $req->param('passwd'); # suggestion-specific password
$permit = $req->param('permit');
if($adminpasswd ne $permit) {
&Header("bad password");
print "<p> I insist on getting the actual password.";
&Footer;
exit;
}
if($delete ne "") {
#delete this entry!
$db = new pbase;
$db->open("data/ideas");
$db->delete("id", $id);
$db->save();
print "Location: list.cgi\n\n";
exit;
}
$now = sprintf("%04d-%02d-%02d", &ThisYear, &ThisMonth, &ThisDay);
$db = new pbase;
$db->open("data/ideas");
%row=%{$db->get("id", $id)};
$row{"name"}= "$name";
$row{"email"}= "$email";
$row{"category"}= "$category";
$row{"idea"}= "$idea";
$row{"remark"}= "$remark";
$row{"edit"}= "$edit";
$row{"editdate"}= "$now";
$row{"when"}= "$when";
$row{"title"}= "$title";
if($passwd ne "") {
$row{"passwd"}=$passwd;
}
$db->change("id", "$id", %row);
$db->save();
print "Location: display.cgi?id=$id\n\n";
_______________________________________________
http://cool.haxx.se/mailman/listinfo/curl-www-commits
|
