#!/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. .............................................#
#...................................................................#

#   I'm your dream, make you real
#   I'm your eyes   when you must steal
#   I'm your pain   when you can't feel
#   sad but true
#...................	Metallica, "Sad But True"

#...................................................................#
# File name: view.cgi -  viewer for weblog's dynamic pages..........#
#...................................................................#

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', '$autolink',
'$qhtml', '$fozzy', '$txt_news';
#....Load Libraries 
eval { 
require "admin/cfg.cfg";
require "$dir/Sanitarium_WL.pm";
};
#....If not Libraries
if ($@){
	print "Content-type: text/html\n\n";
	print "ERROR including libraries: $@";
	exit;
	}
#flock() option:
$Sanitarium_WL::USE_FLOCK=$use_flock;
$Sanitarium_WL::USE_FLOCK||=0;

#....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{'terms'}){&search;}
elsif(($in{'add'}||$in{'preview'}||$in{'post'})){&add;}
elsif($in{'goto'}){&go_to;}
elsif($in{'mail'}){&mail_to_me;}
elsif ($in{'id'}&&$in{'cat_id'}){
	if ($in{'print'}){&print_page;}
	elsif($in{'page'}){&view_page;}
	else{&not_found;}
}
elsif ($in{'cat_id'}&&$in{'jump'}){&jump;}
elsif ($in{'cat_id'}){&view_index;}
else {&not_found;}
#end sub
}	

sub view_page {
#---------------------------------------------
if (-e "$data/$in{'cat_id'}/$in{'id'}.dat"){
	my $html;
	my $obj=new Sanitarium_WL("$data/$in{'cat_id'}", 'index');
	my %art=$obj->get_data($in{'id'});
	if ($art{'status'} ne 'ok'){&not_found;}
	$obj=0;
	
	$obj=new Sanitarium_WL("$data/categories", 'categories');
	%art=$obj->get_data($in{'cat_id'});
	$obj=0;
	
	&load_cfg('', '',$art{'template'});
	$html = ($builder->build_article($in{'id'},$in{'cat_id'},$in{'page'}));#||&not_found;
	$|++;
	&print_header;
	print $html;
	
}	
else {&not_found;}
#end sub
}	

sub go_to {
#--------------------------------------------------
my ($obj, $goto, %art);
$obj=new Sanitarium_WL("$data/index", 'index');
%art=$obj->check_and_get($in{'goto'});
$obj=0;
unless (%art){&not_found;}
if ($art{'status'} ne 'ok'){&not_found;}
if ($static_pages){$goto="$public_url/$art{'cat_id'}/$in{'goto'}"."_1.$ext";}
else {$goto="$view_cgi_url?cat_id=$art{'cat_id'}&id=$in{'goto'}&page=1";}
print "Location: $goto \n\n";
}	

sub print_page {
#---------------------------------------------
my $option=shift;
$option||='print';
if (-e "$data/$in{'cat_id'}/$in{'id'}.dat"){
	my $html;
	my $obj=new Sanitarium_WL("$data/$in{'cat_id'}", 'index');
	my %art=$obj->get_data($in{'id'});
	if ($art{'status'} ne 'ok'){&not_found;}
	$obj=0;
	$obj=new Sanitarium_WL("$data/categories", 'categories');
	%art=$obj->get_data($in{'cat_id'});
	$obj=0;

	&load_cfg('', '',$art{'template'});
	#$id, $cat, $page_view, $print
	$html =$builder->build_article($in{'id'},$in{'cat_id'},$in{$option},$option);
	$html||&not_found;
	if ($option eq 'mail'){return $html;}
	$|++;
	&print_header;
	#print $html;
	print $html;
	
}	
else {&not_found;}
#end sub
}

sub mail_to_me {
#---------------------------------------------
my ($obj, $tmpl, %art);
unless($in{'to'}&&$in{'from'}&&$in{'name'}&&$in{'cat_id'}){
	$in{'mail'}||=1;
	$obj=new Sanitarium_WL("$data/index", 'index');
	%art=$obj->check_and_get($in{'id'});
	$obj=0;
	unless (%art){&not_found;}
	if ($art{'status'} ne 'ok'){&not_found;}
	open(MAILFORM, "<$tmpl_dir/tmp-main/mailform.txt")||&WLerr("Can not open $tmpl_dir/tmp-main/mailform.txt, reason: $!");
	if ($use_flock){flock(MAILFORM, 1);}
	while(<MAILFORM>){$tmpl .=$_;}
	close MAILFORM;
	$tmpl=~ s/<%cat_id%>/$art{'cat_id'}/g;
	$tmpl=~ s/<%id%>/$in{'id'}/g;
	$tmpl=~ s/<%page%>/$in{'mail'}/g;
	$tmpl=~ s/<%title%>/$art{'title'}/g;
	$tmpl=~ s/<%view_cgi_url%>/$view_cgi_url/g;
	$|++;
	&print_header;
	print $tmpl;
}
else {
	foreach my $m ($in{'to'}, $in{'from'}){
		unless ($m=~/(?:^|\s)[-\w]+@[-\w]+(?:\.[-\w]+)*?\.\w{2,4}(?:$|\s)/){
			&print_header;
			print qq~<center><h2>Error!</h2></center> Check input fields!<br><a href="javascript: history.back()"><b>Back</b></a>~;
			exit;
		}
	}
$in{'mail'}=$in{'page'};
&send_mail($in{'to'}, $in{'from'}, &print_page('mail'), $in{'name'});
&print_header;
print qq~<h3>OK! Article emailed!</h3>
	<b>To:</b> $in{'to'}<br>
	<b>From:</b> $in{'from'}
~;	
}
}		

