GET /~paaa/cgi-bin/guestbbok.cgi HTTP/1.0Вот это самое главное в запросе
HTTP/1.0 200 Okay Content-Type: text/html <HTML> <BODY> ....... </BODY></HTML>
Замечание:
Если же вы используете Windows NT ,то материал данной книги вам будет тоже очень полезен, однако будьте готовы к тому что в некоторые скрипты придется вносить значительные изменения. В некоторых случаях,когда сказывается то , что возможности NT по работе с сетью намного хуже, чем у UNIX,то некоторые скрипты вовсе нельзя будет использовать.
#!/usr/bin/perl #first.cgi print "Content-Type: text/html\n\n"; print "<HTML><BODY>"; print "<H1>Hello you!!!</H1>"; print "</BODY></HTML>";
print "Content-Type: text/html\n\n"; #Все Правильно print "Content-Type: text/html\n"; #ОШИБКА!!!
<HTML><BODY> <H1>Hello you!!!</H1> </BODY></HTML>Сервер обработает ответ скрипта и на базе него сформирует и пошлет браузеру ответ.(Сервер обычно не изменяет тела сообщения,он только дополняет заголовок нужными для работы протокола HTTP полями)
Это одно из самых главных поле используемое для определения метода запроса HTTP Протокол HTTP использует методы GET и POST для запроса к серверу.Они отличаются тем что при методе GET запрос является как-бы частью URL т.е. http://www..../myscript.cgi?request а при методе POST данные передаются в теле HTTP-запроса (при GET тело запроса пусто) и следовательно для CGI тоже есть различие при GET запрос идет в переменную QUERY_STRING а при POST подается на STDIN скрипта.QUERY_STRING
Пример:REQUEST_METHOD=GET
Это строка запроса при методе GET. Вам всем известно что запрос из формы кодируется браузером поскольку не все символы разрешены в URL некоторые имеют специальное назначение. Теперь о методе urlencode: неплохо бы чисто формально напомнить,что все пробелы заменяются в URL на знак '+', а все специальные и непечатные символы на последовательность %hh ,где hh-шестнадцатиричный код символа,разделитель полей формы знак '&',так что при обработке форм надо произвести декодирование.CONTENT_LENGTH
Пример:QUERY_STRING= name=quake+doomer&age=20&hobby=games
Длина в байтах тела запроса.При методе запроса POST необходимо считать со стандартного входа STDIN CONTENT_LENGTH байт,а потом производить их обработку.Обычно методом POST пользуютс для передачи форм,содержащих потенциально большие области ввода текста TEXTAREA.При этом методе нет никаких ограничений,а при методе GET существуют ограничения на длину URL .CONTENT_TYPE
Пример:CONTENT_LENGTH=31
Тип тела запроса(для форм кодированых выше указаным образом он application/x-www-form-urlencoded)GATEWAY_INTERFACE
Версия протокола CGI.REMOTE_ADDR
Пример:GATEWAY_INTERFACE=CGI/1.1
IP-Адрес удаленого хоста,делающего данный запрос.REMOTE_HOST
Пример:REMOTE_ADDR=139.142.24.157
Если запрашивающий хост имеет доменное имя,то эта переменная содержит его, в противном случае -тот же самый IP-адресс что и REMOTE_ADDRSCRIPT_NAME
Пример:REMOTE_HOST=idsoftware.com
Имя скрипта,исполизованое в запросе.Для получения реального пути на сервере используйте SCRIPT_FILENAMESCRIPT_FILENAME
Пример:SCRIPT_NAME=/~paaa/guestbook.cgi
Имя файла скрипта на сервере.SERVER_NAME
Пример:SCRIPT_FILENAME=/home/p/paaa/public_html/cgi-bin/guestbook.cgi
Имя серера ,чаще всего доменное как www.microsoft.com ,но в редких случаях за неимением такового может быть IP-адресом как 157.151.74.254SERVER_PORT
Пример:SERVER_NAME=www.uic.nnov.ru
TCP-Порт сервера используюшийся для соединения .По умолчаниию HTTP-порт 80, хотя может быть в некоторых случаях другим.SERVER_PROTOCOL
Пример:SERVER_PORT=80
Версия протокола сервера.SERVER_SOFTWARE
Пример:SERVER_PROTOCOL=HTTP/1.1
Програмное обеспечение сервера.AUTH_TYPE, REMOTE_USER
Пример:Apache/1.0
Эти переменные определены в том случае,когда запрошеный ресурс требует аутентификации пользователя.Переменные заголовка HTTP-запроса.
Давая запрос на сервер браузер обычно расчитывает получить информацию определеного формата,и для этого он в заголовке запроса указывает поле Accept:,Отсюда скрипту поступает cписок тех MIME,которые браузер готов принять в качестве ответа от сервера.HTTP_USER_AGENT
Пример:HTTP_ACCEPT=text/html,text/plain,image/gif
Браузер обычно посылает на сервер и информацию о себе,чтоб базируясь на знании особеностей и недостатков конкретных браузеров CGI-скрипт мог выдать информацию с учетом этого. Например,разные браузеры могут поддерживать или не поддерживать какие-то HTMLые тэги.HTTP_HOST
Пример:HTTP_USER_AGENT=Mozila/2.01 Gold(Win95;I)
Имя хоста к которому обращается браузер. Так как физически на одном сервере может находиться сразу много серверов (Виртуальные Хосты), то должен быть способ сообщить серверу к какому именно идет обращение. Скрипт же может тоже в зависимости от этой переменной производить различные действия, таким если он используется на сайтах сразу нескольких виртуальных хостов.
Пример:HTTP_HOST=www.nnov.city.ru
#!/usr/bin/perl
#vars.cgi
sub urldecode{ #очень полезная функция декодировани
local($val)=@_; #запроса,будет почти в каждой вашей CGI-программе
$val=~s/\+/ /g;
$val=~s/%([0-9A-H]{2})/pack('C',hex($1))/ge;
return $val;
}
print "Content-Type: text/html\n\n";
print "<HTML><HEAD><TITLE>CGI-Variables</TITLE></HEAD>\n";
print "<BODY>\n";
print "Enter here something:<ISINDEX><BR>\n";
print "Your request is:$ENV{'REQUEST_STRING'}<BR>\n";
print "Decoded request is:urldecode($ENV{'REQUEST_STRING'})<BR>\n";
print "<HR>\n";
print "Variables:<BR>\n";
print "<I><B>REQUEST_METHOD</B></I>=$ENV{'REQUEST_METHOD'}<BR>\n";
print "<I><B>QUERY_STRING</B></I>=$ENV{'QUERY_STRING'}<BR>\n";
print "<I><B>CONTENT_LENGTH</B></I>=$ENV{'CONTENT_LENGTH'}<BR>\n";
print "<I><B>CONTENT_TYPE</B></I>=$ENV{'CONTENT_TYPE'}<BR>\n";
print "<I><B>GATEWAY_INTERFACE</B></I>=$ENV{'GATEWAY_INTERFACE'}<BR>\n";
print "<I><B>REMOTE_ADDR</B></I>=$ENV{'REMOTE_ADDR'}<BR>\n";
print "<I><B>REMOTE_HOST</B></I>=$ENV{'REMOTE_HOST'}<BR>\n";
print "<I><B>SCRIPT_NAME</B></I>=$ENV{'SCRIPT_NAME'}<BR>\n";
print "<I><B>SCRIPT_FILENAME</B></I>=$ENV{'SCRIPT_FILENAME'}<BR>\n";
print "<I><B>SERVER_NAME</B></I>=$ENV{'SERVER_NAME'}<BR>\n";
print "<I><B>SERVER_PORT</B></I>=$ENV{'SERVER_PORT'}<BR>\n";
print "<I><B>SERVER_PROTOCOL</B></I>=$ENV{'SERVER_PROTOCOL'}<BR>\n";
print "<I><B>SERVER_SOFTWARE</B></I>=$ENV{'SERVER_SOFTWARE'}<BR>\n";
print "<I><B>HTTP_ACCEPT</B></I>=$ENV{'HTTP_ACCEPT'}<BR>\n";
print "<I><B>HTTP_USER_AGENT</B></I>=$ENV{'HTTP_USER_AGENT'}<BR>\n";
print "<I><B>HTTP_HOST</B></I>=$ENV{'HTTP_HOST'}<BR>\n";
print "<HR>\n";
print "All enviroment:<BR>\n";
foreach $env_var (keys %ENV){
print "<I>$env_var=$ENV{$env_var}</I><BR>\n";
}
print "</BODY></HTML>\n";
Так как все ваши .cgi -файлы должны быть исполняемыми то чтоб
облегчить себе жизнь заведите себе в директории cgi-bin командный файл
mkcgi ,содержащий #!/bin/sh #mkcgi chmod +x *.cgiи сделайте его в свою очередь исполняемым chmod +x mkcgi -он сильно упростит вам жизнь.
| Операцыи | Описание | Пример |
| + - * / % | Арифметические | print 2*7+4/(8%3); print int(127/15); #целая часть |
| ** | Возведение в степень | print 2**16; |
| ++ -- | Инкремент-декремент | $i++; |
| & | ^ ~ << >> | Побитовые | $x=3;$y=4; print $x|$y; print $x&$y; |
| == != < > <= >= <=> | Числовые операции сравнения | if($x==9){print "Ok!";} |
| eq ne lt gt le ge cmp | стрковые операции сравнения | if($game eq 'doom'){print "You are doomer!\n";} |
| || && ! | Логические | if(($x==9)||($game eq 'doom')){print "hello you!\n";} |
| ?: | Условный оператор | $x=($game eq 'quake'?9:8); |
| , | Последовательное вычисление | $x=10,$y=20; |
| . | Конкатенация | $x='http://'.'www.uic.nnov.ru'; |
| x | Повторение | $x='1234'x5; #$x='12341234123412341234' |
| =~ | Сопоставление с образцом | if($url=~/http/){print "HTTP";} |
| !~ | То же но с отрицанием | if($url!~/http/){print "No HTTP";} |
| = += -= *= /= %= **= |= &= ^= ~= <<= >>= .= x= | Присваивание | $x+=$y; |
$x='qwerty'; print 'my var is $x'; #выведет my var is $x print "my var is $x"; #выведет my var is qwertyСписки: Спискочные переменные начинаются с символа '@' конструируются следующим образом
@List1=(1,2,5,70); @List2=(12,23,@List1); #12,23,1,2,5,70 @Rgb=($r,$g,$b);Также можно список использовать как lvalue:
@List=(1,2,3..8,15); ($x,$y,$z)=@List; #$x=1,$y=2,$z=3 ($x,$y,$z,@list2)=@List; #$x=1,$y=2,$z=3,@list2=(4,5,6,7,8,15); ($r,$g,$b)=@Rgb;Можно обращаться к нескольким,выбраным элементам массива(срезу массива):
@list=(1..10); @list[2,3,5,9]=(100,200,300,400); #@list=(1,100,200,4,300,6,7,8,400,10) @list[1,10]=@list[10,1];#меняет местами элементыОбратится к скаларному значению -элементу массива можно $имя_массива[индекс], сдесь обратите внимание на знак '$'- мы ведь обращаемся к скаляру-элементу.
$my_hash{1}="doom";
$my_hash{'quake'}="www.idsoftware.com";
$my_hash{1+2}=100;
Хеш может быть также сконструирован из массива с четным числом
элементов где пары превращаются в ключ-значение %hash=(1,20,2,100);#аналогично $hash{1}=20;$hash{2}=100;
удаление из хеша -операция delete: delete $hash{1};
есть функции выдающие ключи и значения соответственно. %hash=(1,20,2,100,3,'doom'); @k=keys %hash; #@k=(1,2,3); @v=values %hash;#@v=(20,100,'doom');Операторы:
if(условие)оператор; оператор if условие;В пару к оператору if имеется оператор unless : означающий if с отрицанием:
unless(($method eq 'GET')||($method eq 'POST')){print "Unsupported method";}
print "Ok" unless $x < $y;
Также в пару while существует untilfor($i=0;$i<10;$i++){
print $i;
}
новшеством(и приятным) является foreach позволяющий пройтись по
всем элементам массива,присваивая по очереди его элементы какой-то переменной,
его синтаксис такой:foreach $переменная (@массив){
блок операторов;
}
или
foreach (@массив){
операторы;
}
Последний пример особенно важен для упрощения вашего тяжкого труда
програмиста и демонтстрирует интересную особенность Perl-переменную по
умолчанию $_: в оргомном количестве операторов и функций при опускании
аргумента она подразумевается по умолчанию. Она также по умолчанию
сопоставляется с регулярным выражением: следующий пример
@Data=<STDIN>;
foreach(@Data){
chomp;
print if /^From:/;
}
аналогичен такому:
@Data=<STDIN>;
foreach $_ (@Data){
chomp($_);
print $_ if $_ =~ /^From:/;
как видите затраты труда значительно сокращаются,благодаря этому
маленькому трюку.if(/abc/){
print '$_ содержит abc\n';
}
это самый простой пример применения регулярного выражения а теперь
посложнее вот тут в табличке (из того что я помню наизусть):
| Символ | Значение | Пример применения |
| . | Соответствует любому символу | print if /ab.c/; |
| [мн-во симв] | Соответствует любому символу из данного мн-ва | /[abc]d/;#соответствует ad,bd,cd |
| [^мн-во] | Отрицание мн-ва символов | /[^xyz]/;# |
| (....) | Группировка элементов(и также запоминание в переменных $1 $2 $3 ...) | /(xyz)*/ /([abc].[^xy]qwerty)/ |
| (..|..|..) | Одна из альтернатив | |
| * | повторение образца 0 или более раз | /.*/;#соответствует всему |
| ? | Повторение 0 или 1 раз | /(http:\/\/)?.*\.cgi/ |
| + | Повторение 1 или более раз | |
| {n,m} | повторение от n до m раз | |
| {n} | повторение точно n раз | |
| {n,} | повторение n и более раз | |
| Спец символы: | ||
| \t \r \n ... | Управляющие символы:табуляции,возврат каретки,перевод строки..... | |
| \d | Соответствует цифре,Аналог [0-9] | |
| \D | Соответствует нецифровому симсволу,аналог[^0-9] | |
| \w | Соответствует букве | |
| \W | Соответствует небуквеному символу | |
| \s | Соответствует пробельным символам(пробелы,табуляции,новые строки..) | |
| \S | Соответствует непробельному символу | |
| \b | Соответствует границе слова | $test1="this is
test"; $test2="wise"; if($test1=~/\bis\b/){print "1";}#соответствует if($test2=~/\bis\b/){print "2";}#нет |
| \B | Соответствует не границе слова | /\Bis\B/ соответсвует 'wise' но не 'is' |
print "Are you sure?:";
$answer=<STDIN>;
if($answer=~/Y/i){
#че-нибудь сделаем...
}
$x="This is test"; $x=~s/ /_/g; print $x; #This_is_testОчень полезная опция у s/// e -она означает что вторая строка не строка а выражение, результат которого и будет подставлен. Например,у вас есть файл в котором все записи о возрасте через год надо менять
open(OLD,"oldfile.txt") || die "Cannot open oldfile.txt $!\n"; open(NEW,">newfile.txt") || die "Cannot open newfile.txt $!\n"; foreach(или более показательным примером послужит функция urldecode,которая будет встречатс в каждой вашей программе,обрабатывающей формы:){ s/(\d+)(\s+год)/($1+1).$2/gie; s/(\d+)(\s+лет)/($1+1).$2/gie; print NEW $_; } close(NEW); close(OLD);
sub urldecode{
local($val)=@_;
$val=~s/\+/ /g;
$val=~s/%([0-9a-hA-H]{2})/pack('C',hex($1))/ge;
return $val;
}
Также важным удобством в Perl являются операции для работы с
файлами для выполнения схожих функций в других языках приходиться проделывать
огромную массу работы. Аргументами могут быть как Файловые переменные,так и
строки,представляющие имя файла.
| Операция | Описание | Пример использоввания |
| -r | Доступен для чтения | unless(-r "myfile"){print "Cannot read myfile\n";} |
| -w | Доступен для записи | |
| -x | Для исполнения | |
| -o | Принадлежит пользователю | if(-o "index.htm"){chmod(0777,"index.htm");} |
| -R | Доступен для чтения реальным пользователем,а не только "эффективным". Имеет значения для set-uid -скриптов |
if(-r FILE){unless(-R FILE){die "Its not allowed to read this\n";}} |
| -W | Доступен для записи реальным пользователем | |
| -X | Доступен для исполнения реальным пользователем | |
| -O | Принадлежит реальному пользователю | |
| -e | Файл или каталог Существует | unless(-e $htmlfile){ open(HTML,">$htmlfile"); print HTMLFILE "<HTML><BODY></BODY></HTML>"; close(HTMLFILE); } |
| -z | Существует,но имеет нулевую длину | if(-z 'tmpfile'){unlink('tmpfile');} |
| -s | Размер файла в байтах | system("rar m -m5 archive.rar $myfile") if -s $myfile > 1000; |
| -f | Файл существует и является простым файлом | |
| -d | Файл существует и является каталогом | if(-d 'public_html'){chdir('public_html');} |
| -l | Символической ссылкой | |
| -p | Каналом FIFO | |
| -u | Имеет бит установки пользователя | |
| -g | Имеет бит установки группы | |
| -k | Установлен sticky-бит | |
| -t | Является терминальным устройством | |
| -M | Время с последнего изменения (в днях) | while(defiled($file=glob('*'))){ if(-M $file >= 7.0){ unlink($file);#удаляем слишком старые файлы } } |
| -A | Время последнего доступа(в днях) | if(-A "$ENV{'HOME'}/public_html/index.html" < -A "$ENV{'HOME'}/.last"){print "Кто-то ходил на твою домашнюю страничку пока тебя не было!!!\n";} |
| -C | Время последнего обновления файлового индекса(в днях) | |
open(ФАЙЛОВАЯ_ПЕРЕМЕННАЯ,"имя файла"); #открыть файл для чтени open(ФАЙЛОВАЯ_ПЕРЕМЕННАЯ,">имя файла"); #для записи open(ФАЙЛОВАЯ_ПЕРЕМЕННАЯ,">>имя файла");#для записи в конец open(ФАЙЛОВАЯ_ПЕРЕМЕННАЯ,"+<имя файладля чтения и записи open(файловая_переменнаякомманда#направить информацию на вход программы#считать с выхода#и то другое вместе >Что какается открытия файлов,то вам как програмистам все очевидно, но с коммандами тоже все здорово,что пояснит хороший пример(из практики):
open(MAIL,"|mail paaa@uic.nnov.ru");#Пошлем информацию по почте print MAIL "Hello\n"; print MAIL "...\n"; print MAIL "...\n"; close(MAIL);когда вы открыли файл вы можете считать из него строку в скалярную переменную Вот так:$str=<FILE>
print "Введите имя файла:"; $fname=<STDIN>; chomp($fname); open(F,$fname)|| die "Cannot open $fname $!\n"; .....Если также подставить списочную переменную,то получим список строк файла от текущей строки и до конца
print "Что искать:";
$search=<STDIN>;
chomp($search);
@L=<F>;
foreach(@L){
print if /$search/;
}
а можно и так:
print "Что искать:";
$search=<STDIN>;
chomp($search);
foreach(<F>){
print if /$search/;
}
бинарный файл можно читать и писать функциями sysread и
syswrite:#Разбить строку слов,разделенных пробелами в список вы можете
@WordList=split(/ /,$String);
#После обработки снова обьединить
$String=join(' ',@WordList);
Встроеные функции Perl можно вызывать со скобками или без (как
вам удобно), скобки программисты указывают или для красоты,или чаще,что
устранить возможную неоднозначность в выраженнии: printf "x=%d",$x;
printf ("x=%d",$x);#аналогично
Надеюсь что я вас позабавил примерами функций
;).#!/usr/bin/perl
#txt2html
die "Usage: txt2html Infile OutFile\n" unless(@ARGV);
open(IN,"$ARGV[0]")|| die "Cannot open $ARGV[0] $! \n";
open(OUT,">$ARGV[1]")|| die "Cannot open $ARGV[1] $! \n";
while(<IN>){
s/&/&/g;
s/</</g;
s/>/>/g;
s/(http:\/\/\S+)/<A href="$1">$1<\/A>/g;
print OUT $_;
}
close(IN);
close(OUT);
Более подробную информацию о Perl вы можете получить по
адресам:Простейший запрос: GET /index.html HTTP/1.0 Посложнее: GET /somedir/somedoc.html HTTP/1.0 User-Agent: Mozilla/2.0 Accept: text/html Accept: text/plain Accept: image/gif Передача данных CGI- скрипту через метод GET GET /~paaa/cgi-bin/test.cgi?name=Dmitry&organization=%D3%ED%E8%E2%E5%F0%F1%E8%F2%E5%F2+%CD%E8%E6%ED%E5%E3%EE+%CD%EE%E2%E3%EE%F0%EE%E4%E0&Name=&email=&comment= HTTP/1.0 User-Agent: Mozila/2.0 Accept: text/html Accept: image/gif Используя метод POST данные передаются в теле сообщения запроса: POST /~paaa/cgi-bin/test.cgi HTTP/1.0 User-Agent: Mozila/2.0 Accept: text/html Accept: image/gif Content-Type: application/x-www-form-urlencoded Content-Length: 131 name=Lesha &organization=%D3%ED%E8%E2%E5%F0%F1%E8%F2%E5%F2+%CD%E8%E6%ED%E5%E3%EE+%CD%EE%E2%E3%EE%F0%EE%E4%E0&Name= &email= &comment=Ответ HTTP-сервера.
| Код статуса | Значение |
| 200 | OK |
| 201 | Успешная команда POST |
| 202 | Запрос принят |
| 203 | Запрос GET или HEAD выполнен |
| 204 | Запрос выполнен но нет содержимого |
| 300 | Ресурс обнаружен в нескольких местах |
| 301 | Ресурс удален навсегда |
| 302 | Ресурс отсутствует временно |
| 304 | Ресурс был изменен |
| 400 | Плохой запрос от клиента |
| 401 | Неавторизованый запрос |
| 402 | Необходима оплата за ресурс |
| 403 | Доступ Запрещен |
| 404 | Ресурс не найден |
| 405 | Метод не применим для данного ресурса |
| 406 | Недопустимый тип ресурса |
| 410 | Ресурс Недоступен |
| 500 | Внутренняя ошибка сервера (это по вашу душу,юные CGI-программисты ;( ) |
| 501 | Метод не выполнен |
| 502 | Неисправный шлюз либо перегруз сервера |
| 503 | Сервер недоступен/тайм-аут шлюза |
| 504 | Вторичный шлюз/тай-аут сервера |
HTTP/1.0 200 Ok Date: Wed, 25 Sep 1998 23:00:00 GMT Server: Apache/1.1 MIME-version: 1.0 Last-Modified: Mon 15 Nov 1996 15:20:12 GMT Content-Type: text/html Content-Length: 2000 <HTML><HEAD><TITLE>Hello</TITLE></HEAD> <BODY bgcolor="green" text="yellow"> ...... </HTML> А вот такое сервер выдаст в неудачном случае: HTTP/1.0 404 Not FoundCGI-заголовок.
Обычно такое выдает скрипт: Content-Type: text/html <HTML><HEAD>....... Но иногда такое(когда он служит для перенаправления): Location: http://www.mustdie.ru/ А вот пример возврата статуса: Content-Type: image/gif Status: 190 Its seems great like a playing doom! WOW! GIF89a........nph-скрипты.
#!/usr/bin/perl
#nph-animate.cgi
$times = 20;
#Заготовте несколько небольних gif-файлов для этой программы
@files = qw(img0.gif img1.gif img2.gif img3.gif);
select (STDOUT);
$|=1; #autoflush mode on
#Generate header
print "HTTP/1.0 200 Okay\n";
print "Content-Type: multipart/x-mixed-replace;boundary=myboundary\n\n";
print "--myboundary\n";
for ($num=1;$num<=$times;$num++) {
foreach $file (@files) {
print "Content-Type: image/gif\n\n";
open(PIC,"$file");
print <PIC>;
close(PIC);
print "\n--myboundary\n";
sleep(3);
}
}
print "\n--myboundary--\n";
Этот пример вам выдаст анимацию ,составленую из нескольких .gif
-файлов.Если же вы получили вместо анимации сообщение об ошибках,то вам
следует,может быть перейти к следующей главе, которая поведает вам о правах
доступа- того,без чего Unix не был бы Unixом.
| 1я -права доступа для пользователя,которому принадлежит файл |
| 2я -для группы которой принадлежит файл |
| 3я -для всех остальных |
| Бит | Описание |
| 8 | Право на чтение для пользователя |
| 7 | Право на запись для пользователя |
| 6 | Право на исполнение для пользователя |
| 5 | Право на чтение для группы |
| 4 | Право на запись для группы |
| 3 | Право на исполнение для группы |
| 2 | Право на чтение для всех остальных |
| 1 | Право на запись для всех остальных |
| 0 | Право на исполнение для всех остальных |
#!/usr/bin/perl
#listmydir.cgi
print "Content-Type: text/html\n\n";
if(!(-r '..')){
print ".. is not allowed for reading ;)))))\n";
}
else{
@list=glob('../*');
foreach(@list){
print "<A href=\"$_\">$_</A>";
print " readable" if -r;
print " writable" if -w;
print " executable" if -x;
print "<BR>\n";
}
}
MIME-Version: 1.0 Content-Type: multipart/alternative; boundary="w23renff491nc4rth56u34-9449" --w23renff491nc4rth56u34-9449 Content-Type: text/plain; charset="koi8-r" Hello,World!! --w23renff491nc4rth56u34-9449 Content-Type: text/html; charset="us-ascii" <H1>Hello,Word!!</H1> <HR> <FONT size=+1 color=red>Hello people!</FONT> --w23renff491nc4rth56u34-9449--
<SCRIPT language="JavaScript">
if(navigator.AppName=="Netscape"){
/*Сделать чо-нибудь специфичное для Netscape*/
}
else if(navigator.AppName=="Microsoft Internet Explorer"){
/*Сделать чо-нибудь специфичное для Explorer*/
}
else{
/*Не делаем специфичных вещей-хрен его знает с каким браузером мы имеем дело*/
}
</SCRIPT>
или
<SCRIPT language="JavaScript">
if((navigator.AppName=="Netscape")&&(parseFloat(navigator.appVersion)<3.0)){
document.writeln("Пользуетесь слишком старым браузером");
}
</SCRIPT>
Ну не волнуйтесь вы так ,мы CGI-программисты не в самых худших
условиях на этот счет. Вспомните о том что браузер сам при запросе посылает вам
данные о себе и о своей версии. И делает он это для того,чтобы эту информацию
можно было учесть.#!/usr/bin/perl
#oldbrowser.cgi
print "Content-Type: text/html\n\n";
if(defined ($ENV{'HTTP_USER_AGENT'})){
$browser=$ENV{'HTTP_USER_AGENT'};
($vers)=($browser=~/\/(\d+\.\d+)/);
if(($browser=~/mozilla/i)&&($vers<=2.0)){
print "<HTML><HEAD><TITLE>Too old!</TITLE></HEAD>";
print "<BODY bgcolor=\"red\" text=\"black\">";
print "<CENTER><H1>Ваш Netscape Слишком старый для этого сайта";
print "(старость не радость;))</H1></CENTER>";
print "</BODY></HTML>";
exit;
}
if(($browser=~/msie/i)&&($vers<=3.0)){
print "<HTML><HEAD><TITLE>Too old!</TITLE></HEAD>";
print "<BODY bgcolor=\"red\" text=\"black\">";
print "<CENTER><H1>Ваш Explorer устарел";
print "(а не пора ли сделать апгрейт хотя бы до 4.0 версии)</H1></CENTER>";
print "</BODY></HTML>";
exit;
}
}
print "<HTML><HEAD>.........";
Ну уже почувствовали,насколько это здорово.А вот еще примерчик.Это из
разряда того, что тэги бывают разные.Например в Explorer есть тэг
BGSOUND предназначеный для проигрывани музыки на страничке.(В
Netscape этого тега нет,и поэтому для втыкания музыки приходится
использовать подключаемые модули plugin).Мутится с этими Плугинами Вам в
облом,а хочется побаловать человека хорошей музыкой,если браузер позволяет. ...
...
if($ENV{'HTTP_USER_AGENT'}=~/msie/i){
print "<BGSOUND src=\"jmj00.mid\">";
}
elsif($ENV{'HTTP_USER_AGENT'}=~/mozilla/i){
#Оставлю сдесь коментарий,что воткну что-нибудь типа музыки,для Netscap'а ,
#Когда мне не будет так в облом это делать.......
}
Ну вот вы уже можете управлять этим процессом.Только не забывайте,что
если вы не получили информацию о клиенте(так может быть,если например ваш скрипт
вызвал какая-нибудь поисковая машина) то не в этом случае не надо делать никаких
предположений,а просто пусть ваш скрипт продолжает делать то что должен был
делать. #!/usr/bin/perl
#download.cgi
sub urldecode{
local($val)=@_;
$val=~s/\+/ /g;
$val=~s/%([0-9a-hA-H]{2})/pack('C',hex($1))/ge;
return $val;
}
@Filelist=qw(index.html readme.txt jmj00.mid gunshot.wav foto.gif);
@Sel_list=();
if($ENV{'REQUEST_METHOD'} eq 'GET'){$query=$ENV{'QUERY_STRING'};}
elsif($ENV{'REQUEST_METHOD'} eq 'POST'){sysread(STDIN,$query,$ENV{'CONTENT_LENGTH'});}
if($query eq ''){
#Если никаких данных не подано на обработку,то сгенерируем форму,
#которую и предложим заполнить пользователю.
print "Content-Type: text/html\n\n";
print "<HTML><HEAD><TITLE>File Downloading</TITLE></HEAD>";
print "<BODY bgcolor=\"white\">";
print "Выберите файлы которые вы хотите загрузить:<BR>";
print "<FORM METHOD=\"POST\">";
print "<SELECT NAME=\"file\" size=4 multiple>";
foreach(@Filelist){
print "<OPTION value=\"$_\">$_";
}
print "</SELECT><BR>";
print "<INPUT TYPE=\"Submit\" value=\"Download!\">";
print "</FORM>";
print "</BODY></HTML>"
}
else{
@formfields=split(/&/,$query);
foreach(@formfields){
if(/^file=(.*)/){push(@Sel_list,urldecode($1));}
}
unless(@Sel_list){
print "Content-Type: text/html\n\n";
print "<HTML><BODY><CENTER><H1>Вы должны выбрать что-то из списка";
print "</H1></CENTER></BODY></HTML>";
}
else{
print "Content-Type: multipart/mixed;boundary=\"bhy3e23r4t34tnehtpo7678nneu4232y213vdg\"\n\n";
print "--bhy3e23r4t34tnehtpo7678nneu4232y213vdg\n";
foreach(@Sel_list){
print "Content-Type: application/x-qwerty; name=\"$_\"\n\n";
open(F,"$_");
print <F>;
close(F);
print "\n--bhy3e23r4t34tnehtpo7678nneu4232y213vdg\n";
}
print "Content-Type: text/html\n\n";
print "<HTML><H1>Thats all folks!</H1></HTML>";
print "\n--bhy3e23r4t34tnehtpo7678nneu4232y213vdg--\n";
}
}
<FORM action="http://......cgi" method="GET"|"POST" enctype="encodingType"
name="formName" target="windowName" onSubmit="Handler">
</FORM>
Атрибуты:<FORM action="http://www.uic.nnov.ru/~paaa/cgi-bin/test.cgi" method="POST"> .........Поля формы......... </FORM>Форма может содержать элементы.Элементы имеют имена,которые используются дл кодирования пар имя=значение.Некоторые Элементы не передаются CGI,а используются JavaScript для управления,например кнопки.Некоторые поля передаются только в тех случаях, когда в них что-то выбрано,например списки и переключатели.Остальные поля передаются всегда, даже когда они пустые.
<FORM action="http://www.doom/cgi-bin/test.cgi"> Your Name:<INPUT name="Name"><BR> E-Mail:<INPUT name="Email"><BR> Are you doomer:<INPUT type="checkbox" name="doomer" value="Yes"> <INPUT type="submit" value="Send Form!"> </FORM>Допустим вы ввели имя lesha и адрес paaa@uic.nnov.ru,при этом выбрали переключатель После нажатия кнопки будет отправлен вот такой запрос:
<FORM onSubmit="return false;">
<INPUT type="button" value="Просто Кнопочка"
onClick="alert('Нажали на кнопку!');">
</FORM>
|
<FORM onSubmit="alert('Нечего Посылать!');return false;">
<INPUT type="Submit" value="Послать!">
</FORM>
|
<FORM onSubmit="return false;"> <INPUT name="something"><BR> <INPUT type="reset" value="Очистить!"> </FORM> |
<FORM onSubmit="return false;">
<INPUT name="something" size=30
value="Введите что-нибудь">
</FORM>
|
<TEXTAREA name="textareaName" rows="число" cols="число" wrap="hard"|"soft"> TextToEdit </TEXTAREA>Область многострочного редактирования.Размеры в строках и столбцах задаютс атрибутами rows и cols.Значения атрибута wrap "hard" и "soft" -означают соответственно мягкую или жесткую разбивку на строки (в большинстве случаев ето не существенно). На что следует действительно обратить внимание так это на символ,используемый для указания перехода на новую строку. В Windows это '\r\n' а в Unix '\n',так что если это для вас существенно,то приводите преобразование,например так:
<FORM onSubmit="return false;"> <TEXTAREA name="MyText" rows=7 cols=30> Тут можно что-нибудь написать </TEXTAREA> </FORM> |
<FORM onSubmit="return false;">
Пароль:
<INPUT type="password"
name="yourpass" size=30>
</FORM>
|
<FORM onSubmit="return false;"> Этого сдесь вам не видно,поле-скрытое. <INPUT type="hidden" name="formNum" value="3"> </FORM> |
<FORM onSubmit="return false;">
<INPUT type="checkbox" name="inet" value="Yes"
checked>Доступ к Интернет
</FORM>
|
<FORM onSubmit="return false;"> Вы уверены?<BR> <INPUT type="radio" name="Radbut" checked>Yes <INPUT type="radio" name="Radbut">No </FORM> |
<SELECT name="SelectName" size=число [multiple] [обработчики] > <OPTION value="optionValue1" [selected]>Опция 1 <OPTION value="optionValue2" [selected]>Опция 2 <OPTION value="optionValue3" [selected]>Опция 3 ..... <OPTION value="optionValueN" [selected]>Опция N </SELECT>Задает список,позволяющий выбрать одну (или несколько) опций из списка. Если атрибут multiple не указан,то создается простой выпадающий список,в котором можно выбрать только одну из опций.Его значение всегда передается,т.к. всегда хоть одно выбрано. Если указан атрибут multiple,то во первых можно указать размер видимой части списка атрибутом size (Если опций больше появится скролинг).Во вторых передаются только выбраные опции ,т.е.Он может передатся несколько раз ?SelectName=opt1&SelectName=opt2&SelectName=opt9 если выбраны скажем несколько опций.А может и не разу,если ничего не выбрано из списка. Можно задавать обработчики onBlur,onChange,onFocus.
<FORM onSubmit="return false;"> Ваш цвет:<BR> <SELECT name="singleSel"> <OPTION value="white">Белый <OPTION value="black">Черный <OPTION value="magenta">Фиолетовый <OPTION value="green">Зеленый <OPTION value="red">Красный </FORM> |
<FORM onSubmit="return false;"> Какие сорта пива вы пили:<BR> <SELECT name="miltiSel" multiple size=4> <OPTION value="Балтика">Балтика <OPTION value="Толстяк">Толстяк <OPTION value="Премьер">Премьер <OPTION value="Хольстен">Хольстен <OPTION value="Бавария">Бавари <OPTION value="Coca-Cola ;)">Coca-Cola ;) </SELECT> </FORM> |
<HTML><HEAD>
<SCRIPT language="JavaScript">
<!--
function IsNumber(data){
var NumStr="0123456789";
var ch;var count;
for(var i=0;i<data.length;i++){
ch=data.substring(i,i+1);
if(NumStr.indexOf(ch)!=-1)count++;
}
if(counter==data.length)return true;
else return false;
}
function IsEmpty(data){
if(data.length==0)return true;
else return false;
}
function IsFormOk(f){
if(IsEmpty(f.Name.value)){
alert('Имя не должно быть пустой строкой');
return false;
}
if(!IsNumber(f.Age.value)){
alert('Возраст должен состоять из цифр');
return false;
}
return true;
}
//--></SCRIPT></HEAD>
<BODY>
<FORM action="http://www.test.ru/cgi-bin/test.cgi" onSubmit="IsFormOk(this.form)">
Your Name:<INPUT name="Name"><BR>
Your age:<INPUT name="Age"><BR>
<INPUT type="submit" value="Послать Данные">
</FORM>
</BODY></HTML>
Ну вот ,на этом можно закончить это краткое введение в HTMLые
формы. if($ENV{'REQUEST_METHOD'} eq 'GET'){#Анализируем метод,GET или POST
$query=$ENV{'QUERY_STRING'};
}
elsif($ENV{'REQUEST_METHOD'} eq 'POST'){
sysread(STDIN,$query,$ENV{'CONTENT_LENGTH'});
}
Вот,мы уже считали наш запрос в переменную $query.Теперь пришло
самое время ее обработать. Мы знаем что поля разделены символом '&'
значит используем его в качестве разделителя функции split: @formfields=split(/&/,$query);Вот разделили,а теперь организуем цикл foreach по полученым полям @formfields
foreach(@formfields){
if(/^Name=(.*)/){$name=urldecode($1);}
if(/^Age=(.*)/){$age=urldecode($1);}
}
Сдесь выражение в регулярном выражении в круглых скобках (.*) после
знака '=',запоминаетс в скалярную переменную $1 ,которая затем и
декодируется нашей старой и знакомой функцией urldecode (я
предупреждал,что она будет почти в каждой вашей CGI-программе) sub urldecode{ #очень полезная функция декодировани
local($val)=@_; #запроса,будет почти в каждой вашей CGI-программе
$val=~s/\+/ /g;
$val=~s/%([0-9a-hA-H]{2})/pack('C',hex($1))/ge;
return $val;
}
Так мы проходим по всем полям,которые нам переданы.Это стандартный
подход,он годится в качестве шаблона.У вас может возникнуть вопрос,а что
делать если вам переданы данные от списка у которого задана возможность выбора
нескольких элементов и данные поступают в таком виде:
Sel=opt1&Sel=opt2&Sel=opt9. Тут тоже нет никаких проблем,просто
запихиваем эти поступающие значения в массив. foreach(@formfields){
.....
if(/^Sel=(.*)/){push @Sel,urldecode($1);}
.....
}
И потом спокойно оперируем с Полученым Массивом @Sel.<HTML><!-- HTML файл с формой,можете повесить его себе на сайт! ->
<HEAD><TITLE>Социологический опрос насчет курения</TITLE></HEAD>
<BODY>
<CENTER><H1>Социологический опрос насчет курения</H1></CENTER>
<FORM action="cgi-bin/smoketest.cgi">
<TABLE>
<TR><TD>Ваш возраст:</TD><TD><INPUT name="age"></TD></TR>
<TR><TD>Вы курите(Y/N):</TD>
<TD><INPUT type="radio" name="smoke" value="Yes" checked>Да
<INPUT type="radio" name="smoke" value="No">Нет</TD></TR>
<TR><TD>Как вы относитесь если рядом кто-то курит?</TD>
<TD><SELECT name="sm_near">
<OPTION value="0">Резко негативно
<OPTION value="1">Негативно
<OPTION value="2" selected>Мне все равно
<OPTION value="3">Позитивно
<OPTION value="4">Резко позитивно
</SELECT>
</TD></TR>
<TR><TD>Сколько вы выкуриваете в день?</TD>
<TD><SELECT name="sm_day">
<OPTION value="0">Ни сколько
<OPTION value="1">1 сигарету
<OPTION value="2">2 сигареты
<OPTION value="5">около 5
<OPTION value="0.5pac">полпачки
<OPTION value="pac">пачку
<OPTION value="2pac">2 пачки
<OPTION value="more">больше
</SELECT>
</TD></TR>
<TR><TD>Как давно вы начали курить?</TD>
<TD><SELECT name="sm_stage">
<OPTION value="noatall">Не начинал
<OPTION value="onetime">Бросил
<OPTION value="0.5year">Полгода
<OPTION value="1year">Год
<OPTION value="2year">2 Года
<OPTION value="5year">5 Лет
<OPTION value="more">Больше
</SELECT>
</TD></TR>
<TR><TD>Считаете ли вы это опасным для своего здоровья?</TD>
<TD><SELECT name="sm_danger">
<OPTION value="0">Очень Опасно
<OPTION value="1">Думаю,что да
<OPTION value="2" selected>Не знаю
<OPTION value="3">Может самую малость
<OPTION value="4">Нет,Безопасно.
</SELECT>
</TD></TR>
<TR><TD>Хотите ли вы бросить?</TD>
<TD><SELECT name="sm_nosmoke">
<OPTION value="0">Уже бросаю
<OPTION value="1">Думаю бросить
<OPTION value="2" selected>Иногда
<OPTION value="3">Очень Редко
<OPTION value="4">Никогда.
</SELECT>
</TD></TR>
<TR><TD><INPUT type="submit" value="Послать Данные"></TD>
<TD><INPUT type="reset" value="Очистить Форму"></TD></TR>
</TABLE>
</FORM>
</BODY></HTML>
А вот скрипт для его обработки: #!/usr/bin/perl
#smoketest.cgi
$datafile="smoke.dat";
sub urldecode{
local($val)=@_;
$val=~s/\+/ /g;
$val=~s/%([0-9a-hA-H]{2})/pack('C',hex($1))/ge;
return $val;
}
sub print_err{
print "Content-Type: text/html\n\n";
print "<HTML><HEAD><TITLE>Error!!</TITLE></HEAD>";
print "<BODY><CENTER><H1>@_</H1>";
print "</BODY></HTML>";
exit;
}
if($ENV{'REQUEST_METHOD'} eq 'GET'){$query=$ENV{'QUERY_STRING'};}
elsif($ENV{'REQUEST_METHOD'} eq 'POST')
{sysread(STDIN,$query,$ENV{'CONTENT_LENGTH'});}
if($query ne ''){
@formfields=split(/&/,$query);
foreach(@formfields){
if(/^age=(.*)/){$age=urldecode($1);}
if(/^smoke=(.*)/){$smoke=urldecode($1);}
if(/^sm_near=(.*)/){$sm_near=urldecode($1);}
if(/^sm_day=(.*)/){$sm_day=urldecode($1);}
if(/^sm_stage=(.*)/){$sm_stage=urldecode($1);}
if(/^sm_danger=(.*)/){$sm_danger=urldecode($1);}
if(/^sm_nosmoke=(.*)/){$sm_nosmoke=urldecode($1);}
}
if((!$age)||($age=~/\D/)){
print "Content-Type: text/html\n\n";
print "<HTML><BODY><H2>Возраст введен неправильно,должен состоять из цифр.</H2>";
print "<FORM><INPUT type=\"button\" value=\"Вернуться назад к Анкете\"";
print "onClick=\"history.back();\"></FORM>";
print "</BODY></HTML>";
}
$anket_str=join('\t',($age,$smoke,$sm_near,$sm_day,$sm_stage,$sm_danger,$sm_nosmoke));
open(DATA,">>$datafile") || print_err("Cannot open $datafile $!");
print DATA "$anket_str\n";
close(DATA);
}
open(DATA,"$datafile") || print_err("Cannot open $datafile $!");
@AllData=<DATA>;
close(DATA);
$total=$#AllData;
foreach(@AllData){
($age,$smoke,$sm_near,$sm_day,$sm_stage,$sm_danger,$sm_nosmoke)=split(/\t/,$_);
$smok_total++ if ($smoke eq 'Yes');
$nosmok_total++ if ($smoke eq 'No');
if($age<16){$age16_total++;
if($smoke eq 'Yes'){$age16_sm++;}else{$age16_nosm++;}
}
if(($age>16)&&($age<=18)){$age16_18_total++;
if($smoke eq 'Yes'){$age16_18_sm++;}else{$age16_18_nosm++;}
}
if(($age>18)&&($age<=20)){$age18_20_total++;
if($smoke eq 'Yes'){$age18_20_sm++;}else{$age18_20_nosm++;}
}
if($age>20){$age20_total++;
if($smoke eq 'Yes'){$age20_sm++;}else{$age20_nosm++;}
}
if($sm_near eq '0'){$near0++;}
if($sm_near eq '1'){$near1++;}
if($sm_near eq '2'){$near2++;}
if($sm_near eq '3'){$near3++;}
if($sm_near eq '4'){$near4++;}
if($sm_day eq '0'){$day0++;}
if($sm_day eq '1'){$day1++;}
if($sm_day eq '2'){$day2++;}
if($sm_day eq '5'){$day5++;}
if($sm_day eq '0.5pac'){$dayhalfpac++;}
if($sm_day eq 'pac'){$daypac++;}
if($sm_day eq '2pac'){$day2pac++;}
if($sm_day eq 'more'){$daymore++;}
if($sm_stage eq 'noatall'){$stagenoatall++;}
if($sm_stage eq 'onetime'){$statgeonetime++;}
if($sm_stage eq '0.5year'){$stagehalfyear++;}
if($sm_stage eq '1year'){$stage1year++;}
if($sm_stage eq '2year'){$stage2year++;}
if($sm_stage eq '5year'){$stage5year++;}
if($sm_stage eq 'more'){$stagemore++;}
if($sm_danger eq '0'){$danger0++;}
if($sm_danger eq '1'){$danger1++;}
if($sm_danger eq '2'){$danger2++;}
if($sm_danger eq '3'){$danger3++;}
if($sm_danger eq '4'){$danger4++;}
if($sm_nosmoke eq '0'){$stopsmoke0++;}
if($sm_nosmoke eq '1'){$stopsmoke1++;}
if($sm_nosmoke eq '2'){$stopsmoke2++;}
if($sm_nosmoke eq '3'){$stopsmoke3++;}
if($sm_nosmoke eq '4'){$stopsmoke4++;}
}
#########
print "Content-Type: text/html\n\n";
print "<HTML><HEAD><TITLE>Результаты обработки данных</TITLE></HEAD>";
print "<BODY bgcolor=\"yellow\">";
unless($total){print "<H1>Еще нет данных</H1></BODY></HTML>";exit;}
print "<CENTER><H1>Результаты обработки данных</H1></CENTER>";
print "<BR>\n";
print "Обработано анкет: $total<BR>\n";
print "Общие данные Всего:<BR>\n";
print "Курящие:$smok_total (".(($smok_total/$total)*100) ."%)<BR>\n";
print "Некурящие:$nosmok_total (".(($nosmok_total/$total)*100)."%)<BR>\n";
print "<TABLE>\n";
print "<TR><TD colspan=4>Возрастные группы:(<16,16..18,18..20,>20)</TD></TR>\n";
print "<TR><TD>Возраст</TD><TD>Курящие</TD><TD>Некурящие</TD><TD>Всего</TD></TR>\n";
print "<TR><TD><16:</TD><TD>$age16_sm</TD><TD>$age16_nosm</TD><TD>$age16_total</TD></TR>\n";
print "<TR><TD>16..18:</TD><TD>$age16_18_sm</TD><TD>$age16_18_nosm</TD><TD>$age16_18_total</TD></TR>\n";
print "<TR><TD>18..20:</TD><TD>$age18_20_sm</TD><TD>$age18_20_nosm</TD><TD>$age18_20_total</TD></TR>\n";
print "<TR><TD>>20:</TD><TD>$age20_sm</TD><TD>$age20_nosm</TD><TD>$age20_total</TD></TR>";
print "</TABLE>\n";
print "<TABLE>\n";
print "<TR><TD colspan=2>Отношение когда кто-то курит рядом:(%)</TD></TR>\n";
print "<TR><TD>Резко негативно</TD><TD>".(($near0/$total)*100)."</TD></TR>\n";
print "<TR><TD>Негативно </TD><TD>".(($near1/$total)*100)."</TD></TR>\n";
print "<TR><TD>Мне все равно </TD><TD>".(($near2/$total)*100)."</TD></TR>\n";
print "<TR><TD>Позитивно </TD><TD>".(($near3/$total)*100)."</TD></TR>\n";
print "<TR><TD>Резко позитивно</TD><TD>".(($near4/$total)*100)."</TD></TR>\n";
print "</TABLE>\n";
print "<TABLE>\n";
print "<TR><TD colspan=2>В среднем выкуривают:(%)</TD></TR>\n";
print "<TR><TD>не курят: </TD><TD>".(($day0/$total)*100)."</TD></TR>\n";
print "<TR><TD>1 сигарету:</TD><TD>".(($day1/$total)*100)."</TD></TR>\n";
print "<TR><TD>2 сигареты:</TD><TD>".(($day2/$total)*100)."</TD></TR>\n";
print "<TR><TD>5 сигарет: </TD><TD>".(($day5/$total)*100)."</TD></TR>\n";
print "<TR><TD>полпачки: </TD><TD>".(($dayhalfpac/$total)*100)."</TD></TR>\n";
print "<TR><TD>пачку: </TD><TD>".(($daypac/$total)*100)."</TD></TR>\n";
print "<TR><TD>2 пачки: </TD><TD>".(($day2pac/$total)*100)."</TD></TR>\n";
print "<TR><TD>больше: </TD><TD>".(($daymore/$total)*100)."</TD></TR>\n";
print "</TABLE>\n";
print "<TABLE>\n";
print "<TR><TD colspan=2>Стаж курения:(%)</TD></TR>\n";
print "<TR><TD>Не начинал</TD><TD>".(($stagenoatall /$total)*100)."</TD></TR>\n";
print "<TR><TD>Бросил </TD><TD>".(($statgeonetime/$total)*100)."</TD></TR>\n";
print "<TR><TD>Полгода </TD><TD>".(($stagehalfyear/$total)*100)."</TD></TR>\n";
print "<TR><TD>Год </TD><TD>".(($stage1year /$total)*100)."</TD></TR>\n";
print "<TR><TD>2 Года </TD><TD>".(($stage2year /$total)*100)."</TD></TR>\n";
print "<TR><TD>5 Лет </TD><TD>".(($stage5year /$total)*100)."</TD></TR>\n";
print "<TR><TD>Больше </TD><TD>".(($stagemore /$total)*100)."</TD></TR>\n";
print "</TABLE>\n";
print "<TABLE>\n";
print "<TR><TD colspan=2>Курение опасно:(%)</TD></TR>\n";
print "<TR><TD>Очень Опасно </TD><TD>".(($danger0/$total)*100)."</TD></TR>\n";
print "<TR><TD>Думаю,что да </TD><TD>".(($danger1/$total)*100)."</TD></TR>\n";
print "<TR><TD>Не знаю </TD><TD>".(($danger2/$total)*100)."</TD></TR>\n";
print "<TR><TD>Может самую малость</TD><TD>".(($danger3/$total)*100)."</TD></TR>\n";
print "<TR><TD>Нет,Безопасно. </TD><TD>".(($danger4/$total)*100)."</TD></TR>\n";
print "</TABLE>\n";
print "<TABLE>\n";
print "<TR><TD colspan=2>Хотели ли вы бросить:(%)</TD></TR>\n";
print "<TR><TD>Уже бросаю </TD><TD>".(($stopsmoke0/$total)*100)."</TD></TR>\n";
print "<TR><TD>Думаю бросить</TD><TD>".(($stopsmoke1/$total)*100)."</TD></TR>\n";
print "<TR><TD>Иногда </TD><TD>".(($stopsmoke2/$total)*100)."</TD></TR>\n";
print "<TR><TD>Очень Редко </TD><TD>".(($stopsmoke3/$total)*100)."</TD></TR>\n";
print "<TR><TD>Никогда. </TD><TD>".(($stopsmoke4/$total)*100)."</TD></TR>\n";
print "</TABLE>\n";
print "</BODY></HTML>";
<A href="cgi-bin/somescript.cgi"><IMG src="somepic.gif" border=0 ismap></A>Заметьте что все отличие заключается в том,что в тэге IMG добавлен атрибут ismap. Он говорит браузеру,что когда пользователь щелкнет на картинке то нужно перейти не просто к URL указаному в <A href="URL"> а что нужно к этому URL добавить координаты той точки по которой пользователь щелкнул мышью .
http://www.somehost.ru/cgi-bin/somescript.cgi?10,15Т.е. координаты идут на скрипте в переменную QUERY_STRING ,их оттуда извлечь? Нет ничего проще:
($x,$y)=split(/,/,$ENV{'QUERY_STRING'});Вот скрипт,который
просто показывает координаты точки щелчка: #!/usr/bin/perl
#ismap_xy.cgi
($x,$y)=split(/,/,$ENV{'QUERY_STRING'});
print "Content-Type: text/html\n\n";
print "<HTML><HEAD><TITLE>Ismap X Y</TITLE></HEAD>";
print "<BODY><H1>Вы щелкнули в точке: x=$x ,y=$y</H1></BODY></HTML>";
А что с ними делать дальше это уже чисто зависит только от вашей
фантазии.Дайте ей ход и все у вас получится!.Очень часто ismap
применяют для графического оглавления сайта. Когда щелкают на разные части
рисунка,то переходят к разным страничкам сайта. Это легко
реализуется,если скрипт выдаст нужный URL в Location: (Вспомните
заголовок
ответа CGI). minx miny maxx maxy URLгде minx miny maxx maxy задают участок рисунка,а следующее за ними поле задает URL, которому этот участок соответствует.Пример:
1 1 20 50 http://www.uic.nnov.ru/~paaa/index_p.html 1 50 20 100 http://www.uic.nnov.ru/~paaa/projects.html 20 1 100 100 http://www.uic.nnov.ru/~paaa/cgi-bin/guestbook.cgiГде нибудь на своей страничке воткните что-то вроде:
<A href="cgi-bin/testismap.cgi"><IMG src="gifs/doom2.jpg" border=0 ismap></A>А сам скрипт testismap.cgi будет иметь вот такой простенький вид:
#!/usr/bin/perl
#testismap.cgi
$default_url="http://www.uic.nnov.ru/~paaa/";#URL по умолчанию,переходим к нему когда щелкнули
#в участок,которому не сопоставлен URL
$url_map_file="urlmap.txt"; #файл с информацией об URL
($x,$y)=split(/,/,$ENV{'QUERY_STRING'});
open(F,"$url_map_file")|| print "Location: $default_url\n\n";
$url=$default_url;
foreach(<F>){
chomp;
($minx,$miny,$maxx,$maxy,$URL)=split(/\s+/);
if(($x>=$minx)&&($x<$maxx)&&
($y>=$miny)&&($x<$maxy)){$url=$URL;}
}
close(F);
print "Location: $url\n\n";
#!/usr/bin/perl
#nph-animate2.cgi
$delay=3;
@files = qw(img0.gif img1.gif img2.gif img3.gif);
select (STDOUT);
$|=1; #autoflush mode on
#Generate header
print "HTTP/1.0 200 Okay\n";
print "Content-Type: multipart/x-mixed-replace;boundary=myboundary\n\n";
srand;
print "--myboundary\n";
while(1){
$file=$files[int(rand($#files))]; #random file
print "Content-Type: image/gif\n\n";
open(PIC,"$file");
print <PIC>;
close(PIC);
print "\n--myboundary\n";
sleep($delay);
}
Конечно одно из самых примитивных применений такой системы.Более
мощным примером могло бы послужить отслеживание на сервере какого-нибудь
периодически изменяющегося файла и пересылка пользователю обновленной
версии.#!/usr/bin/perl
#test.cgi
print "Content-Type: text/html\n\n";
print "<HTML>Test</HTML>";
exit; #Программа как вы понимаете выполняется только до етого места
#
#if($ENV{'REQUEST_METHOD'} eq 'GET'){$query=$ENV{'QUERY_STRING'}}
#else{sysread STDIN,$query,$ENV{'CONTENT_LENGTH'};}
#if($query eq ''){
# @formfields=split /&/,$query;
# .......
# ........
А теперь запускайте скрипт.Естественно он выдаст Одно только
слово 'Test'. Разкоментируйте несколько строчек.Еще раз
запустите скрипт.Он опять выдаст 'Test'. Значит
синтаксически эти только что разкоментированые строчки были
правильные. И так далее....sub debug_err{
open(DEBUGFILE,">>debug.txt");
print DEBUGFILE $ENV{'SCRIPT_NAME'}.' '.scalar localtime.' '.@_."\n";
close(DEBUGFILE);
}
Примеры использования (Напомню,что встроеная переменная Perl
$! содержит сообщение о причине последней ошибки,поэтому включайте
ее всегда в свои сообщения): open(F,"+<$myfile") || debug_err("Cannot open $myfile $!");
seek(F,0,0) || debug_err("Cannot seek $myfile $!");
connect(SOCKET,$paddr)|| debug_err("Cannot connect to $remote $!");
......
Потом можно периодически заглядывать в этот файл debug.txt и
смотреть,какие ошибки встречались при работе ваших скриптов.Таким образом ваши
скрипты сами помогать будут в своей отладке ;).#!/usr/bin/perl
#delcr
unless(@ARGV){die "Usage: delcr file ....\n";}
foreach $file(@ARGV){
if(! -r $file || ! -w $file){print "$file: access denied\n";}
else{
open(F,"+<$file")|| die "Cannot open $file $!\n";
binmode(F) || die "Cannot binmode $file $!\n";
@D=<F>;
seek(F,0,0);
foreach(@D){
s/\r//g;
print F;
}
truncate(F,tell(F));
close(F);
}
}
Саму же взаимную перекодировку Dos<->koi-8<->Win
поможет выполнить вот такая прога. Написал я ее очень давно, даже раньше чем
занялся CGI программированием и с тех давних пор она меня все
время выручала, став моим по-настоящему незаменимым и верным другом.
Итак, знакомьтесь: txtconv -Утилита перевода раскладок символов. #include<stdio.h>
#include<string.h>
/*****************/
char tbldw[256]={
0x0,0x1,0x2,0x3,0x4,0x5,0x6,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf,
0x10,0x11,0x12,0x13,0x14,0x15,0x16,0x17,0x18,0x19,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,
0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28,0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f,
0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,0x3a,0x3b,0x3c,0x3d,0x3e,0x3f,
0x40,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f,
0x50,0x51,0x52,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5a,0x5b,0x5c,0x5d,0x5e,0x5f,
0x60,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,0x6a,0x6b,0x6c,0x6d,0x6e,0x6f,
0x70,0x71,0x72,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7a,0x7b,0x7c,0x7d,0x7e,0x7f,
0xc0,0xc1,0xc2,0xc3,0xc4,0xc5,0xc6,0xc7,0xc8,0xc9,0xca,0xcb,0xcc,0xcd,0xce,0xcf,
0xd0,0xd1,0xd2,0xd3,0xd4,0xd5,0xd6,0xd7,0xd8,0xd9,0xda,0xdb,0xdc,0xdd,0xde,0xdf,
0xe0,0xe1,0xe2,0xe3,0xe4,0xe5,0xe6,0xe7,0xe8,0xe9,0xea,0xeb,0xec,0xed,0xee,0xef,
0x5f,0x5f,0x5f,0xa6,0xa6,0xa6,0xa6,0x2b,0x2b,0xa6,0xa6,0x2b,0x2b,0x2b,0x2b,0x2b,
0x2b,0x2d,0x2d,0x2b,0x2d,0x2b,0xa6,0xa6,0x2b,0x2b,0x2d,0x2d,0xa6,0x2d,0x2b,0x2d,
0x2d,0x2d,0x2d,0x2b,0x2b,0x2b,0x2b,0x2b,0x2b,0x2b,0x2b,0x5f,0x5f,0x5f,0x5f,0x5f,
0xf0,0xf1,0xf2,0xf3,0xf4,0xf5,0xf6,0xf7,0xf8,0xf9,0xfa,0xfb,0xfc,0xfd,0xfe,0xff,
0xa8,0xb8,0xaa,0xba,0xaf,0xbf,0xa1,0xa2,0xb0,0x95,0xb7,0x5f,0xb9,0xa4,0x5f,0x5f
};
char tblwd[256]={
0x0,0x1,0x2,0x3,0x4,0x5,0x6,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf,
0x10,0x11,0x12,0x13,0x14,0x15,0x16,0x17,0x18,0x19,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,
0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28,0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f,
0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,0x3a,0x3b,0x3c,0x3d,0x3e,0x3f,
0x40,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f,
0x50,0x51,0x52,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5a,0x5b,0x5c,0x5d,0x5e,0x5f,
0x60,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,0x6a,0x6b,0x6c,0x6d,0x6e,0x6f,
0x70,0x71,0x72,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7a,0x7b,0x7c,0x7d,0x7e,0x7f,
0x5f,0x5f,0x5f,0x5f,0x5f,0x5f,0x5f,0x5f,0x5f,0x5f,0x5f,0x5f,0x5f,0x5f,0x5f,0x5f,
0x5f,0x5f,0x5f,0x5f,0x5f,0xf9,0x5f,0x5f,0x5f,0x5f,0x5f,0x5f,0x5f,0x5f,0x5f,0x5f,
0x5f,0xf6,0xf7,0x5f,0xfd,0x5f,0x7c,0x15,0xf0,0x63,0xf2,0x11,0x2d,0x2d,0x72,0xf4,
0xf8,0x5f,0x49,0x69,0x5f,0x5f,0x14,0xfa,0xf1,0xfc,0xf3,0x10,0x5f,0x5f,0x5f,0xf5,
0x80,0x81,0x82,0x83,0x84,0x85,0x86,0x87,0x88,0x89,0x8a,0x8b,0x8c,0x8d,0x8e,0x8f,
0x90,0x91,0x92,0x93,0x94,0x95,0x96,0x97,0x98,0x99,0x9a,0x9b,0x9c,0x9d,0x9e,0x9f,
0xa0,0xa1,0xa2,0xa3,0xa4,0xa5,0xa6,0xa7,0xa8,0xa9,0xaa,0xab,0xac,0xad,0xae,0xaf,
0xe0,0xe1,0xe2,0xe3,0xe4,0xe5,0xe6,0xe7,0xe8,0xe9,0xea,0xeb,0xec,0xed,0xee,0xef
};
char tbl_asc[256]={
0x0,0x1,0x2,0x3,0x4,0x5,0x6,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf,
0x10,0x11,0x12,0x13,0x14,0x15,0x16,0x17,0x18,0x19,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,
0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28,0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f,
0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,0x3a,0x3b,0x3c,0x3d,0x3e,0x3f,
0x40,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f,
0x50,0x51,0x52,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5a,0x5b,0x5c,0x5d,0x5e,0x5f,
0x60,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,0x6a,0x6b,0x6c,0x6d,0x6e,0x6f,
0x70,0x71,0x72,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7a,0x7b,0x7c,0x7d,0x7e,0x7f
};
char tbldu[256]={
0x0,0x1,0x2,0x3,0x4,0x5,0x6,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf,
0x10,0x11,0x12,0x13,0x14,0x15,0x16,0x17,0x18,0x19,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,
0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28,0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f,
0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,0x3a,0x3b,0x3c,0x3d,0x3e,0x3f,
0x40,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f,
0x50,0x51,0x52,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5a,0x5b,0x5c,0x5d,0x5e,0x5f,
0x60,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,0x6a,0x6b,0x6c,0x6d,0x6e,0x6f,
0x70,0x71,0x72,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7a,0x7b,0x7c,0x7d,0x7e,0x7f,
0xE1,0xE2,0xF7,0xE7,0xE4,0xE5,0xF6,0xFA,0xE9,0xEA,0xEB,0xEC,0xED,0xEE,0xEF,0xF0,
0xF2,0xF3,0xF4,0xF5,0xE6,0xE8,0xE3,0xFE,0xFB,0xFD,0xFF,0xF9,0xF8,0xFC,0xE0,0xF1,
0xC1,0xC2,0xD7,0xC7,0xC4,0xC5,0xD6,0xDA,0xC9,0xCA,0xCB,0xCC,0xCD,0xCE,0xCF,0xD0,
0x90,0x91,0x92,0x81,0x87,0xB2,0xB4,0xA7,0xA6,0xB5,0xA1,0xA8,0xAE,0xAD,0xAC,0x83,
0x84,0x89,0x88,0x86,0x80,0x8A,0xAF,0xB0,0xAB,0xA5,0xBB,0xB8,0xB1,0xA0,0xBE,0xB9,
0xBA,0xB6,0xB7,0xAA,0xA9,0xA2,0xA4,0xBD,0xBC,0x85,0x82,0x8D,0x8C,0x8E,0x8F,0x8B,
0xD2,0xD3,0xD4,0xD5,0xC6,0xC8,0xC3,0xDE,0xDB,0xDD,0xDF,0xD9,0xD8,0xDC,0xC0,0xD1,
0xB3,0xA3,0x99,0x98,0x93,0x9B,0x9F,0x97,0x9C,0x95,0x9E,0x96,0xBF,0x9D,0x94,0x9A
};
char tblud[256]={
0x0,0x1,0x2,0x3,0x4,0x5,0x6,0x7,0x8,0x9,0xa,0xb,0xc,0xd,0xe,0xf,
0x10,0x11,0x12,0x13,0x14,0x15,0x16,0x17,0x18,0x19,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,
0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28,0x29,0x2a,0x2b,0x2c,0x2d,0x2e,0x2f,
0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,0x3a,0x3b,0x3c,0x3d,0x3e,0x3f,
0x40,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f,
0x50,0x51,0x52,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5a,0x5b,0x5c,0x5d,0x5e,0x5f,
0x60,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,0x6a,0x6b,0x6c,0x6d,0x6e,0x6f,
0x70,0x71,0x72,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7a,0x7b,0x7c,0x7d,0x7e,0x7f,
0xC4,0xB3,0xDA,0xBF,0xC0,0xD9,0xC3,0xB4,0xC2,0xC1,0xC5,0xDF,0xDC,0xDB,0xDD,0xDE,
0xB0,0xB1,0xB2,0xF4,0xFE,0xF9,0xFB,0xF7,0xF3,0xF2,0xFF,0xF5,0xF8,0xFD,0xFA,0xF6,
0xCD,0xBA,0xD5,0xF1,0xD6,0xC9,0xB8,0xB7,0xBB,0xD4,0xD3,0xC8,0xBE,0xBD,0xBC,0xC6,
0xC7,0xCC,0xB5,0xF0,0xB6,0xB9,0xD1,0xD2,0xCB,0xCF,0xD0,0xCA,0xD8,0xD7,0xCE,0xFC,
0xEE,0xA0,0xA1,0xE6,0xA4,0xA5,0xE4,0xA3,0xE5,0xA8,0xA9,0xAA,0xAB,0xAC,0xAD,0xAE,
0xAF,0xEF,0xE0,0xE1,0xE2,0xE3,0xA6,0xA2,0xEC,0xEB,0xA7,0xE8,0xED,0xE9,0xE7,0xEA,
0x9E,0x80,0x81,0x96,0x84,0x85,0x94,0x83,0x95,0x88,0x89,0x8A,0x8B,0x8C,0x8D,0x8E,
0x8F,0x9F,0x90,0x91,0x92,0x93,0x86,0x82,0x9C,0x9B,0x87,0x98,0x9D,0x99,0x97,0x9A
};
char tbluw[256]={
0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0x0A,0x0B,0x0C,0x0D,0x0E,0x0F,
0x10,0x11,0x12,0x13,0x14,0x15,0x16,0x17,0x18,0x19,0x1A,0x1B,0x1C,0x1D,0x1E,0x1F,
0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28,0x29,0x2A,0x2B,0x2C,0x2D,0x2E,0x2F,
0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,0x3A,0x3B,0x3C,0x3D,0x3E,0x3F,
0x40,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,0x4A,0x4B,0x4C,0x4D,0x4E,0x4F,
0x50,0x51,0x52,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5A,0x5B,0x5C,0x5D,0x5E,0x5F,
0x60,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,0x6A,0x6B,0x6C,0x6D,0x6E,0x6F,
0x70,0x71,0x72,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7A,0x7B,0x7C,0x7D,0x7E,0x7F,
0x2D,0xA6,0x2B,0x2B,0x2B,0x2B,0x2B,0xA6,0x2D,0x2D,0x2B,0x5F,0x5F,0x5F,0x5F,0x5F,
0x5F,0x5F,0x5F,0xAF,0x5F,0x95,0x5F,0xA2,0xBA,0xAA,0x5F,0xBF,0xB0,0xA4,0xB7,0xA1,
0x2D,0xA6,0x2B,0xB8,0x2B,0x2B,0x2B,0x2B,0x2B,0x2B,0x2B,0x2B,0x2B,0x2B,0x2B,0xA6,
0xA6,0xA6,0xA6,0xA8,0xA6,0xA6,0x2D,0x2D,0x2D,0x2D,0x2D,0x2D,0x2B,0x2B,0x2B,0xB9,
0xFE,0xE0,0xE1,0xF6,0xE4,0xE5,0xF4,0xE3,0xF5,0xE8,0xE9,0xEA,0xEB,0xEC,0xED,0xEE,
0xEF,0xFF,0xF0,0xF1,0xF2,0xF3,0xE6,0xE2,0xFC,0xFB,0xE7,0xF8,0xFD,0xF9,0xF7,0xFA,
0xDE,0xC0,0xC1,0xD6,0xC4,0xC5,0xD4,0xC3,0xD5,0xC8,0xC9,0xCA,0xCB,0xCC,0xCD,0xCE,
0xCF,0xDF,0xD0,0xD1,0xD2,0xD3,0xC6,0xC2,0xDC,0xDB,0xC7,0xD8,0xDD,0xD9,0xD7,0xDA
};
char tblwu[256]={
0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0x0A,0x0B,0x0C,0x0D,0x0E,0x0F,
0x10,0x11,0x12,0x13,0x14,0x15,0x16,0x17,0x18,0x19,0x1A,0x1B,0x1C,0x1D,0x1E,0x1F,
0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28,0x29,0x2A,0x2B,0x2C,0x2D,0x2E,0x2F,
0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,0x3A,0x3B,0x3C,0x3D,0x3E,0x3F,
0x40,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,0x4A,0x4B,0x4C,0x4D,0x4E,0x4F,
0x50,0x51,0x52,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5A,0x5B,0x5C,0x5D,0x5E,0x5F,
0x60,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,0x6A,0x6B,0x6C,0x6D,0x6E,0x6F,
0x70,0x71,0x72,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7A,0x7B,0x7C,0x7D,0x7E,0x7F,
0x5F,0x5F,0x5F,0x5F,0x5F,0x5F,0x5F,0x5F,0x5F,0x5F,0x5F,0x5F,0x5F,0x5F,0x5F,0x5F,
0x5F,0x5F,0x5F,0x5F,0x5F,0x95,0x5F,0x5F,0x5F,0x5F,0x5F,0x5F,0x5F,0x5F,0x5F,0x5F,
0x5F,0x9F,0x97,0x5F,0x9D,0x5F,0x7C,0x15,0xB3,0x63,0x99,0x11,0x2D,0x2D,0x72,0x93,
0x9C,0x5F,0x49,0x69,0x5F,0x5F,0x14,0x9E,0xA3,0xBF,0x98,0x10,0x5F,0x5F,0x5F,0x9B,
0xE1,0xE2,0xF7,0xE7,0xE4,0xE5,0xF6,0xFA,0xE9,0xEA,0xEB,0xEC,0xED,0xEE,0xEF,0xF0,
0xF2,0xF3,0xF4,0xF5,0xE6,0xE8,0xE3,0xFE,0xFB,0xFD,0xFF,0xF9,0xF8,0xFC,0xE0,0xF1,
0xC1,0xC2,0xD7,0xC7,0xC4,0xC5,0xD6,0xDA,0xC9,0xCA,0xCB,0xCC,0xCD,0xCE,0xCF,0xD0,
0xD2,0xD3,0xD4,0xD5,0xC6,0xC8,0xC3,0xDE,0xDB,0xDD,0xDF,0xD9,0xD8,0xDC,0xC0,0xD1
};
/*****************/
int convert(unsigned char *buff,unsigned char *Tbl,int count)
{
int i;
for(i=0;i<count;i++)buff[i]=Tbl[(unsigned)buff[i]];
return 0;
}
/*****************/
char szHelp[]=
"Text file converter (c)lesha 1998\n"
"Usage:txtconv <options> <srcfile> <dstfile>\n"
" options: -ud koi8->dos\n"
" -du dos->koi8\n"
" -uw koi8->win\n"
" -wu win->koi8\n"
" -dw dos->win\n"
" -wd win->dos\n"
" -? -This help\n";
int main(int argc,char *argv[])
{
FILE *f1;
FILE *f2;
char tmpbuff[1024];
char *xtbl=NULL;
int nr;
if((argc>1)&&(strcmp(argv[1],"-?")==0)){printf(szHelp);return 0;}
if(argc<4){printf(szHelp);return 0;}
if (strcmp(argv[1],"-ud")==0)xtbl=tblud;
else if(strcmp(argv[1],"-du")==0)xtbl=tbldu;
else if(strcmp(argv[1],"-uw")==0)xtbl=tbluw;
else if(strcmp(argv[1],"-wu")==0)xtbl=tblwu;
else if(strcmp(argv[1],"-dw")==0)xtbl=tbldw;
else if(strcmp(argv[1],"-wd")==0)xtbl=tblwd;
if(xtbl==NULL){printf("unknown option:%s",argv[1]);return 1;}
if((f1=fopen(argv[2],"rb"))==NULL){perror(argv[2]);return 1;}
if((f2=fopen(argv[3],"wb"))==NULL){fclose(f1);perror(argv[3]);return 1;}
while((nr=fread(tmpbuff,1,sizeof(tmpbuff),f1))>0)
{
convert(tmpbuff,xtbl,nr);
fwrite(tmpbuff,1,nr,f2);
}
fclose(f1);
fclose(f2);
return 0;
}
Это еще одна утилита,соторая поможет вам в тяжелой реальности
Интернета ;). Скомпилить ее можно под все три системы и используется она
после этого очень легко, особенно когда всегда под рукой.#!/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);
#!/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);
}
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'е).
#!/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);
}
Если вам циферки не понравились вы их легко сможете заменить.
