MoveR studio ..:: П о м о щ ь   -   С т а т ь и ::..
 Помощь
Учебное пособие по CGI-программированию от Леши

Примеры приложений:

Кто посещает мою страничку?


Вам иногда хотелось наверное узнать,кто же смотрит на вашу страничку,откуда и когда ваша страничка посещалась.
Бывают такие вопросы? Кто-то считает,что ответить на них нельзя. Но вы не верьте этому расхожему мнению.
Один раз с подобными вопросами ко мне подошел мой одногрупник, Диман. У него неплохой сайт. и туда к нему всегда валит целая куча народа. Вот как раз разговор и зашел об этой куче народа. Результатом моего непродолжительного труда стал небольшой скрипт.В страничку он втакается через тэг <IMG src="cgi-bin/get_ip.cgi"> он покажет вам изображение что не будет бросаться в глаза. Зато при своей работе он все запишет в файл ipdata.txt : В нем будет время и IP-адрес того,кто смотрел на вашу страничку! 
#!/usr/bin/perl
#get_ip.cgi
$gif="../gifs/player.gif";
$data="ipdata.txt";
print "Content-Type: image/gif\n\n";
open(G,$gif);
print <G>;
close(G);
open(D,">>$data");
print D scalar localtime,' '.$ENV{'REMOTE_ADDR'}."\n";
close(D);

Гостевая книга


А вот еще пример того,как можно с умом использовать нехитрые знания. Гостевая книга ,в которую каждый может записать свое вам пожелание.
К ней прилагаются .gif -файлы,позволяющие указать свое настроение:
Запись происходит в базу данных guestbook.dat и при каждой новой записи в гостевую книгу скрипт извещает по почте хозяина гостевой книги, а тому кто в нее вошел по почте посылается сообщение об этом.
#!/usr/bin/perl
#guestbook.cgi
$myemail="paaa\@uic.nnov.ru";
$myname="lesha";
$mail="mail";
($sd,$sn)=($ENV{'SCRIPT_FILENAME'}=~/(.*)\/([^\/]*)/);
$datafile=$sd."\/guestbook.dat";
@Mailgifs=qw(../gifs/mood0.gif ../gifs/mood1.gif ../gifs/mood2.gif);
$Facetxt{$Mailgifs[0]}= ":)";
$Facetxt{$Mailgifs[1]}= ":|";
$Facetxt{$Mailgifs[2]}= ":(";

sub urldecode{
 local($val)=@_;
 $val=~s/\+/ /g;
 $val=~s/%([0-9a-hA-H]{2})/pack('C',hex($1))/eg;
 return $val;
 }
sub strhtm{
 local($val)=@_;
 $val=~s/&/&/g;
 $val=~s/</</g;
 $val=~s/>/>/g;
 $val=~s/(http:\/\/\S+)/<A href="$1">$1<\/A>/g;
 return $val;
 }