sub send_mail {
#----------------------------------------------	
my ($to, $from, $data, $name)=@_;
my $subj="$name emailing article to you!";
open (MAIL,"| $SEND_MAIL -t");
    print MAIL "To: $to\n";
    print MAIL "From: $from\n";
    print MAIL "Reply-to: $from\n";
    print MAIL "X-Mailer: Sanitarium WebLoG (WebScript.Ru Network)\n";
    print MAIL "Content-Type: TEXT/HTML; charset=\"windows-1251\"\n";
    print MAIL "Subject: $subj\n\n";
    print MAIL "$data";
    print MAIL "\n.\n";

}

sub add {
#--------------------------------------------
my $tmpl;
if (!($in{'post'}||$in{'preview'})){
	open(ADDFORM, "<$tmpl_dir/tmp-main/addform.txt")||&WLerr("Can not open $tmpl_dir/tmp-main/addform.txt, reason: $!");
         if ($use_flock){flock(ADDFORM, 1);}
	 while(<ADDFORM>){$tmpl .=$_;}
	 close ADDFORM;
	 $tmpl=~ s/<%view_cgi_url%>/$view_cgi_url/g;
	 print "Content-Type: text/html\n\n";
	 print $tmpl;
}
else {
 unless ($in{'name'}&&$in{'mail'}&&$in{'article'}&&$in{'title'}){
 	if ($in{'preview'}){ &WLerr("Не заполнены все требуемые поля!");} 	
 	else { &WLerr("Не заполнены все требуемые поля: <a href=\"javascript: history.back()\"><b>Вернуться Назад</b></a>");}
 }
 unless ($in{'mail'} =~ /(?:^|\s)[-\w]+@[-\w]+(?:\.[-\w]+)*?\.\w{2,4}(?:$|\s)/){
  	&WLerr("Wrong e-mail adress! <font color=red><b>$in{'mail'}</b>"); 
 }
 $tmpl = qq~
 <HTML><HEAD>
<TITLE>Новая Статья</TITLE>
<META http-equiv=Content-Type content="text/html; charset=windows-1251">
<STYLE TYPE="text/css">
body {color:#000000;
	background-color:#FFFFFF;
       font-family: Verdana, Arial, "sans-serif"; 
       font-size:10pt;}
</STYLE>       
</HEAD>
<BODY link="#0000EE" alink="#FF0000" vlink="#551A8B" text="#000000" bgcolor="#ffffff">
 ~;
 $tmpl .= $in{'title'}. '<br>';
 $tmpl .= 'Автор: '.$in{'name'}. '<br>';
 $tmpl .= 'E-mail:'. $in{'mail'}. '<br>';
 $tmpl .= 'WWW: ';
 $tmpl .= $in{'www'}? $in{'www'}: 'не указан';
 $tmpl .= '<br>'.'Портрет/Аватар :';
 $tmpl .= $in{'foto'}? $in{'foto'} : 'не указан';
 $tmpl .= '<p><b>Статья:</b><br>'.$in{'article'};
 $tmpl .='<p><b>Пожелания Автора:</b><br>';
 $tmpl .= $in{'note'}? $in{'note'} : 'нет';
 
 if ($in{'post'}){
	&send_mail($admin_mail, $in{'mail'}, $tmpl, $in{'name'});
	$tmpl .='<h3>Спасибо! Статья отправлена!</h3>';
 }
&print_header;
print $tmpl;
}	
exit; 
}


