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;