parse.pl
#!/usr/local/bin/perl
# ปรับปรุง 6 สิงหาคม 2545
# Version สำหรับ lovelampang.com และเปิดให้คนลำปางนำไปใช้ได้
############################################################
# เพื่อนำ 10 กะทู้ล่าสุดไปแสดง
# <iframe src=http://www.thaiall.com/lovelampang/board/board10.pl height="205" width="500" marginwidth="0" marginheight="0" vspace="0" hspace="0" frameborder="0"></iframe>
# เพิ่มข่าว หรือแสดงความเห็น
# <a href=http://www.lovelampang.com/board>http://www.lovelampang.com/board</a>
############################################################
&parse_form;
# ต้องตรวจสอบว่า ค่า $ENV ของท่านเป็นอะไร แต่ละเครื่องไม่เหมือนกันครับ
# เพราะถูกเรียกจากหลายโปรแกรม จึงต้องเลือกทำงานให้ถูก กับวัตถุประสงค์
if (($ENV{'SCRIPT_FILENAME'} eq "/home/lovelampang/board/parse.pl") && ($ENV{'REQUEST_URI'} eq "/lovelampang/board/" || substr($ENV{'REQUEST_URI'},0,31) eq "/lovelampang/board/boardlist.pl" || substr($ENV{'REQUEST_URI'},0,29) eq "/lovelampang/board/index.html")) {
print "Content-type:text/html\n\n";
foreach $rt (sort keys(%xrtxt)) {
$xrt = substr($rt,2,4);
print "<option value=$xrt ";
if ($v{'r'} eq $xrt) { print "selected"; }
print ">$rtxt{$xrt}\n";
}
}
sub header{
$f = "header.htm";
open(f,$f); print <f>; close(f);
}
sub headers{
$f = "headers.htm";
open(f,$f); print <f>; close(f);
}
sub footer{
$f = "footer.htm";
open(f,$f); print <f>; close(f);
}
sub parse_form {
%xrtxt = (
'01rynk','กระดานข่าวลำปาง',
'02rkeh','กระดานบันทึกเว็บมาสเตอร์',
'03rcyl','รวมกะทู้แจ้งลบ'
);
foreach $rt (sort keys(%xrtxt)) {
$xrt = substr($rt,2,4);
$rtxt{$xrt} = $xrtxt{$rt};
}
if ($ENV{'REQUEST_METHOD'} eq 'GET') {
@pairs = split(/&/, $ENV{'QUERY_STRING'});
} elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $buffer);
}
foreach $pair (@pairs) {
local($name, $value) = split(/=/, $pair);
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$xvalue = $value;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
if ($name eq "subj" || $name eq "xsubj" || $name eq "email" || $name eq "xemail" ) {
$value =~ s/:/|/g;
$value =~ s/</</g;
$value =~ s/>/>/g;
}
$value =~ s/,/,/g;
$v{$name} = $value;
if ($name eq "message") { $v{'xmessage'} = $xvalue; }
if ($name eq "email") { $v{'xemail'} = $xvalue; }
if ($name eq "subj") { $v{'xsubj'} = $xvalue; }
# if ($name eq "title") { $v{'title'} =~ s/|/5/g; }
}
# change or add room in
# parse.pl header.htm boardlist.pl del.htm
if (length($v{'r'}) eq 3) {
$rtmp = join '',"r",$v{'r'};
if (length($rtxt{$rtmp}) > 5) {
$v{'r'} = join "","r",$v{'r'};
} else {
$v{'r'} = "rynk";
}
} else {
if (length($rtxt{$v{'r'}}) > 5) {
# value ok
} else {
$v{'r'} = "rynk";
}
}
}
sub checklength {
if (length($v{'email'}) > 40 || length($v{'email'}) < 5) { &breakerror('E-Mail too long or too short'); }
if (length($v{'subj'}) > 300 || length($v{'subj'}) < 5) { &breakerror('Subject too long or too short'); }
if (length($v{'message'}) > 40000 || length($v{'message'}) < 5) { &breakerror('Message too long or too short'); }
if (length($v{'title'}) > 200 ) { &breakerror('Title too long'); }
if (length($v{'icq'}) > 10) { &breakerror('ICQ too long'); }
# @msg = split(/\n/,$v{'message'});
@msg = split(/%0D%0A/,$v{'message'});
$msgnew ="";
foreach $m (@msg){
$m =~ tr/+/ /;
$m =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$ml = length($m);
$maxch = 300;
if ($ml > $maxch) {
$mdiv = ($ml - ($ml % $maxch)) / $maxch;
for $i (0..$mdiv){
$msgnew = join "\n",$msgnew,substr($m,$i*$maxch,$maxch);
}
} else {
$msgnew = join "\n",$msgnew,$m;
}
}
$v{'message'} = $msgnew;
}
sub breakerror {
print @_;
&footer;
exit;
}
1; |