#!/usr/bin/perl -w
##.......................................................................#
# Sanitarium WebLoG: web publish system.................................#
# Author: Green Kakadu (WebScript.Ru Network) ..........................#
# Email: gnezdo@webscript.ru ...........................................#
# WWW: http://webscript.ru .............................................#
# Copyright 2002 WebScript.Ru Network ( http://webscript.ru )...........#
# All Rights Reserved. .................................................#
#.......................................................................#

#    never cared for what they do
#    never cared for what they know
#    but I know
#...................	Metallica, "Nothing Else Matters"

#.................................................................................#
# File name: comment.cgi - Sanitarium WebLoG comment system.......................#
#.................................................................................#


use strict;
use CGI::Carp qw(fatalsToBrowser);
use vars '$time_view','$script_admin', '$ext', '$img_url', '$tmpl_dir', '$data', '$public_dir', '$use_emoticons', '$public_url', '$use_flock', '$dir', '%msg', '%in', '$builder',
'$index_url', '$index_page', '$entry_per_page', '$static_pages', '$view_cgi_url', '$site_title', '$how_news', '$use_search', '$not_found', '$foto_url',
'$premoderate', '$send_new_comments', '$admin_mail', '$SEND_MAIL', '$comadmin_cgi_url', '$comment_url', '$mail_cgi_url', '$coms_per_page', '$foto_dir', '$img_dir', '$GMT', '$upload_url', '$validate_db', '$autolink',
'$qhtml', '$fozzy', '$txt_news', '$new_to_top';
#....Load Libraries 
eval { 
require "admin/cfg.cfg";
require "$dir/Sanitarium_WL.pm";
require "$dir/Comment_WL.pm";
require "$dir/lang.pl";
};
#....If not Libraries
if ($@){
	print "Content-type: text/html\n\n";
	print "ERROR including libraries: $@";
	exit;
	}
	
#flock() options:
$Sanitarium_WL::USE_FLOCK=$use_flock;
$Sanitarium_WL::USE_FLOCK||=0;
$Comment_WL::USE_FLOCK=$use_flock;	
$Comment_WL::USE_FLOCK||=0;	

#Comments Type View
$new_to_top=1;
#If $new_to_top=1; then fresh comments publish in the top of all comments
# Classic View: $new_to_top=0; oldest comment put to the top

#Validate DB (if premoderate on):
$validate_db="$data/comments/new_comments.txt";


#....RUN main subrouting

eval {
&main
};
#....If Errors
if ($@){ 
&WLerr("Error: $@");
}
exit;


sub main {
#--------------------------------------------------------------
if ($ENV{'REQUEST_METHOD'}){%in=&parse_form;}
else {&not_found;}
#
if ($in{'id'}&&$in{'post'}){&post;}
elsif ($in{'id'}){&view;}
else {&not_found;}
}	