$cont_len=$ENV{'CONTENT_LENGTH'};
if($ENV{'REQUEST_METHOD'} eq 'GET'){$query=$ENV{'QUERY_STRING'};}
else {sysread(STDIN,$query,$cont_len);}
if($query eq ''){
  print "Content-type: text/html\n\n";
  print <<HTML_generating;
<HTML><HEAD><TITLE>Wellcome to my guestbook</TITLE></HEAD>
<BODY bgcolor="cyan">
<CENTER><H1>Wellcome to my guestbook</H1></CENTER>
<HR><FORM action="guestbook.cgi" METHOD="POST">
<TABLE border=0>
<TR><TD>Name:</TD><TD colspan=3><INPUT NAME="Name"></TD></TR>
<TR><TD>E-mail:</TD><TD colspan=3><INPUT NAME="Email"></TD></TR>
<TR><TD>URL:</TD><TD colspan=3><INPUT NAME="URL"></TD></TR>
<TR><TD>Message:</TD><TD colspan=3><TEXTAREA NAME="Message" rows=6 cols=64></TEXTAREA></TD></TR>
<TR><TD>Mood:</TD><TD><IMG src="$Mailgifs[0]"></TD><TD><IMG src="$Mailgifs[1]"></TD><TD><IMG src="$Mailgifs[2]"></TD></TR>
<TR><TD> </TD><TD><INPUT TYPE="radio" NAME="Mood" VALUE="$Mailgifs[0]"></TD>
                   <TD><INPUT TYPE="radio" NAME="Mood" VALUE="$Mailgifs[1]"></TD>
                   <TD><INPUT TYPE="radio" NAME="Mood" VALUE="$Mailgifs[2]"></TD></TR>
<TR><TD colspan=2><INPUT TYPE="submit" VALUE="Send"></TD>
    <TD colspan=2><INPUT TYPE="reset" VALUE="Clean"></TD></TR>
</TABLE></FORM>
<HR><BR>
HTML_generating
  open(DATAFILE,"$datafile")|| die "Cannot open $datafile $!\n";
  @GUESTDATA=<DATAFILE>;
  print @GUESTDATA;
  close(DATAFILE);
  print "</BODY></HTML>";
  }
else{
  foreach(@fields=split(/&/,$query)){
    if(/^Name=(.*)/){$Name=&urldecode($1);}
    if(/^Email=(.*)/){$Email=&urldecode($1);}
    if(/^URL=(.*)/){$URL=&urldecode($1);}
    if(/^Message=(.*)/){$Message=&urldecode($1);}
    if(/^Mood=(.*)/){$Mood=&urldecode($1);}
    }
  $MESSAGE=&strhtm($Message);
  if(-e $datafile){unless (-r $datafile && -w $datafile){die "Cannot access $datafile\n";}}
  $Newmsg="<IMG src=\"$Mood\"><BR><A href =\"mailto:$Email\">$Name</A>".
          "(<A href=\"$URL\">$URL</A>):<BR>\n$MESSAGE<HR>\n";
  open(DATAFILE,"+<$datafile") || die "Cannot open $datafile $!\n";
  @GUESTDATA=<DATAFILE>;
  @GUESTDATA=($Newmsg,@GUESTDATA);
  seek(DATAFILE,0,0);
  print DATAFILE @GUESTDATA;
  close(DATAFILE);
  print "Content-type: text/html\n\n";
  print "<HTML><HEAD><TITLE>Congratulations</TITLE></HEAD>\n";
  print "<BODY bgcolor=\"cyan\">\n<CENTER><H1>Congratulations:you have successfully entered to $myname\'s";
  print "guestbook.Thank you!</H1></CENTER><HR>$Newmsg</BODY></HTML>";
  open(MAIL,"|$mail $Email");
  print MAIL "Guestbook\n";
  print MAIL "You have entered to $myname\'s guestbook\n";
  print MAIL "Thank you.\n\t\t\t\t$myname";
  close(MAIL);
  format NOTIFYMAIL=
Guestbook  
========================== Guestbook Entry =======================
| Time:                    |Name:                                |
| @<<<<<<<<<<<<<<<<<<<<<<<<|@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< |
scalar localtime,$Name
+--------------------------+-------------------------------------+
| Email:                   |URL:                                 |
| @<<<<<<<<<<<<<<<<<<<<<<<<|@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< |
$Email,$URL
+--------------------------+-------------------------------------+
| ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< |
$Message
| ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< |
$Message
| ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< |
$Message
| ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<    @<<<<< |
$Message,$Facetxt{$Mood}
==================================================================
.
  open(NOTIFYMAIL,"|$mail $myemail");
  write NOTIFYMAIL;
  close(NOTIFYMAIL);
  }

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


Наверное тоже одним из часто встречающихся приложений 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);
 }
Если вам циферки не понравились вы их легко сможете заменить.


[ Предыдущая | Содержание | Следующая ]

Hosted by uCoz