cont3.pl
| Код |
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;
|
|
