Модераторы: korob2001, ginnie
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Сохранить куки в БД 
:(
    Опции темы
BuTbKa_ua
Дата 10.10.2006, 02:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 28
Регистрация: 7.10.2006

Репутация: нет
Всего: нет
Есть идеи как сохранить куки в БД?

Использую HTTP::Cookies.
PM MAIL   Вверх
korob2001
Дата 10.10.2006, 06:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 2871
Регистрация: 29.12.2002

Репутация: 31
Всего: 61
Вообще вопрос не понятен, но насколько я понял, то примерно это нужно:
Код

#!/usr/bin/perl -w
use strict;

use CGI;
use DBI;
my $cgi = new CGI();

# Получаем куки
my $name = $cgi->cookie("name");
my $family = $cgi->cookie("family");
my $last_visit = $cgi->cookie("last_visit");

print $cgi->header(-charset => "Windows-1251");

# Подключаемся к БД и делаем запрос
my $dbh = DBI->connect("DBI:mysql:host=localhost;database=test","login","password") or die DBI->errstr();
my $sth = $dbh->prepare("INSERT INTO CookieInfo (Name,Family,LastVisit) VALUES (?,?,'$last_visit')");
$sth->execute($name,$family);
my $res = $sth->finish();
$dbh->disconnect();

# Выводим сообщение юзеру
print $cgi->start_html( -title => "Test" );
if ($res + 0) {
    print $cgi->b("Куки успешно добавлены в базу данных");
} else {
    print $cgi->b("Не удалось добавить куки в базу данных");
}
print $cgi->end_html();

Перед запуском нужно:
1. Cоздать базу test.
2. Изменить login и password на свои в скрипте выше.
3. После того как база была создана, создать таблицу CookieInfo
Код

CREATE TABLE IF NOT EXISTS CookieInfo (
       Id               INT            UNSIGNED     NOT NULL       AUTO_INCREMENT,
       Name             VARCHAR(100)                NOT NULL,
       Family           VARCHAR(100)                NOT NULL,
       LastVisit        DATETIME                    NOT NULL,
       PRIMARY KEY(Id)
);

4. Записать в куки информацию:
Код

#!/usr/bin/perl -w
use strict;
use CGI;

my $cgi = new CGI;

sub show_form {
    print $cgi->header(-charset => "Windows-1251");
    print $cgi->start_html();
    print $cgi->start_form(-action => $cgi->url(-relative => 1));
    print $cgi->b("Name: "),   $cgi->textfield(-name => "name",  -size => 20),$cgi->br();
    print $cgi->b("Family: "), $cgi->textfield(-name => "family",-size => 20),$cgi->br();
    print $cgi->submit(-name => "send",-value => "Записать в куки");
    print $cgi->end_form();
    print $cgi->end_html();
}

sub data_prepare {
    my $name = $cgi->param('name');
    my $family = $cgi->param('family');
    &error("В имени обнаружена ошибка :(")   unless $name   =~ /^[A-Za-zА-Яа-я ]{3,100}$/;
    &error("В фамилии обнаружена ошибка :(") unless $family =~ /^[A-Za-zА-Яа-я ]{3,100}$/;
    add_cookie(name => $name, family => $family, last_visit => &time_format());
}

sub add_cookie {
    my %info   = @_;
    my $name       = $cgi->cookie(-name => 'name',      -value => $info{'name'},       -expires => "+20m");
    my $family     = $cgi->cookie(-name => 'family',    -value => $info{'family'},     -expires => "+20m");
    my $last_visit = $cgi->cookie(-name => 'last_visit',-value => $info{'last_visit'}, -expires => "+20m");
    print $cgi->header(-charset => "Windows-1251",-cookie => [$name,$family,$last_visit]);
    print $cgi->start_html();
    print $cgi->b("Данные сохранены в куках");
    print $cgi->end_html();
}

sub error {
    my $mess = shift || "";
    print $cgi->header(-charset => "Windows-1251");
    print $cgi->start_html(-title => "Ошибка");
    print $cgi->b({-style => "color: red"},"Ошибка: ");
    print $cgi->b($mess);
    print $cgi->end_html();
    exit 0;
}

sub time_format {
    my $tm = shift || time();
    my($s,$m,$h,$d,$M,$y) = (localtime($tm))[0..5];
    $M += 1;
    for ($s,$m,$h,$d,$M) { $_ = join("",0,$_) if $_ < 10 };
    $y += 1900;
    return "${y}-${M}-$d $h:$m:$s";
}

if (defined $cgi->param('send')) {
    &data_prepare();
} else {
    &show_form();
}


Это сообщение отредактировал(а) korob2001 - 10.10.2006, 13:21


--------------------
"Время проходит", - привыкли говорить вы по неверному пониманию. 
"Время стоит - проходите вы".
PM MAIL WWW ICQ MSN   Вверх
Nab
Дата 10.10.2006, 13:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 582
Регистрация: 25.3.2006
Где: Kiev

Репутация: 26
Всего: 37
Ну если используете  HTTP::Cookies, то почему не заюзать и  CGI::Session, там есть много способов сохранять сессии, в том числе и через DBI, и все будет намного прозрачней и переносимей...

Добавлено @ 13:44 
Забыл указать что там можно хранить много чего, и формат базы должен быть примерно таков
CREATE TABLE IF NOT EXISTS sessions (    
       id               INT            UNSIGNED     NOT NULL       AUTO_INCREMENT,    
       sid             VARCHAR(32)  NOT NULL,    
       a_session  TEXT   NULL,    
       UNIQUE KEY (sid),
       PRIMARY KEY(Id)    
);

Можно сделать sid и primary key, но числовой id имхо, универсальней...


--------------------
 Чтобы правильно задать вопрос нужно знать больше половины ответа...
Perl Community 
FREESCO in Ukraine 
PM MAIL   Вверх
BuTbKa_ua
Дата 14.10.2006, 04:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 28
Регистрация: 7.10.2006

Репутация: нет
Всего: нет
Все что мне надо, это просто сохранить копию куков и при след обращениях, подсовывать в запрос. Вот и все. 

Что-то по типу бота. Чтобы не надо было постоянно логиниться. Для авторизации использую LWP.
Я не знаю, что приходит в куках и не знаю их количество. 
PM MAIL   Вверх
BuTbKa_ua
Дата 14.10.2006, 04:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 28
Регистрация: 7.10.2006

Репутация: нет
Всего: нет
Код

  use LWP 5.64;
 
  my $browser = LWP::UserAgent->new;
  
  use HTTP::Cookies;
  my $cookies = HTTP::Cookies->new(); 
  $browser->cookie_jar($cookies);
   
   push @{ $browser->requests_redirectable }, 'POST';
   $browser->agent('Mozilla/4.0 (compatible; MSIE 5.12; Mac_PowerPC)' );
   
     
   my $url = 'http://mysite.com/login.php';
   my $response = $browser->post( $url ,['login'=>"user",'psw'=>"password"]);
   
       


вот как мне вытащить заголовок куков?,
а потом подсунуть при следующих запросах из других скриптов?

Это сообщение отредактировал(а) BuTbKa_ua - 14.10.2006, 05:00
PM MAIL   Вверх
od0201
Дата 19.7.2011, 12:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 126
Регистрация: 16.1.2009

Репутация: 1
Всего: 1
вопрос так и не был решен, поэтому попытаюсь поднять его уже я.

автор темы BuTbKa_ua довольна разборчиво задал вопрос, но ответы были какие-то не в попад (или я в них не разобрался).

Попытаюсь еще раз
Код

use LWP::UserAgent;
use HTTP::Cookies;
$cookies = HTTP::Cookies->new;
$ua = LWP::UserAgent->new;
$ua->agent("Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; WebMoney Advisor; .NET CLR 1.1.4322)");
$ua->cookie_jar($cookies); 

$url="http://www.mysite.com/";
$log{ID}="od0201";
$log{Password}="ksjdfh654654";

$res = $ua->post($url,{%log});


получаю куки, и мне их нужно сохранить в БД (не в файл). 
Для чего сохранить? Для имитации браузера, у меня скрипт 2 часа за каждого юзера по сайту ходит и 20 раз логинится
Почему в БД. Потому что логинов/паролей до 100 и надеюсь больше будет.

Думаю так будет работать.
Код

use Storable qw(freeze thaw);
my $str = freeze($cookies); 
$str->БД
...
БД->$str
$cookies=thaw ($str);

если есть более разумные идеи, поделитесь

Это сообщение отредактировал(а) od0201 - 19.7.2011, 13:07
PM MAIL   Вверх
arto
Дата 19.7.2011, 13:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1495
Регистрация: 31.10.2004

Репутация: 38
Всего: 40
perldoc HTTP::Cookies вы не прочитали, как и perldoc CGI::Session.

Это сообщение отредактировал(а) arto - 19.7.2011, 13:13
PM MAIL ICQ   Вверх
od0201
Дата 19.7.2011, 13:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 126
Регистрация: 16.1.2009

Репутация: 1
Всего: 1
HTML::Cookies - прочел и все перепробовал (методом тыка), в файл он сохраняет, это да, а мне нужно в БД или в строку на крайний случай.
И то в файле только "#LWP-Cookies-1.0" оказывается при $cookies->save("ttt.txt"); почему так?  

CGI::Session - и это читал, но мне кажется это не с той оперы (хотя может и не достаточно разобрался), но мне кажется сессия организовывается на стороне сервера, а нам нужна имитация браузера.

если есть пример, приведите его, гуглю 2 дня уже, все не то.
PM MAIL   Вверх
arto
Дата 19.7.2011, 13:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1495
Регистрация: 31.10.2004

Репутация: 38
Всего: 40
# perl -MHTTP::Cookies -MLWP::UserAgent -le '$j = new HTTP::Cookies (file => "/tmp/a.cookie", autosave => 1, ignore_discard => 1); $b = new LWP::UserAgent; $b->cookie_jar($j); $res = $b->get ($ARGV[0]);' http://google.com 
# wc -l /tmp/a.cookie
6 /tmp/a.cookie
# 

наследуйте HTTP::Cookie и переопределяйте save/load.

btw, насколько у вас тормозит файл по сравнению с базой?
PM MAIL ICQ   Вверх
od0201
Дата 19.7.2011, 15:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 126
Регистрация: 16.1.2009

Репутация: 1
Всего: 1
идею понятна, 
половина уже работает, 
но к сожалению у меня не достаточно опыта в ООП, пойду почитаю....
как разберусь, выложу рабочий код ....................... или нерабочий )) 

