Гостевая книга для вашего сайта

[code]

package Firebook;

# Размещать в папке cgi-bin/Firebook

BEGIN {

use Exporter;

use CGI;

use File::stat;

use Time::Local;

use DB_File;

use Time::HiRes;

@ISA = qw(Exporter);

$VERSION=2.01;

@EXPORT = qw(@MIST);

}

return 1;

END{}

###################################

sub mySub{

my ($par)=@_;

# Подпрограмма пользователя.

# Запускается при размещении в HTML-файле строки

#<!--#mySub(d)-->

# где d=$par любое число-параметр

return

}

##################################

sub PageList{

my ($step,$max)=@_;

my $par;

if($main::q->param('img')){return};

my $page=$main::q->param('page');

my $npage= $step? int $max/$step : 0;

if($main::q->param('arh')){$par='arh=1;'};

if($max < $step){return};

if(!$main::main{TextStart}){$main::main{TextStart}="В начало"};

print "<p><a href=\'$main::main{Exe}\'>$main::main{TextStart}</a> ";

for($i=0;$i <= $npage;$i++){

my $p=$i+1;

      if($i == $page && $page ){print "<font size='+2' color='#ff0000'>$p</font> "}else{print "<a href=\'$main::main{Exe}?page=$i;$par\'>$p</a> "};

};

if($main::DOP ==11){print "$step $max"};

}

#################################################