sub view {
#--------------------------------------------------------------
my ($obj, $from, $to, $how, $how_pages, $tmpl, @coms,  %com_parse, %for_parse);

$in{'page'}||=1;

#Get Article Info:
$obj= new Sanitarium_WL("$data/index", 'index');
%for_parse=$obj->get_data($in{'id'});
$obj=0;
&print_header;

#Get Category Info:
$obj= new Sanitarium_WL("$data/categories", 'categories');
%com_parse = $obj->get_data($for_parse{'cat_id'});
$obj=0;
foreach my $key (keys %com_parse){
	$for_parse{$key}=$com_parse{$key};
}
undef %com_parse;	
#Build Comments Index:

	
if ($for_parse{'status'} ne 'ok'){&not_found;}

$for_parse{'id'}=$in{'id'};
$for_parse{'cat_id'}=$in{'cat_id'};
$for_parse{'page'}=$in{'page'};
$for_parse{'cat_url'}=$public_url."/$in{'cat_id'}/$index_page";
#<%article_url%>
if ($static_pages){	$for_parse{'article_url'}=$public_url."/$in{'cat_id'}/$in{'id'}"."_1.$ext";}
else {	$for_parse{'article_url'}=$view_cgi_url."?goto=$in{'id'}";}	
$for_parse{'comment_script'}=$comment_url;
$for_parse{'drop_list'}=&load_template("$data/$for_parse{'template'}-drop_list.txt");
$for_parse{'menu_html'}=&load_template("$data/$for_parse{'template'}-menu.txt");

if (-e "$data/comments/$in{'id'}.txt"){
	#Load Comment Template:
	$tmpl=&load_template("$tmpl_dir/$for_parse{'template'}/comment.txt");
	$obj= new Comment_WL("$data/comments/$in{'id'}.txt");
	@coms = $obj->get_me_recs;
	if ($new_to_top){@coms = reverse(@coms) if @coms;}
	
#___PREMODERATE:	
	if ($premoderate){	
		#foreach my $com (@coms){
		#	if ($com=~/^\d+\|ok\|/){push(@temp, $com);}
		#}
		
		@coms=grep(/^\d+\|ok\|/, @coms);
		#undef @temp;	
	}
#___END PREMODERATE	
	if (@coms){	
		$how=$#coms;
		$from=$coms_per_page*($in{'page'}-1);
		$to=$from+$coms_per_page-1;
		if ($from>$how){$from=0;}
		if ($to>$how){$to=$how;}
		#How Pages:
		++$how;
		$how_pages = int ($how/$coms_per_page);
		++$how_pages unless (($how_pages*$coms_per_page) == $how);
		#Generate span pages:
		for (my $i=1; $i<=$how_pages; $i++){
			if ($in{'page'}==$i){$for_parse{'span_pages'} .= qq~<font class="span"> $i </font>~;}
			else {$for_parse{'span_pages'} .= qq~
			<a href="$comment_url?id=$in{'id'}&page=$i" class="span"> $i </a>
			~;}
		}	
		#Parsing each comment:
		foreach my $com (@coms[$from..$to]){
			%com_parse=$obj->unpack_to_hash($com);
			$for_parse{'comments'} .=&parse($tmpl, \%com_parse);
		}
		undef @coms;
		$obj=0;
	}
	else {
	$for_parse{'comments'}='';
	}#if NOT (@coms)			
}
else {$for_parse{'comments'}='';}#if NOT premoderate
$for_parse{'span_pages'}||='<b>1</b>';
#Main Parse
$tmpl=&parse_include(&load_template("$tmpl_dir/$for_parse{'template'}/view_comments.txt"));

my $html = &parse($tmpl, \%for_parse);
#Print Page:
$|++;
print $html;
} 

sub post {
#-----------------------------------------------------
my ($obj, $status, $id, $html, %rec, %art, %title);
unless($in{'author'}&&(length($in{'author'})<30)){$in{'author'}='Unknown';}

if (($in{'mail'}=~/(^|\s)([-\w]+@(?:[-\w\.]+)+\.\w{2,4})(?:$|\s)/)&&(length($in{'mail'})<50)){$in{'mail'}=$2;}
else {$in{'mail'}='';}
if (($in{'www'}=~/(^|\s)(http:\/\/)?((?:[-\w\.]+)+\.\w{2,4})(?:$|\s)/)&&(length($in{'www'})<50)){$in{'www'}='http://'.$3;}
else {$in{'www'}='';}
my $date=&get_time;

$in{'post'} =~ s/</\&lt;/g;
$in{'post'} =~ s/>/\&gt;/g;
$in{'post'} =~ s/"/\&quot;/g;
$in{'post'}=~s/\r//g;
$in{'post'}=~s/\n\n+/<p>/g;
$in{'post'}=~s/\n/<br>/g;
$in{'post'}=~s/\s+/ /g;
$in{'post'} =~ s/\[(i|I)\]/<i>/g;
$in{'post'} =~ s/\[\\(i|I)\]/<\/i>/g;
$in{'post'} =~ s/\[(b|B)\]/<b>/g;
$in{'post'} =~ s/\[\/(b|B)\]/<\/b>/g;
$in{'post'} =~ s/\[(([qQ](uot|UOT|uot)[eE]?)|([cC](ite|ITE)))\]/<div class="quot">/g;
$in{'post'} =~ s/\[\/(([qQ](uot|UOT|uot)[eE]?)|([cC](ite|ITE)))\]/<\/div>/g;
#$in{'post'} =~ s/[^"=]\s((http|ftp):\/\/(\S+))/<a href="$1" target=_blank> $3 <\/a>/g;
$in{'post'} =~ s/(\S{50})/$1<br> /g;
if ($use_emoticons){
	$in{'post'} =~ s/\s\Q:)\E\s/ \<img src=$img_url\/smile\.gif width=15 height=15 alt=":)"\> /g;
	$in{'post'} =~ s/\s\Q:-)\E\s/ \<img src=$img_url\/smile\.gif width=15 height=15 alt=":-)"\> /g;
	$in{'post'} =~ s/\s\Q:-(\E\s/ \<img src=$img_url\/sad.gif width=15 height=15 alt=":-("\> /g;
	$in{'post'} =~ s/\s\Q:(\E\s/ \<img src=$img_url\/sad.gif width=15 height=15 alt=":("\> /g;
	$in{'post'} =~ s/\s\Q8)\E\s/ \<img src=$img_url\/cool.gif width=15 height=15 alt="8)"\> /g;
}

