Учебное пособие по CGI-программированию

Сщетчик посещений


Наверное тоже одним из часто встречающихся приложений CGI являются счетчики посещений. Они стоят практически на каждой страничке, возможно даже и у вас. Но иногда вас не устраивает тот факт, что счетчик лежит где-то в другом месте.Из-за этого скажем невозможно начать счет с произвольного числа.Или еще некоторые счетчики по разному фильтруют 'Reload'. Да и мало ли? Ну а иногда вам хочется просто сделать другой дизайн цифр. То если вы CGI-програмист то возможно имеет смысл написать свой счетчик. И делать с ним что захочется. Вот я так-же написал.....

Скрипт данного счетчика обслужевает несколько счетчиков ,им вы присваиваете идентификаторы. Поэтому вы спокойно можете втыкать независимые счетчики в разные страницы сайта и даже давать это делать друзьям. В общем он прост в использовании:<IMG src="cgi-bin/counter.cgi?id=name">, Где name -любое уникальное имя идентифицирующее счетчик.Вытакже можете задать необязательный параметр dig

который задает количество цифр в счетчике ,Например:

<IMG src="cgi-bin/counter.cgi?id=doom2&dig=9">.

Получится примерно вот так:


.gif'ы в счетчике с прозрачными областями.Что дает дополнительную гибкость к примеру для улучшения внешнего вида с помощью другого фона его иногда имеет смысл запихнуть в "таблицу":

<TABLE><TR><TD bgcolor="white"><IMG src="counter.gif"></TD></TR></TABLE>


Свои данные он пишет примерно в такой файл counter.dat:

doom2 4 127.0.0.1 906992351 quake2 1 127.0.0.1 906992700 quake 3 127.0.0.1 906992668 doom 1 127.0.0.1 906991960

Вы спросите,зачем столько информации? Чтобы отфильтровывать нажатия Reload. Если с одного IP-адреса между заходами промежуток меньше чем 30 секунд,то счетчик не инкрементируется (Так например поступает счетчик в Rambler'е).

Теперь об исходнике. Скрипт получился великоват,потому,что сдесь большую часть занимает генерация .gif - файлов.. Выглядит громоздко , зато пашет как трактор ;))!!




