#!/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 {¬_found;} # if ($in{'id'}&&$in{'post'}){&post;} elsif ($in{'id'}){&view;} else {¬_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'){¬_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~ $i ~;} else {$for_parse{'span_pages'} .= qq~ $i ~;} } #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'}||='1'; #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//\>/g; $in{'post'} =~ s/"/\"/g; $in{'post'}=~s/\r//g; $in{'post'}=~s/\n\n+/

/g; $in{'post'}=~s/\n/
/g; $in{'post'}=~s/\s+/ /g; $in{'post'} =~ s/\[(i|I)\]//g; $in{'post'} =~ s/\[\\(i|I)\]/<\/i>/g; $in{'post'} =~ s/\[(b|B)\]//g; $in{'post'} =~ s/\[\/(b|B)\]/<\/b>/g; $in{'post'} =~ s/\[(([qQ](uot|UOT|uot)[eE]?)|([cC](ite|ITE)))\]/

/g; $in{'post'} =~ s/\[\/(([qQ](uot|UOT|uot)[eE]?)|([cC](ite|ITE)))\]/<\/div>/g; $in{'post'} =~ s/[^"=]\s((http|ftp):\/\/(\S+))/ $3 <\/a>/g; if ($use_emoticons){ $in{'post'} =~ s/\s\Q:)\E\s/ \:) /g; $in{'post'} =~ s/\s\Q:-)\E\s/ \:-) /g; $in{'post'} =~ s/\s\Q:-(\E\s/ \:-( /g; $in{'post'} =~ s/\s\Q:(\E\s/ \:( /g; $in{'post'} =~ s/\s\Q8)\E\s/ \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/27.txt"); $obj->add_new(%rec); $obj=0; $obj=new Comment_WL("$data/comments/27.txt"); unless ($in{'id'}=27){ $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~
  • $msg{'Title'}:$art{'title'}

    $msg{'comment'}:

  • id: $rec{'id'}
  • $msg{'Author'}: $rec{'name'}
  • e-mail: $rec{'mail'}
  • www: $rec{'www'}
  • ip: $rec{'ip'}
  • date: $rec{'date'}

    $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~ Sanitarium WebLoG $msg{'charset'} $html ~); } my $go_to="$comment_url?id=$in{'id'}&cat_id=$art{'cat_id'}"; #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(){ $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 }