$id=time();
$id .=sprintf("%d",rand 100);

if ($premoderate){$status='validate';}
else {$status='ok';}
# ID|status|title|article_url|name|mail|www|ip|date|content|admin_answer|art_id|cat_id

%rec=('id'=>$id,
      'status'=>$status,
      'title'=>$in{'title'},
      'article_url'=>$in{'article_url'},
      'name'=>$in{'author'},
      'mail'=>$in{'mail'},
      'www'=>$in{'www'},
      'ip'=>($ENV{'REMOTE_ADDR'}||'undefined'),
      'date'=>$date,
      'content'=>$in{'post'},
      'admin_answer'=>'',
      'art_id'=>$in{'id'},
      'cat_id'=>$in{'cat_id'},);

$obj=new Comment_WL("$data/comments/$in{'id'}.txt");
$obj->add_new(%rec);
$obj=0;

$obj=new Comment_WL("$data/comments/142.txt");
$obj->add_new(%rec);
$obj=0;

$obj=new Comment_WL("$data/comments/142.txt");
unless ($in{'id'}=142){
$obj->add_new(%rec);}
$obj=0;

$obj= new Sanitarium_WL("$data/index", 'index');
%art=$obj->get_data($in{'id'});
$obj=0;
if ($static_pages){$art{'url'}="$public_url/$art{'cat_id'}/$in{'id'}".'_1'.".$ext";}
else {$art{'url'}="$view_cgi_url?cat_id=$art{'cat_id'}&id=$in{'id'}&page=1";}
#Make Report:
$html = qq~
<li> <b>$msg{'Title'}:</b><a href="$art{'url'}" target=_blank>$art{'title'}</a>
<p>
<b>$msg{'comment'}:</b><br>
<li> <b>id:</b> $rec{'id'}
<li> <b>$msg{'Author'}:</b> $rec{'name'}
<li> <b>e-mail:</b> $rec{'mail'}
<li> <b>www:</b> $rec{'www'}
<li> <b>ip:</b> $rec{'ip'}
<li> <b>date:</b> $rec{'date'}
<p>$rec{'content'}
~;
if ($premoderate){
	$html=~s/\r|\n//g;
	open(NEWCOM, ">>$validate_db")||&WLerr("Can not open $validate_db, reason: $!");
	if ($use_flock){flock(NEWCOM, 2) or &WLerr("Can not flock VALIDATE DATABASE, reason: $!");}
	print NEWCOM "$in{'id'}|$rec{'id'}|$html\n";
	close NEWCOM;
}
#Email about new comment to admin!
if ($send_new_comments){
	&send_mail($admin_mail,'new comment post!', 
	 qq~ 
	 <html><head><title>Sanitarium WebLoG</title>
	 $msg{'charset'}
	 </head><body>$html</body></html>
	 ~);
}	 	

my $go_to="http://spasem-shkolu.p-rossii.ru/cgi/comments.cgi?id=142&cat_id=3";

#Now, redirect viSitor:
print "Location: $go_to \n\n";
}