sub view_index {
#---------------------------------------------
my $cat_url;
my $index=$in{'cat_id'};
$in{'page'}||=1;
if (-e "$data/$index.dat"){
	my $obj= new Sanitarium_WL("$data/$index", 'index');
	my @ids= sort {$b<=>$a} $obj->get_keys();
	$obj=0;
	
	my $end=($entry_per_page*$in{'page'}-1);
	my $start=($entry_per_page*($in{'page'}-1))||0;
	if ($index eq 'index'){$cat_url=$index_url;}
	else {$cat_url=$public_url."/$in{'cat_id'}";}
	
	&load_cfg($in{'cat_id'}, $cat_url,'', $in{'page'});
	my $html=$builder->build_index(($#ids+1),@ids[$start..$end]);
	undef @ids;
	$|++;
	&print_header;
	print $html;
}
else {&not_found;}
#end sub
}	

sub jump {
#--------------------------------------------
my $go_to;
if ($in{'cat_id'} eq 'index'){$go_to=$index_url;}
	else {$go_to=$public_url."/$in{'cat_id'}/$index_page";}
print "Location: $go_to\n\n";
#end sub
}


######################### SEARCHING ##########################

sub search {
#-----------------------------------
unless($use_search){&not_found;}
$in{'page'}||=1;
my @terms=&index_text($in{'terms'});
my $next=$ENV{'QUERY_STRING'};
$next=~s/&page=\d+//;

my $obj= new Sanitarium_WL("$data/search", '');
my @result=$obj->search(@terms);
$obj=0;
my %relevant=();
foreach my $answ(@result){
	my @ids=split(/;/, $answ);
		foreach my $id(@ids){
			my ($key, $val)=split(/,/,$id);
			if (defined $key){
				if (exists $relevant{$key}){$relevant{$key}+=($val+15);}
				else{$relevant{$key}=$val;}
			}	
		}
}
undef @terms;
my @ids=sort {$relevant{$b}<=>$relevant{$a}} keys %relevant;
undef %relevant;
unless (@ids){&not_found}
my $start=(($entry_per_page*($in{'page'}-1))||0);
if ($start>=($#ids)){$start=0;}
my $end=$start+$entry_per_page-1;
if ($end>($#ids)){$end=$#ids;}
&load_cfg('search', '','tmp-main', $in{'page'});
my $how_results=($#ids+1);
my @id_res;
if ($start<$end){@id_res=@ids[$start..$end];}
else {@id_res = @ids;}
undef @ids;
my $html=$builder->build_index_search($next,$how_results,@id_res);

	$|++;
	&print_header;
	print $html;
			
#
}	

sub index_text {
#------------------------------------
my $page=shift;

# RUSSIANS, WARNING! 
# @word_ends and @stop_words in win-1251 encoding!!
# if you work in koi8-r, then you must translate @word_ends and @stop_words into koi8-r
my @word_ends= qw/ies ила ыми ому или ить ему ого in gеть ала ими али ять ать его \-то ое ит ую ой ия ка ки ке ые ят оё ed ен ый ою ет от ьи ть ом ам ым es ал ют ие ья ий ут ил им ин ь ю ая я ы а е и о ё s/;
my @stop_words= qw/сейчас тепер друг нужн пот конечн поэт можн снов мог сам них тем там чем очен это что так когд кажд кто всег лиш был нет have by есл вас ваш вам даж над инач здес нескольк мо год not will you there and по\-мо all вес with моч говор are бы would the наш один can any was скаж как сказ from или эта about котор буд that больш зна for which вон соб but тольк вот what one they this одн/;

# BIG RUSSIAN LETTERS \xC0-\xDF\xA8 (xA8 - Ё)
# small russian letters \xE0-\xFF\xB8' (xB8 - ё)

$page=~s/<[^>]+>/ /g;#Strip ALL HTML Tags
$page=~s/&[\w]+;//g;#Strip ALL HTMLs like &lt;
$page=~tr/A-Z\xC0-\xDF\xA8/a-z\xE0-\xFF\xB8/;#BIG to small

map{$page=~s/$_[^a-z\xE0-\xFF\xB8]/ /g if length($_)>3} @word_ends;#Delete word ends
map($page=~s/[^a-z\xE0-\xFF\xB8]$_[^a-z\xE0-\xFF\xB8]/ /g, @stop_words);#Delete stop words
$page=~s/([-a-z\xE0-\xFF\xB8])\1+/$1/g;#Delete double symbols
my(@words) = split(/[^-a-z\d\xE0-\xFF\xB8]+/, $page);#Delete non alphabetic symbols and splite to array
undef $page;
@words=grep{length > 2} @words;#Delete all words from 1 or 2 symbols
my %count=();
#  Now shorting words
foreach (@words){
	if(length==5){s/.$//;} 
	elsif(length==6||length==7){s/..$//;}
	elsif(length==8||length==9){s/...$//;}
	elsif(length>9){s/....$//;}
	$count{$_}++;
}
return keys %count;
}	
	
sub not_found {
#--------------------------------------------
print "Location: $not_found\n\n";
exit;
#end sub
}	

sub load_cfg {
#----------------------------------------------
my ($cat_id, $cat_url, $template, $page)=@_;
$cat_id||='';
$cat_url||='';
$template||='';
$page||=0;

#GLOBAL:
$builder= new Sanitarium_WL;
$builder->load_cfg( $site_title,
                    $public_url,
                    $index_page,
                    $ext,
                    $index_url,
                    $entry_per_page,
                    $static_pages,
                    $data,
                    $tmpl_dir,
                    $public_dir,
                    $view_cgi_url,
                    $comment_url,
                    $how_news,
                    $txt_news,
                    $foto_url,
                    $cat_id,
                    $cat_url,
                    $template,
                    $page);
#end sub
}

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

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;
}