Я видел очень много скриптов на разных языках, которые рассказали бы мне о том, как узнать о своих посетителях. Но они все были очень странные и местами требовали непонятных мне вещей.
В силу того, что всю жизнь писал на Perl'е, подумал что неплохо бы разобраться как дела обстоят с решением подобной задачи.
Сама по себе задача тривиальна и решение её просто. Особенно на PHP.
Но я PHP не люблю. А перл никогда не использовал для web.
Посему за вечер был накидан вот такой код:
В .htaccess я написал вот что:
У себя в записи ЖЖ я пишу вот такую вещь:
Где
Вроде как необходимо указывать gif-пустышку, которая будет отдаваться, но то ли у меня достаточно современный браузер (Firefox 3.6.17), то ли я чего-то не понял, раскуривая маны, но скрипт вполне рабочий.
Хохмы ради из него можно слепить счётчик или еще чего полезное.
Этот пример скрипта скорее полезен тем, кто только начинает работать с вебом при помощи Perl'а (Это как раз про меня).
Показан простейший способ работы без монстроподобных модулей типа Mason или CGI, избежание 500-ой ошибки и всяких print «Text/plain\n\n»;
Спасибо.
В силу того, что всю жизнь писал на Perl'е, подумал что неплохо бы разобраться как дела обстоят с решением подобной задачи.
Сама по себе задача тривиальна и решение её просто. Особенно на PHP.
Но я PHP не люблю. А перл никогда не использовал для web.
Посему за вечер был накидан вот такой код:
#!/usr/bin/perl -w
# Указываем необходимые модули
use strict;
use warnings;
use CGI::WebOut(1);
use Mail::Mailer;
# Объявление переменных
my( $topic , $date , $ref , $flag , $tmp );
my( $query , $pair , $name , $value , $input );
my @pairs;
my %input;
my( $to_address , $subject , $mailer , $body , $from_address );
$date = `/bin/date "+%Y-%m-%d %H:%M"`; # Дата и её формат берём прямо из системы
$to_address = 'info@microsoft.com'; # Куда отсылать отчёт
$from_address = 'abuse@microsoft.com'; # От кого шлём
$flag = 0; # Флаг состояния
if( $ENV{'REQUEST_METHOD'} eq 'GET' ){ # Смотрим метод
$query=$ENV{'QUERY_STRING'};
}
elsif( $ENV{'REQUEST_METHOD'} eq 'POST' ){
sysread( STDIN , $query , $ENV{'CONTENT_LENGTH'});
}
$ref = $ENV{'HTTP_REFERER'}; # Смотрим откуда пришли
@pairs = split( /&/ , $query ); # Начинаем разбор параметров
foreach $pair ( @pairs ){
( $name , $value ) = split( /=/ , $pair ); # Параметр1=Значение1 (Пример)
if( defined( $name )){ # Если есть параметр
if( !( defined( $value ))){ # Но нет значения
next; # Идём дальше
}
}
$value =~ tr/+/ /; # Пробелы заменяем на плюсы
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex())/eg; # Пакуем
$value =~ s/<!--(.| )*-->//g; # Режем комментарии (А вдруг? =)
$input{$name} = $value; # Присваиваем значение
if( $name ne 'topic' ){ # Значение не Topic?
if( $flag == 0){ # И флаг состояние равен 0 ?
$flag = 0; # Всё равно ноль!
}
}
if( $name eq 'topic' ){ # О! А вот и топик!
$topic = $value; # Запоминаем значение
$body .= "Topic: $topic\n"; # Добавляем в тело письма
$flag++; # Флаг уже не ноль
}
# Следующим блоком можно указать, что отсылать можно куда-то еще,
# указав это в параметрах
# if( $name eq 'mail' ){
# if( !(length( $value ))){
# $value = 'info@microsoft.com';
# }
# }
}
if( !( defined( $flag ))){ ololo(); } # Флаг не нашли (Хотя как так? Он же у нас всё равно существует!
if( !( defined( $value ))){ ololo(); } # Значений нет...
if( $flag == 0 ){ ololo(); } # Да и флаг нулю равен
if( defined( $ENV{'REMOTE_ADDR'} )){
$body .= "Remote address: $ENV{'REMOTE_ADDR'}\n"; # Удаленный адрес у нас есть!
}
else{
$body .= "Remote address is unknown\n"; # Или нет...
}
if( defined( $ENV{'REMOTE_HOST'} )){
$body .= "Remote host: $ENV{'REMOTE_HOST'}\n"; # Имя хоста смогли отрезолвить
}
else{
$body .= "Remote host is unknown\n"; # Или это зарезано в конфиге апача
}
if( defined( $ref )){
$body .= "Referer: $ref\n"; # Откуда пришли мы знаем!
}
else{
$body .= "Referer is unknown\n"; # Или не знаем
}
$body .= "Date: $date\n"; # Поставим дату
$subject = "$topic at $date"; # Укажем топик письма
$mailer = Mail::Mailer->new(); # Создадим новый объект мейлера
$mailer->open({
From => $from_address, # Откуда
To => $to_address, # Кому
Subject => $subject, # Тема письма
}) or ololo(); # print "Can't open: $!\n"; # Не, не смогли ничего... Можно посмотреть почему
print $mailer $body; # Отправляем...
$mailer->close();
sub ololo{ # Процедура безопасного выхода
undef @pairs;
undef %input;
undef $topic; undef $date; undef $ref; undef $flag; undef $tmp; undef $query; undef $pair;
undef $name; undef $value; undef $input;
undef $to_address; undef $subject; undef $mailer; undef $body; undef $from_address;
exit 0;
}
В .htaccess я написал вот что:
Options +Includes +ExecCGI
У себя в записи ЖЖ я пишу вот такую вещь:
<div style="display:none">
<img src="http://myserver.ru/lj.pl?topic=PLAZMOTRON" width=1>
</div>
Где
- lj.pl — имя скрипта
- topic — имя вашего топика, который идентифицирует запись в ЖЖ (В данном случае PLAZMOTRON)
Вроде как необходимо указывать gif-пустышку, которая будет отдаваться, но то ли у меня достаточно современный браузер (Firefox 3.6.17), то ли я чего-то не понял, раскуривая маны, но скрипт вполне рабочий.
Хохмы ради из него можно слепить счётчик или еще чего полезное.
Этот пример скрипта скорее полезен тем, кто только начинает работать с вебом при помощи Perl'а (Это как раз про меня).
Показан простейший способ работы без монстроподобных модулей типа Mason или CGI, избежание 500-ой ошибки и всяких print «Text/plain\n\n»;
Спасибо.