Документ взят из кэша поисковой машины. Адрес оригинального документа : http://www.kosmofizika.ru/includes/forum/newmessage.msn
Дата изменения: Mon Oct 31 10:41:00 2005
Дата индексирования: Tue Oct 2 02:26:01 2012
Кодировка: koi8-r
% if ($id) {
<& /includes/forum/showmessage.msn,
tree=>$tree,
resource_table=>$resource_table,
id=>$id,
title=>'Reply to message',
width=>$width
&>
% }
% if ($err_form==1 || !defined $NEWMESSAGE_SUBMIT) {
>


% if ($id) {

% }

>



% if ($err_form==1) {

% }






Your message
Some errors are found! Please retype
 Your name:
 Your e-Mail:
 Subject:
Input your message:



% }
<%PERL>
else {
my $last_res_id=DB_functions::get_max_id($dbh,$resource_table,'id');
$author =~ s/ $author =~ s/>/>/g;
$email =~ s/ $email =~ s/>/>/g;
$subj =~ s/ $subj =~ s/>/>/g;
$body =~ s/ $body =~ s/>/>/g;
if (!$dbh->do("INSERT INTO $resource_table (id,author,email,subj,body) VALUES ($last_res_id,
" .
$dbh->quote($author) . "," .
$dbh->quote($email) . "," .
$dbh->quote($subj) . "," .
$dbh->quote($body) . ");"
))
{
$m->out("Error: " . $dbh->errstr . "
");
return -1;
}
my $last_id=DB_functions::get_max_id($dbh,$tree,'id');
my $parent = ($id>0)?$id:0;
if (!$dbh->do("INSERT INTO $tree (id,parent,resource) VALUES (
$last_id," .
$parent . "," .
$last_res_id . ");"
))
{
$m->out("Error: " . $dbh->errstr . "
");
return -1;
} else {
$m->out("Message sent
\n");
}

$m->cache(
action=>'store',
key=>"message.$unique",
value=>1,
expire_in=>'30min'
);
}
return 0;


<%INIT>
my $cols=72;
my $ua = $r->header_in('User-Agent');
$cols=50 if ($ua =~ /Mozilla/ && $ua !~ /MSIE/);

my $r_author;
my $r_email;
my $r_subj;
my $r_body;
my $r_time="ВРЕМЯ";

# check if form has been already sent
if (defined $unique) {
my $is_sent = $m->cache(
action=>'retrieve',
key=>"message.$unique");
return -1 if $is_sent;
} else {
$unique = rand(1E6) if !defined $unique;
}


return -1 if (defined $id && $id !~ /^\d+$/);
return -1 if ($tree !~ /^tree_\w+$/);

use DB_functions;
my $dbh=$m->comp('/includes/dbcon.msn');
return -1 unless $dbh;

my $err_form=0;
if (defined $NEWMESSAGE_SUBMIT) {
$err_form=1 if (!defined $author || !$author);
$err_form=1 if (!defined $subj || !$subj);
$err_form=1 if (!defined $body || !$body);
$err_form=1 if (!defined $email ||
! ($email =~ /^[\w\.\-]+\@[\w+\.\-]+\w\w\w?$/ || $email eq '') );
} else {
if ($id) {
my $sth = $dbh->prepare("SELECT * FROM $tree WHERE id=$id");
if (! $sth) {
$m->out("Error: " . $dbh->errstr . "
");
return;
}
if (! $sth->execute()) {
$m->out("Error: " . $dbh->errstr . "
");
return;
}
if(my $ref = $sth->fetchrow_hashref ) {
my $sth1 = $dbh->prepare("SELECT * FROM $resource_table WHERE id=".$ref->{resource});
if (! $sth1) {
$m->out("Error: " . $dbh->errstr . "
");
return -1;
}
if (! $sth1->execute()) {
$m->out("Error: " . $dbh->errstr . "
");
return -1;
}
if (my $ref1 = $sth1->fetchrow_hashref) {
$r_author = $ref1->{author} if (defined $ref1->{author});
$r_email = $ref1->{email} if (defined $ref1->{email});
$r_subj = $ref1->{subj} if (defined $ref1->{subj});
$r_body = $ref1->{body} if (defined $ref1->{body});
} else {
$sth1->finish;
$m->out("Внутренняя ошибка #1 форума! Пожалуйста напишите об этом в группу поддержки
");
return -1;
}
$sth1->finish;
} else {
$sth->finish;
$m->out("Внутренняя ошибка #2 форума! Пожалуйста напишите об этом в группу поддержки
");
return -1;
}
$sth->finish;
$subj = ($r_subj =~ /^Re:/)?$r_subj:('Re: '.$r_subj);
}
}


<%ARGS>
$tree
$resource_table
$unique => undef
$id => 0
$author => undef
$email => undef
$subj => undef
$body => undef
$action => undef
$NEWMESSAGE_SUBMIT => undef
$width => undef


<%DOC>
$tree - tree to add message
$resource_table - resource table to add message
$unique - unique identifier of user who tries to add message to forum
(unique is used to unsure that user send only one request on adding form data to SQL,
and refresh button will not do a bad job of flooding forum with identical messages)

$id - id of message in tree, if user is replying
$author - author field
$email - email field
$subj - subj field
$body - body field
$action - script to POST form
$NEWMESSAGE_SUBMIT - submit button
$width - width of form