sub print_file{

my ($par,$file,$Forma,$nomer,$noprint)=@_;

if($par eq 'file'){

      if(!-e $file){ print "<p align=center><font color='#ff0000'> Файла не существует </font>";return}

      my ($FS,$FE,$FS0,$E0,$textarea);

      my $asis=1;

      $FS0=$Forma;

      $FE0=$Forma;

      #      my $FE=$Forma;

      $FS0=~s/\$H\{post\}.*//s;

      $FE0=~s/^.*?\$H\{post\}//s;             

      if($FE0 eq $FS0){$FE0=""};

#print "<p>$file";            

my $edit_yes;

my $NOM;

      open FILE, "<$file";

      my $n;

      my ($post,$comm,$printPrivat,%Head,$strhead,%FirstHead,$firsthead,$nhead);

      while (<FILE>){

            my $str=$_;

            warning($str,"print_file($file)");

            my ($headPost,$endPost,$commPost);

#            $str=~s/\n/<p>/g;

            $n++;      

            if($str =~/^(\[code\])\r?$/){

                  $code=1;

                  $str=~s/\[code\]/<div style='background-color: white;width:80%;font-family:time;font-size:x-small;'><p align=right>\[code\]<\/p>/;

#                  style='overflow: auto; background-color: white; height: 400; width: 80%'

                  print $str;

                  next;

                  }

            if($str =~/^(\[\/code\])\r?$/){$code=0;$str=~s/\[\/code\]/<p align=right><b>code<\/b><\/div>/;next}

            if($code){

                  $str=~s/&/&#38;/g;

                  $str=~s/</&lt;/g;

                  $str=~s/>/&gt;/g;

                  $str=~s/\t/&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;/g;

                  #if( length $str >100){$str=~s/^(\S{100})/$1<br>/};

                  if($main::main{NomCode}){

                  print "<p>$NOM:&nbsp;$str";

                                    }else{

                                          print "<p>$str";

                                    }                                    

                  $NOM++;

                  next;

                  }

#            if($str =~/<textarea .*?>/){$textarea=1;print $str;next}

#            if($str=~/<\/textarea>/){$textarea=0;print $str;next}

#            if($textarea){print $str;next}

            if($str =~/(<\!--start.*?-->)/){

                  $asis="";

                  $headPost=1;

                  if($post==1){

                  # Не закрыт предыдущий пост, отсутствует строка <td width="2%"> <tr><td colspan="3"> <p> <tr><td colspan="3"> <p> </table> <br>             

                        my $end=$FE;

                        $end=~s/\$H\{(.*?)\}/$Head{$1}/g;

                        print $end; # Исправляем, закрываем пост

                  };

            my $z=$1;

            %Head=();

            $printPrivat=0;

            $FE=$FE0;

            $FS=$FS0;

            %Head=str_head($z,$file);

            if(!$firsthead){

                   %FirstHead=%Head;

                   $firsthead=1;

             };

            if($Head{vis} eq 'vip'){$FS=~s/class="PostSq"/class="GreenSq"/};

            if($Head{vis} =~ /^\w{2}\d+/ && $Head{vis} !~/-\d/){$FS=~s/class="PostSq"/class="PinkSq"/};

            if($Head{vis} =~ /-2/ && $main::DOP>1){$FS=~s/class="PostSq"/class="YellowSq"/};

            if($Head{vis} =~ /-1/ && $main::DOP>1){$FS=~s/class="PostSq"/class="YellowSq"/};

            if($Head{vis} =~/-(1|2)/ && $main::DOP >=4){      

             if($Head{vis}=~/^-2$/){$Head{admininfo}=~s/<\/font>/<b> <font style='color:#ff0000;font-size:11;'>Информационное для Админа<\/font> <\/b><\/font>$Head{vis}/}

             elsif($Head{vis}=~/^-1$/){$Head{admininfo}=~s/<\/font>/<b> <font style='color:#ff0000;font-size:11;'>Сообщение заблокировано<\/font> <\/b><\/font>$Head{vis}/}

             else{$Head{admininfo}=~s/<\/font>/<\/font> <font style='color:#ff0000;font-size:11;'><b>Заблокировано системой:<\/b><\/font>$Head{vis}/};

             $Head{nomer}="";

                   };            

            if($main::main{Blocks} =~/$Head{user}/){      $Head{admininfo}=~s/<\/font>/<b> &#9824 <\/b><\/font>/};

            $z=~s/([\(\)\[\]\*\?\!\{\}\+\/\\])/\\$1/g;

            $str=~s/$z/$FS/;

            $str=~s/\$H\{(.*?)\}/$Head{$1}/g;

            $post=1;

            $nhead++;

            };

            if($str =~/(<\!--comment.*?-->)/ && !exists $Head{headcomm}){

                  my $z=$1;

                  my %H=str_head($z,$file);

                  $z=~s/([\(\)\[\]\*\?\!\{\}\+\/\\])/\\$1/g;

                  $str=~s/$z/$H{headcomm}/;

                  $commPost=1;

            };

            if($str =~/(<\!--end=.*?-->)/){

                  $str=~s/$1/$FE/;

                  if($nhead >1){$Head{edit}="";$Head{delete}="";};

                  $str=~s/\$H\{(.*?)\}/$Head{$1}/g;

                  $post=0;

                  $endPost=1;

            };

            if( $Head{vis} =~ /^([A-Z]{2}\d+)/){

             if($main::USER ne $1){

                   if($main::USER ne $Head{user} ){

                        if(!$printPrivat){

                              if($Head{vis} !~/-\d/){

                               print "<p><font color='#808080'><i><b>Только для $Head{nikcom}</font></b></i>";

                                                              };

                              if($main::DOP >=4 && $nhead==1){

                                    print "&nbsp;(<font color='#FF9999'><b><i>$Head{nik}</i></b></font>)&nbsp;

                                    <a href=\'$main::main{Exe}?delete=$Head{file};\'>delete</a>"

                                    };

                               if($main::DOP >=5 && $nhead==1){print "&nbsp;<a href=\'$main::main{Exe}?edit=$Head{file};\'>Master</a>"};

                              $printPrivat=1;

                              $post=0;

                              next;

                              }

                              $post=0;

                              next;

                         }}};

#            print "<p>vis=$Head{vis};Friends=$main::main{Friends};USER=$main::USER; DOP=$main::DOP;";

            if( $Head{vis} =~ /vip/ && $main::main{Friends} !~/$main::USER/ && $main::DOP <5 ){      $post=0;      next};

            if( $Head{vis} =~ /^-1/ && $main::DOP <5 && $Head{user} ne $main::USER){      $post=0;                        next};

            if( $Head{vis} =~ /^-2/ && $main::DOP <5 ){      $post=0;                                                                  next};

            if( $main::main{Blocks} =~/$Head{user}/ && $Head{user} ne $main::USER && $main::DOP <5){$post=0;      next};

            if($post && !$FE && $strhead){      $post=0;                                                                                               next};

            my $print;

            if($Head{text} eq 'html'){$print='asis'}; # Если есть параметр text=html , то печатаем "как есть"

            if($noprint){$print='noprint'};

            if($main::main{Print}){

            # Гостевая - каталог

            # Если в установках есть параметр Print=catalog,1; то в общем потоке

            # показываются только заголовки сообщений юсерам, у кого допуск меньше или равен числу после запятой.

                        if($main::PATH =~ /index\.html/){

                        my $print=$main::main{Print};

                        my @P=split /,/,$print;

                        if(!$P[1]){$P[1]=1}; # если допуск не указан, то принимается 1

                        if(!$headPost && !$endPost && !$commPost){

                   if($P[0] eq 'catalog' && $main::DOP <= $P[1] ){next};

                                     }

                         }

                   }

            ($str,$comm)=print_text($str,$comm,$print);

            $strhead++;

            };

if($post==1){

            # Не закрыт пост                              

            my $end=$FE;

            $end=~s/\$H\{(.*?)\}/$Head{$1}/g;

            print $end;            

};            

      close FILE;

return (%FirstHead);

};

}

###############################

[/code]