sub send_mail {
#----------------------------------------------------
my ($to, $subj, $content, $bcc);
$to=shift;
$subj=shift;
$content=shift;
$content=~s/^\./\.\./g;
$content=~s/\r|(\n+)/\n/g;
open (MAIL,"|$SEND_MAIL -t -oi");
    print MAIL "To: $to\n";
    print MAIL "From: $admin_mail\n";
    print MAIL "Reply-to: $admin_mail\n";
    print MAIL "X-Mailer: Sanitarium WebLoG (WebScript.Ru Network)\n";
    print MAIL "Content-Type: TEXT/HTML; charset=$msg{'mail_charset'}\n";
    print MAIL "Subject: $subj\n\n";
    print MAIL "$content";
    print MAIL "\n.\n";
close(MAIL);
}	

sub parse_include {
#-----------------------------------------------------
my $template=shift;
my %include=();
while ($template =~/(<%include=([-\w\.]+)%>)/g){
		 my $tag=$1;
		 my $file='';
		 if (exists $include{$2}){$file=$include{$2};}
		 else {
	 		$file=&load_template("$tmpl_dir/include/$2");
	 		$include{$2}=$file;
		 } 
	 	$template =~ s/$tag/$file/;
	}
return $template;	
}

sub parse {
#-----------------------------------------------------
my $template=shift;
my $vals=shift;
foreach my $tag(keys %{$vals}){
	$template=~s/<%$tag%>/$vals->{$tag}/g;
}
$template=~s/<%\w+%>//g;
return $template;
}

sub load_template {
#-----------------------------------------------------
my $src=shift;
my $templ;	
open('TMPL', "<$src")||&WLerr("Can't open $src, reason: $!");
if ($use_flock){flock(TMPL, 1);}
while(<TMPL>){
$templ .=$_;
}
close(TMPL)||&WLerr("Can't close $src, reason: $!");
return $templ;
}	
	

######################## UTILITES ############################
sub print_header {
#--------------------------------------------------------------	
print "Content-type: text/html\n";
print "Pragma: no-cache\n\n";
}

sub get_time {
#-------------------------------------------------------------
my $time=shift;
$time||=time();
if ($GMT){$time +=$GMT*3600;}
my(@MON)= split(/,/, $msg{'MON'});
my(@WDAY) = split(/,/, $msg{'WDAY'}); 

my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time);
$year += 1900;
if ($time_view == 1){ return sprintf("%02d/%02d/%04d",$mday,($mon+1),$year);}# dd/mm/yyyy
elsif ($time_view == 2){ return sprintf("%02d %s %04d", $mday,$MON[$mon],$year);}# dd MON yyyy
elsif ($time_view == 3){return sprintf("%s, %02d %s. %04d",$WDAY[$wday],$mday,$MON[$mon],$year);}#WEEKDAY DAY MON yyyy
elsif ($time_view == 4){return sprintf("%s, %02d %s %04d %02d:%02d:%02d",$WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec);}#WDAY DAY MON yyyy hour:min:sec
elsif ($time_view == 5){return sprintf("%02d.%02d.%04d",$mday,($mon+1),$year);}#dd.mm.yyyy
elsif ($time_view == 6){return sprintf("%02d.%02d.%04d",($mon+1),$mday,$year);}#mm.dd.yyyy
else {return sprintf("%02d/%02d/%04d",($mon+1),$mday,$year);}#mm/dd/yyyy
}	


sub parse_form {
#--------------------------------------------------------------
my ($buffer, $val, $key, $line_parse, @parse, %parse_data);

if ($ENV{'REQUEST_METHOD'} eq 'GET') {
	@parse = split(/&/, $ENV{'QUERY_STRING'});
    }
elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
        read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
        @parse = split(/&/, $buffer);
    }
else {&WLerr("This cant access (Telnet/SHH?)!");}
foreach $line_parse(@parse) {
$line_parse =~ tr/+/ /;
($key, $val) = split(/=/, $line_parse);
$key =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
if (defined($parse_data{$key})){$parse_data{$key} .= ",$val";}
else {$parse_data{$key} = $val;}
}
return %parse_data;
}



sub WLerr {
#--------------------------------------------------------------
&print_header;
print @_;
exit;
}

sub not_found {
#--------------------------------------------
print "Location: $not_found\n\n";
exit;
#end sub
}