Форум программистов [Powered by Invision Power Board]

Код

use CGI qw(:standard);
use DBI;
use Compress::Zlib;
use Fcntl qw(:flock);
 
$|=1;


#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
sub get_lock {
my $name=shift || 'default';
open($name, ">$name.sem") ;
flock($name,LOCK_EX) || "Cant block the file $name:$!";
} 
sub relase_lock {
$name=shift || 'default';
close($name);
}
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
sub quit
{
my $url = $ENV{'SCRIPT_NAME'};
my $erorr="$DBI::errstr <br>\n";

  get_lock('litlelog.txt');
   open(AD ,">>litlelog.txt") || die "open file error";
   
   print AD "$url\n";
   print AD @_,"\n" if @_;
   print AD "$erorr\n";
   
   close(AD);
   relase_lock('litlelog.txt');
 }
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
sub db_connect
{
$dbh = DBI->connect("DBI:mysql:ddd:localhost","ddd","ddd") || die "ccc";
    return $dbh;
}
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
sub block_write  
{
my($word)=@_;
my $abnbanner;
$abnbanner=<<PAGE_HERE;  
<body background=../../img/color0.gif>
<table width=120 border=0 cellspacing=0 cellpadding=0 align=center>
<tr><td ><img src=../../img/error.gif width=120 height=10></td></tr>
<tr>
<td bgcolor=white height=50><div align=center>
<FONT face="Verdana, Arial, Helvetica, sans-serif" size=1>$word</font>
<a href=addevents.pl><FONT face=Verdana, Arial, Helvetica, sans-serif size=1 color=blue> эрчрф</font></a><br>
</div>
<br></td></tr><br></tr>
<tr><td ><img src=../img/niz.gif width=120 height=10></td></tr>
</table><br><br>
</body>
PAGE_HERE
return($abnbanner);
}
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@222
sub bwrite  
{
my($word)=@_;
my $abnbanner;
$abnbanner=header(-charset=>'Windows-1251');
$abnbanner.="<FONT face=Verdana, Arial, Helvetica, sans-serif size=1>$word</font>";
return($abnbanner);
}
#@@@@@@@@@@@@@@@@@@@@@22
sub bwrite2  
{my($word)=@_;

my $abnbanner;
print header(-charset=>'Windows-1251');

print "<link rel=\"stylesheet\" type=\"text/css\" href=\"../../css.css\">$word";
exit 0;
}


#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@22
sub gzip
{

if(($ENV{HTTP_ACCEPT_ENCODING} || '') =~ /gzip/){
        
        
                $a = Compress::Zlib::memGzip($a);
                print "Content-Encoding: gzip\n";}

print header(-charset=>'Windows-1251')
}

1;