% use Text::Wrap qw($columns wrap);
% use Data::Dumper;
% unless( ($new && ($valsi || $natlangword)) || ($respond && $comment) ) {
Couldn't locate what you wanted to post in regards to
Either jbovlaste generated an invalid URL for you to follow, or you're trying
to fiddle around with things you ought not be messing with! Either way, please
report this page's URL.
% $titlestr = "Couldn't locate what you wanted to post in regards to";
% return;
% }
<%perl>
# keep things clean for quoting.
sub fmtcomment {
my $cmt = shift;
my ($out, @lines);
$columns = 75;
$out = "";
@lines = split(/\r?\n/, $cmt);
foreach my $line (@lines) {
$out .= wrap("", "", $line) . "\n";
}
$out;
}
%perl>
% unless( defined($session{'username'}) ) {
Not logged in
I'm afraid you'll need to log in in order to post.
% $titlestr = "Not logged in";
% return;
% }
% if($new) {
% if(!defined($content)) {
<%perl>
my $table = $valsi?"valsi":"natlangwords";
my $column = $valsi?"valsiid":"wordid";
my $query = $dbh->prepare("SELECT * FROM $table WHERE $column = ?");
$query->execute($valsi?$valsi:$natlangword);
my $wordtypestr = $valsi?"valsi":"natural language word";
my $theword = $query->fetchrow_hashref->{'word'};
$titlestr = sprintf('New post for %s "%s"',$wordtypestr, $theword);
%perl>
New Post
For <% $wordtypestr %> "<% $theword %>"
% } else {
%if((length($subject)<=0) || (length($comment)<=0)) {
You've got to write something
Sorry, you'll need to actually post something before I can let it through.
% $titlestr = "Must actually write something";
% return;
%}
<%perl>
$dbh->begin_work;
$dbh->do("LOCK TABLE threads IN ACCESS EXCLUSIVE MODE");
my $threadquery = $dbh->prepare("SELECT * FROM threads WHERE valsiid=? AND natlangwordid=? AND definitionId=?");
$threadquery->execute($valsi,$natlangword,$definition);
my $threadrow = $threadquery->fetchrow_hashref;
$threadquery->finish;
if(!defined($threadrow)) {
$dbh->do("INSERT INTO threads (valsiid, natlangwordid, definitionId ) VALUES (?,?,?)",
undef,
$valsi, $natlangword, $definition);
$threadquery->execute($valsi, $natlangword, $definition);
$threadrow = $threadquery->fetchrow_hashref;
if(!defined($threadrow)) {
$m->out("Something is really broken!");
return;
}
}
$content = fmtcomment($content);
my $commentNum = $dbh->selectrow_array("SELECT max(commentNum) + 1 FROM comments
WHERE threadid=$threadrow->{'threadid'}\n");
if (! defined($commentNum))
{
$commentNum=1
}
$dbh->do(
"INSERT INTO comments (threadid, parentid, userid, time, subject,
content, commentNum) VALUES (?, ?, ?, ?, ?, ?, ?)",
undef,
$threadrow->{'threadid'}, 0, $session{'userid'},
time(), $subject, $content, $commentNum );
$dbh->commit;
$titlestr = "Post received";
%perl>
Post received
I think I submitted your comment. You probably ought to check.
<%perl>
$m->out("Click ".
"here to get back to the thread.
\n\n");
# Here we send e-mail to the person who entered the word, if this is
# a per-definition comment.
if( $definition )
{
my $email = $dbh->selectrow_array("SELECT u.email FROM
definitions d, users u WHERE d.userid = u.userid AND d.definitionid=$definition");
my $valsiwordword = $dbh->selectrow_array("SELECT word FROM valsi WHERE valsiid=$valsi");
my $natlangwordword = $dbh->selectrow_array("SELECT word FROM natlangwords WHERE wordid=$natlangword");
my $word = $valsiwordword ? $valsiwordword : $natlangwordword;
utils::sendemail( [ $email ], "Comment Response At Word $word", "
A jbovlaste thread you have commented in has had a reply added!
Please go to
to see the thread.
Thank you.
-The jbovlaste Admin Team
", $session{'username'} );
}
%perl>
% }
% return;
% }
% if($respond && $comment>0) {
% if(!defined($content)) {
<%perl>
# Acquire comment we're responding to
my $commentquery = $dbh->prepare("SELECT *
FROM convenientthreads t, convenientcomments c
WHERE t.threadid=c.threadid AND c.commentid=?");
$commentquery->execute($comment);
$comment = $commentquery->fetchrow_hashref;
my($wordtypestr,$theword);
if($comment->{'valsiid'}>0) {
$wordtypestr = "valsi";
$theword = $comment->{'valsi'};
} else {
$wordtypestr = "natural language word";
$theword = $comment->{'natlangword'};
}
$titlestr = sprintf('Responding to "%s"', $comment->{'subject'});
%perl>
Responding to: "<% $comment->{'subject'} %>"
In thread for <% $wordtypestr %> "<% $theword %>"
<%perl>
$comment->{'content'} =~ s/^/> /mg;
$comment->{'content'} =~ s/$//mg;
$comment->{'content'} = sprintf("%s wrote:\n",$comment->{'username'}).$comment->{'content'}."\n\n";
$comment->{'subject'} = "Re: ".$comment->{'subject'} unless $comment->{'subject'} =~ /Re:/;
%perl>
% } else {
<%perl>
$content = fmtcomment($content);
my $commentNum = $dbh->selectrow_array("SELECT max(commentNum) + 1 FROM
comments WHERE threadid=(SELECT threadid FROM comments WHERE
commentid=$comment)\n");
if (! defined($commentNum))
{
$commentNum=1
}
$dbh->do("INSERT INTO comments (threadid, parentid, userid, time,
subject, content, commentNum)
VALUES ( (SELECT threadid FROM comments WHERE commentid=?), ?, ?, ?, ?, ?, ?)",
undef,
$comment, $comment, $session{'userid'}, time(), $subject, $content,
$commentNum);
$titlestr = "Post received";
%perl>
Post received
I think I submitted your comment. You probably ought to check.
<%perl>
$m->out("Click ".
"here to get back to the thread.
\n\n");
# Here we send mail.
my $emails = $dbh->selectall_arrayref( "SELECT DISTINCT u.email from users u,
comments c WHERE u.userid = c.userid AND c.threadid = (SELECT threadid FROM
comments WHERE commentid=$comment)" );
my $selfemail = $dbh->selectrow_array("SELECT email FROM users WHERE userid=$session{'userid'}");
foreach my $email (@{$emails})
{
my $valsiwordword = $dbh->selectrow_array("SELECT word FROM valsi WHERE valsiid=$valsi");
my $natlangwordword = $dbh->selectrow_array("SELECT word FROM natlangwords WHERE wordid=$natlangword");
my $word = $valsiwordword ? $valsiwordword : $natlangwordword;
if( @{$email}[0] eq $selfemail )
{
next;
}
utils::sendemail( [ @{$email}[0] ], "Comment Response At Word $word", "
A jbovlaste thread you have commented in has had a reply added!
Please go to
to see the thread.
Thank you.
-The jbovlaste Admin Team
", $session{'username'} );
}
%perl>
% }
% return;
% }
% $titlestr = "Magical Bug!";
You've found a magical bug! Please report whatever you did.
<%init>
our($dbh,%session);
%init>
<%args>
$new => 0
$respond => 0
$comment => 0
$valsi => 0
$natlangword => 0
$subject => undef
$content => undef
$definition => 0
%args>
<%shared>
our $titlestr;
%shared>
<%method title>
<% $titlestr %>
%method>