Perl для CGI / Примеры Perl-сценариев |
||
Кто посещает мою страничку? |
||
Вам иногда хотелось, наверное, узнать кто же смотрит на вашу страничку, откуда и когда ваша страничка посещалась. Бывают такие вопросы? Кто-то считает, что ответить на них нельзя. Но вы не верьте этому расхожему мнению. Один раз с подобными вопросами ко мне подошел мой одногрупник Диман. У него неплохой сайт и туда к нему всегда валит целая куча народа. Вот как раз разговор и зашел об этой куче народа. Результатом моего непродолжительного труда стал небольшой скрипт. В страничку он втыкается через тэг <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="black"><IMG
src="cgi-bin/counter.cgi?id=doom2&dig=9"></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);
}
Если вам циферки не понравились вы их легко сможете заменить.
Вместо заключения |
||
Вот и подошла к концу моя книга. Надеюсь, что она найдет поддержку в широких слоях интернет-сообщества. В ней я постарался изложить простым и понятным языком немного из того, что знаю. Очень надеюсь, что я достиг своей цели (если вы дочитали мое учебное пособие до конца). И также я очень надеюсь, что те цели, которые вы перед собой ставили при прочтении данной книги станут осуществимыми. Если вы прочитали эту книгу, и вам понравилось, порекомендуйте ее своим знакомым web-дизайнерам и начинающим интернет-программистам. Для них она будет очень полезна. Также жду ваших отзывов и предложений. Я постараюсь ответить на интересующие вас вопросы. Если вам данная тема понравится, то я обязательно подумаю над тем, чтобы написать продолжение, в котором расскажу о тех вопросах, с которыми сталкивается профессиональный интернет-программист в своей работе.
И еще раз хочу дать совет и пожелание: если что-нибудь у вас не получается, не огорчайтесь и не опускайте руки, всегда есть способ сделать любое, пусть даже с первого взгляда сложное дело. Тем более в наших руках такая мощная вещь как интернет, и от нас зависит, каким он будет через месяц, через год, через два, через десять лет. И если вы действительно приложите усилия, то ваш сайт станет достойным всеобщего восхищения.