??? btw, насколько у вас тормозит файл по сравнению с базой? ??? это к чему?
PM MAIL   Вверх
arto
Дата 19.7.2011, 16:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1495
Регистрация: 31.10.2004

Репутация: 38
Всего: 40
"Почему в БД. Потому что логинов/паролей до 100 и надеюсь больше будет."
PM MAIL ICQ   Вверх
od0201
Дата 19.7.2011, 22:54 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 126
Регистрация: 16.1.2009

Репутация: 1
Всего: 1
аааааааааааааааа, 
не в скорости дело, думал так красивее будет. 
Хотя эти данные не так важны чтоб делать их бэкап
Пожалуй да, в файлах наверное разумнее будет их хранить 

З.Ы. Хотя на моем хостинге есть ограничение по кол.файлов в 3 000 000 smile
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Perl"
korob2001
sharq
  • В этом разделе обсуждаются общие вопросы по языку Perl
  • Если ваш вопрос относится к системному программированию, задавайте его здесь
  • Если ваш вопрос относится к CGI программированию, задавайте его здесь
  • Интерпретатор Perl можно скачать здесь ActiveState, O'REILLY, The source for Perl
  • Справочное руководство "Установка perl-модулей", можно скачать здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, korob2001, sharq.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Perl: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0542 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.