#!/usr/bin/perl #newcount.cgi ############### $LOCK_EX=2; $LOCK_UN=8; $datafile="counter.dat"; ############### $Dig[0]=( "\x01\x01\x01\x01\x01\x01\x01\x01". "\x01\x02\x02\x02\x02\x02\x02\x01". "\x01\x02\x01\x01\x01\x01\x02\x01". "\x01\x02\x01\x01\x01\x01\x02\x01". "\x01\x02\x01\x01\x01\x01\x02\x01". "\x01\x02\x01\x01\x01\x01\x02\x01". "\x01\x02\x02\x02\x02\x02\x02\x01". "\x01\x01\x01\x01\x01\x01\x01\x01" ); $Dig[1]=( "\x01\x01\x01\x01\x01\x01\x01\x01". "\x01\x01\x01\x01\x02\x01\x01\x01". "\x01\x01\x01\x02\x02\x01\x01\x01". "\x01\x01\x01\x01\x02\x01\x01\x01". "\x01\x01\x01\x01\x02\x01\x01\x01". "\x01\x01\x01\x01\x02\x01\x01\x01". "\x01\x01\x02\x02\x02\x02\x02\x01". "\x01\x01\x01\x01\x01\x01\x01\x01" ); $Dig[2]=( "\x01\x01\x01\x01\x01\x01\x01\x01". "\x01\x01\x02\x02\x02\x02\x02\x01". "\x01\x02\x01\x01\x01\x01\x02\x01". "\x01\x01\x01\x01\x01\x01\x02\x01". "\x01\x01\x01\x01\x02\x02\x02\x01". "\x01\x01\x02\x02\x01\x01\x01\x01". "\x01\x02\x02\x02\x02\x02\x02\x01". "\x01\x01\x01\x01\x01\x01\x01\x01" ); $Dig[3]=( "\x01\x01\x01\x01\x01\x01\x01\x01". "\x01\x01\x02\x02\x02\x02\x01\x01". "\x01\x02\x01\x01\x01\x01\x02\x01". "\x01\x01\x01\x01\x02\x02\x02\x01". "\x01\x01\x01\x01\x01\x01\x02\x01". "\x01\x02\x01\x01\x01\x01\x02\x01". "\x01\x01\x02\x02\x02\x02\x01\x01". "\x01\x01\x01\x01\x01\x01\x01\x01" ); $Dig[4]=( "\x01\x01\x01\x01\x01\x01\x01\x01". "\x01\x01\x01\x02\x02\x01\x01\x01". "\x01\x01\x02\x01\x02\x01\x01\x01". "\x01\x02\x01\x01\x02\x01\x01\x01". "\x01\x02\x02\x02\x02\x01\x01\x01". "\x01\x01\x01\x01\x02\x01\x01\x01". "\x01\x01\x02\x02\x02\x02\x01\x01". "\x01\x01\x01\x01\x01\x01\x01\x01" ); $Dig[5]=( "\x01\x01\x01\x01\x01\x01\x01\x01". "\x01\x02\x02\x02\x02\x02\x02\x01". "\x01\x02\x01\x01\x01\x01\x01\x01". "\x01\x01\x02\x02\x02\x02\x01\x01". "\x01\x01\x01\x01\x01\x01\x02\x01". "\x01\x02\x01\x01\x01\x01\x02\x01". "\x01\x01\x02\x02\x02\x02\x01\x01". "\x01\x01\x01\x01\x01\x01\x01\x01" ); $Dig[6]=( "\x01\x01\x01\x01\x01\x01\x01\x01". "\x01\x01\x02\x02\x02\x02\x02\x01". "\x01\x02\x01\x01\x01\x01\x01\x01". "\x01\x02\x02\x02\x02\x02\x01\x01". "\x01\x02\x01\x01\x01\x01\x02\x01". "\x01\x02\x01\x01\x01\x01\x02\x01". "\x01\x01\x02\x02\x02\x02\x02\x01". "\x01\x01\x01\x01\x01\x01\x01\x01" ); $Dig[7]=( "\x01\x01\x01\x01\x01\x01\x01\x01". "\x01\x02\x02\x02\x02\x02\x01\x01". "\x01\x01\x01\x01\x01\x02\x01\x01". "\x01\x01\x01\x01\x02\x01\x01\x01". "\x01\x01\x01\x02\x01\x01\x01\x01". "\x01\x01\x01\x02\x01\x01\x01\x01". "\x01\x01\x02\x02\x02\x01\x01\x01". "\x01\x01\x01\x01\x01\x01\x01\x01" ); $Dig[8]=( "\x01\x01\x01\x01\x01\x01\x01\x01". "\x01\x01\x02\x02\x02\x02\x01\x01". "\x01\x02\x01\x01\x01\x01\x02\x01". "\x01\x01\x02\x02\x02\x02\x01\x01". "\x01\x02\x01\x01\x01\x01\x02\x01". "\x01\x02\x01\x01\x01\x01\x02\x01". "\x01\x02\x02\x02\x02\x02\x02\x01". "\x01\x01\x01\x01\x01\x01\x01\x01" ); $Dig[9]=( "\x01\x01\x01\x01\x01\x01\x01\x01". "\x01\x02\x02\x02\x02\x02\x02\x01". "\x01\x02\x01\x01\x01\x01\x02\x01". "\x01\x02\x02\x02\x02\x02\x02\x01". "\x01\x01\x01\x01\x01\x01\x02\x01". "\x01\x02\x01\x01\x01\x01\x02\x01". "\x01\x01\x02\x02\x02\x02\x02\x01". "\x01\x01\x01\x01\x01\x01\x01\x01" ); ############### sub urldecode{ local($val)=@_; $val=~s/\+/ /g; $val=~s/%([0-9A-H]{2})/pack('C',hex($1))/ge; return $val; } sub gifcompress{ local($bmp)=@_; local(@Tbl); local($rootsize)=(8); # bits per pixel local($i,$bmp_i,$c,$k,$ck,$code,$tbl_i,$comp_size); local($cc,$eoi); local($bits)=(''); local($RV)=(''); $bmp_i=0; foreach $i(0..2**$rootsize-1){$Tbl[$i]=pack('C',$i);} $tbl_i=2**$rootsize+2; $cc=2**$rootsize; $eoi=2**$rootsize+1; $comp_size=$rootsize+1; $c=''; $bits.=substr(unpack('b16',pack('S',$cc)),0,$comp_size); if($cc==(2**$compsize -1)){$comp_size++;} while($bmp_i<length($bmp)){ $k=substr($bmp,$bmp_i,1); $ck=$c.$k; $code=-1; for($i=0;$i<$tbl_i;$i++){if($Tbl[$i] eq $ck){$code=$i;}} if($code!=-1){ $c=$ck; } else{ $Tbl[$tbl_i]=$ck;$tbl_i++;#add $code=-1;for($i=0;$i<$tbl_i;$i++){if($i!=$eoi&&$i!=$cc){if($Tbl[$i] eq $c){$code=$i;}}} $bits.=substr(unpack('b16',pack('S',$code)),0,$comp_size); if($code==(2**$compsize -1)){$comp_size++;} if($code==4095){$bits.=substr(unpack('b16',pack('S',$cc)),0,$comp_size);foreach $i(0..2**$rootsize-1){$Tbl[$i]=pack('C',$i);};$tbl_i=2**$rootsize+2;$comp_size=$rootsize+1;$c='';} $c=$k; } $bmp_i++; } $code=-1;for($i=0;$i<$tbl_i;$i++){if($i!=$eoi&&$i!=$cc){if($Tbl[$i] eq $c){$code=$i;}}} $bits.=substr(unpack('b16',pack('S',$code)),0,$comp_size); if($code==(2**$compsize -1)){$comp_size++;} if($code==4095){$bits.=substr(unpack('b16',pack('S',$cc)),0,$comp_size);foreach $i(0..2**$rootsize-1){$Tbl[$i]=pack('C',$i);};$tbl_i=2**$rootsize+2;$comp_size=$rootsize+1;$c='';} $bits.=substr(unpack('b16',pack('S',$eoi)),0,$comp_size); local($bytes)=(''); for($i=0;$i<length($bits)/8;$i++){ $bytes.=pack('b8',substr($bits,$i*8,8)); } $RV=pack('C',$rootsize); for($i=0;$i<length($bytes)/255;$i++){ $block=substr($bytes,$i*255,255); $RV.=pack('C',length($block)); $RV.=$block; } $RV.=pack('C',0); return $RV; }



