|
ru.perl
- RU.PERL ----------------------------------------------------------------------
From : Stas Vlasov 2:5080/172 16 Mar 2002 00:42:09
To : All
Subject : Hекоторые ошибки
--------------------------------------------------------------------------------
Есть скрипт, который вобщем-то неплохо работает,
производит что-то подобное ls -lr на заданном ftp.
Hо, вероятно, при превышении некоторого количества
файлов на фтп (каждый раз разного) сообщает об ошибке
в одном и том же месте (подчеркнуто) и прекращает
рекурсию, сообщая по всем оставшимся подкаталогам
корня ту же самую ошибку.
Содержимое $! в момент возникновения ошибки - либо пустое,
либо 'Bad file number'
Вопрос: что это могло бы быть и как этого избежать?
Вот собственно скрипт:
==========
#!perl
use strict;
use DBI;
use Net::FTP;
sub update_files;
sub dir_list;
my ($driver, $database, $hostname, $user, $password, $dbh, $dsn, $drh, $sth,
$date, $cdate, $server_date, $url, $status, $query, $ftp, $server, %exclude,
$k, $url_);
$url = $ARGV[0];
if (!(defined $url)) {
printf "usage: update_url.pl ftp://url";
}
$driver = "mysql";
$database = "ftpsearch"; $hostname = "localhost";
$dsn = "DBI:$driver:database=$database;host=$hostname";
$user = "ftpuser";
$password = "";
$dbh = DBI->connect($dsn, $user, $password);
if (!(defined $dbh)) {die "Can't connect to database\n"}
$drh = DBI->install_driver("mysql");
#Выборка урлов-исключений
$sth = $dbh->prepare("SELECT * FROM excludes");
$sth->execute();
while ($url_ = $sth->fetchrow_arrayref) {
$exclude{$$url_[0]} = 1;
}
$date = sprintf "%04d%02d%02d",
(localtime(time))[5] + 1900,
(localtime(time))[4] + 1,
(localtime(time))[3];
$cdate = sprintf "%04d-%02d-%02d",
(localtime(time))[5] + 1900,
(localtime(time))[4] + 1,
(localtime(time))[3];
#$cdate = "2002-02-12";
$status = "";
printf "DELETE FROM files WHERE file LIKE \"%s\%\";\n", $url;
update_files($url);
$dbh->disconnect();
printf "UPDATE ftpservers SET url = \"%s\", lastcheck = \"%s\", status = \"%s\"
WHERE url = \"%s\";\n", $url, $cdate, $status, $url;
sub update_files
{ my ($arg, @arg, $dir);
$arg = $_[0];
$arg =~ s/^ftp:\/\///;
@arg = split '/', $arg;
$server = $arg[0];
$ftp = Net::FTP->new($server, Debug => 0) || die "Can't create ftp object\n";
$ftp->login("anonymous",'f172@mail.ur.ru') || return;
dirlist($dir);
$ftp->quit;
}
sub dirlist {
my ($d, $i, @res, $line, $path);
my ($perm, $size, $mon, $day, $ytime, $fname, $dir, $cdir, $res);
$d = @_[0];
$cdir = $d;
if ($d =~ /^\/$/) { $cdir = "" };
if (!($ftp->cwd($d))) {warn "Can't chdir to $d - $!\n"; return};
#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
@res = $ftp->dir;
for ($i = 0; $i <= $#res; $i++) {
$line = $res[$i];
$line =~
/^(.{10})\s+\d+\s+[0-9a-z]+\s+[0-9a-z]+\s+(\d+)\s+(.+)\s+(\d{1,2})\s+([0-9\:]+)
\s+(.+)$/;
$perm = $1;
$size = $2;
$mon = $3;
$day = $4;
$ytime = $5;
$fname = $6;
if (($fname =~ /^$/) ||
($fname =~ /^\.$/) ||
($fname =~ /^\..$/)) {next;}
if ($perm =~ /^d/) {
if (defined $exclude{$fname}) {next};
$path = sprintf "ftp://$server$cdir/$fname";
printf "INSERT INTO files VALUES (\"%s\", %s, %s,\"%s\",
\"%s\");\n", $path, $size, $day, $mon, $ytime;
$dir = "$cdir/$fname";
if (defined $exclude{$path}) {
next;
} else {
dirlist($dir);
}
} else {
$path = sprintf "ftp://$server$cdir/$fname";
printf "INSERT INTO files VALUES (\"%s\", %s, %s, \"%s\",
\"%s\");\n", $path, $size, $day, $mon, $ytime;
}
}
}
==========
Good luck.
Stas
--- Еще одно "золото" 3.0.1
* Origin: gui is good, but console better (2:5080/172)
Вернуться к списку тем, сортированных по: возрастание даты уменьшение даты тема автор
|
