Pull to refresh

Собираем статистику просмотра постов в LJ/LI

Reading time3 min
Views760
Я видел очень много скриптов на разных языках, которые рассказали бы мне о том, как узнать о своих посетителях. Но они все были очень странные и местами требовали непонятных мне вещей.
В силу того, что всю жизнь писал на 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>


Где
  1. lj.pl — имя скрипта
  2. topic — имя вашего топика, который идентифицирует запись в ЖЖ (В данном случае PLAZMOTRON)


Вроде как необходимо указывать gif-пустышку, которая будет отдаваться, но то ли у меня достаточно современный браузер (Firefox 3.6.17), то ли я чего-то не понял, раскуривая маны, но скрипт вполне рабочий.
Хохмы ради из него можно слепить счётчик или еще чего полезное.

Этот пример скрипта скорее полезен тем, кто только начинает работать с вебом при помощи Perl'а (Это как раз про меня).
Показан простейший способ работы без монстроподобных модулей типа Mason или CGI, избежание 500-ой ошибки и всяких print «Text/plain\n\n»;

Спасибо.
Tags:
Hubs:
Total votes 12: ↑7 and ↓5+2
Comments17

Articles