sub gengif2{ local($Number,$digits,$c_r,$c_g,$c_b)=@_; local($Ascii_Num,$Zeropad); $Ascii_Num=''.$Number; $digits=($digits>length($Ascii_Num)?$digits:length($Ascii_Num)); $Zeropad='0' x $digits; substr($Zeropad,- length($Ascii_Num),length($Ascii_Num))=$Ascii_Num; $Ascii_Num=$Zeropad; local($sym,$pos,$i); local($bmp)="\x00" x ($digits * 8 * 8); foreach $pos(0..length($Ascii_Num)-1){ $sym=substr($Ascii_Num,$pos,1); foreach $i(0..7){ substr($bmp,$i*$digits*8 + $pos*8,8)=substr($Dig[$sym],$i*8,8); } } local($g_x,$g_y); $g_x=$digits*8; $g_y=8; local($transp_index)=(1); local($RV)=('GIF89a'); local($lscr)=(pack('SS',$g_x,$g_y).pack('B8','11110111').pack('C',0).pack('C',0)); local($pal)=(pack('CCC',0x0,0x0,0x0).pack('CCC',0x7f,0x7f,0x7f).pack('CCC',$c_r,$c_g,$c_b). pack('CCC',0x7f,0x0,0x0).pack('CCC',0x0,0x7f,0x0).pack('CCC',0x0,0x0,0x7f)); local($tmp)=(pack('C',0) x 768); substr($tmp,0,length($pal))=$pal; $pal=substr($tmp,0,768);

local($gr_ext)=(pack('C',0x21).pack('C',0xf9).pack('C',4).pack('B8','00001001').pack('S',0).pack('C',$transp_index).pack('C',0));

local($imgdescr)=(pack('C',0x2c).pack('SSSS',0,0,$g_x,$g_y).pack('B8','00000000'));

local($gifdata)=(&gifcompress($bmp)); local($gifend)=(pack('C',0x3b)); $RV=$RV.$lscr.$pal.$gr_ext.$imgdescr.$gifdata.$gifend; return $RV; } ###################### binmode(STDOUT); $|=1; #print "Content-Type: image/gif\n\n"; #print &gengif2($Number,$digits,$c_r,$c_g,$c_b); #print &gengif2(1234567890,9,100,0,0);

$query=$ENV{'QUERY_STRING'}; if($query eq ''){print "Content-Type: image/gif\n\n";print &gengif2(1234567890,10,100,0,0);} else{ @fields=split(/&/,$query); foreach(@fields){ if(/^id=(.*)/){$id=&urldecode($1);} if(/^dig=(.*)/){$dig=&urldecode($1);} } $digits=$dig; $digits=9 unless($dig); $cur_ip=$ENV{'REMOTE_ADDR'}; $cur_time=time; open(DATA,"+<$datafile"); flock(DATA,$LOCK_EX); @Dat=<DATA>; chop(@Dat); %Counters=@Dat; ($count,$ip,$t)=split(/\s+/,$Counters{$id}); $count++ if(($ip!=$cur_ip)($cur_time-$t>30)); $ip=$cur_ip; $t=$cur_time; $Counters{$id}=join(' ',$count,$ip,$t); seek(DATA,0,0); foreach(keys %Counters){ print DATA "$_\n"; print DATA "$Counters{$_}\n"; } truncate(DATA,tell(DATA)); flock(DATA,$LOCK_UN); close(DATA); print "Content-Type: image/gif\n\n"; print &gengif2($count,$dig,100,0,0); }


Если вам циферки не понравились вы их легко сможете заменить.


Содержание раздела