use strict;
use warnings;
#no warnings;
use encoding 'cp1251', STDOUT => 'cp1251';
#$\ = "\r\n";
use Net::FTP;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use LWP::Simple;
use Text::Trim;
use Image::Magick;
use Time::HiRes qw(gettimeofday);
use Image::Size;
use File::Basename;
my $dir_separator = '\\';
my $prog_dir = dirname($0) . $dir_separator;
my @image_types = qw(bmp jpg jpeg png); # Файлы с этими расширениями будут масштрабированы ImageMackik-ом
# Перенаправление вывода в файл
$| = 1;
open STDOUT, '>>', "$prog_dir${dir_separator}log.txt" or die "Ошибка перенаправления STDOUT: $!";
open STDERR, ">&STDOUT" or die "Ошибка перенаправления STDERR: $!";
# Чтение конфига
my %config;
open (my $fh, "<${prog_dir}config.cfg") or die("Ошибка чтения файла конфигурации: $!");
while (my $line = <$fh>) {
if (my ($name, $val) = $line =~ /^(.*?)\s*=\s*"?([^#"]*)/) {
$name = trim($name);
$val = trim($val);
$config{$name} = $val;
}
}
close($fh);
$config{dev} = 0 unless defined $config{dev};
if ($config{'allowed_extensions'}) {
$config{'allowed_extensions'} =~ tr/,/|/;
}
# Главный цикл
while (1) {
eval {
my @files;
# Находим файлы для отправки
print("\r\n");
write_log("Сканирование папки") if $config{extra_log};
opendir (my $dh, $config{local_dir}) or die "Ошибка чтения содержимого папки \"$config{local_dir}\": $!";
while (my $filename = readdir($dh)) {
my $file_path = $config{local_dir} . $dir_separator . $filename;
next if -d $file_path;
# Разрешена загрузка только заданных расширений
unless (!$config{'allowed_extensions'} || $filename =~ /\.(${config{'allowed_extensions'}})$/i) {
write_log("Пропускаем файл \"$filename\"") if $config{extra_log};
next;
}
# Пропускаем файлы со скобками в имени
if ($filename =~ /[\(\)]/) {
write_log("Пропускаем файл \"$filename\" из-за скобок в названии") if $config{extra_log};
next;
}
# Пропускаем файлы нулевого размера
my @stats = stat($file_path);
unless ($stats[7]) {
write_log("Пропускаем пустой файл \"$filename\"") if $config{extra_log};
next;
}
push(@files, $file_path);
}
closedir($dh);
if (@files) {
# Установка соединения с ФТП
write_log("Подключение к FTP ...") if $config{extra_log};
my $ftp = Net::FTP->new($config{ftp_host}, Debug => 0, Passive => 1, BlockSize => 1024 ** 2 * 5, Debug => ($config{ftp_log} ? 1 : 0));
unless ($ftp) {
die("Ошибка подключения к ftp: $@");
}
unless ($ftp->login($config{ftp_user}, $config{ftp_pass})) {
die('Ошибка авторизации: ' . $ftp->message);
}
$ftp->binary;
unless ($ftp->cwd($config{ftp_dir})) {
die("Ошибка смены директории ftp: " . $ftp->message);
}
write_log("Ok") if $config{extra_log};
foreach my $file_path (@files) {
eval {
my($file_name, $dir, $suffix) = fileparse($file_path);
write_log("Начинаем обработку файла \"$file_name\"");
my($file_name1, $ext) = $file_name =~ /^(.*?)\.([^.]+)$/;
$ext = lc($ext);
my $zip_file_name = "$file_name1.zip";
my $zip_path = "$config{temp_dir}$dir_separator$zip_file_name";
# Увеличиваем изображение в два раза
if ($ext ~~ @image_types) {
# Определяем размер изображения
write_log('Определяем размер изображения ...');
my ($w, $h) = imgsize($file_path);
my $s = $w * $h;
write_log('Ok');
write_log("Текущий размер: ${w}x$h");
write_log("Пикселей: " . format_num($s));
if ($s && $s < 15_000_000) { # Делаем ресайз только если изображение меньше
write_log('Чтение изображения ...');
my $img = new Image::Magick;
my $r = $img->Read($file_path);
unless ($r) {
write_log('Ok');
my ($w2, $h2) = ($w * 2, $h * 2); # Новый размер
write_log("Изменение размера до ${w2}x${h2} ...");
$r = $img->Resize(width => $w2, height => $h2, filter => 'Lanczos');
unless ($r) {
$r = $img->Write($file_path);
unless ($r) {
write_log("Ok");
} else {
write_log("Ошибка записи: $r");
}
} else {
write_log("Ошибка масштабирования: $r");
}
} else {
write_log("Ошибка чтения: $r");
}
undef($img);
} else {
write_log('Ресайз не нужен');
}
}
# Упаковываем в zip
write_log("Создание архива \"$zip_file_name\" ...") if $config{extra_log};
my $zip = new Archive::Zip;
$zip->addFile($file_path, $file_name);
unless (my $code = $zip->writeToFileNamed($zip_path) == AZ_OK ) {
write_log("Ошибка упаковки файла \"$file_name\" в архив. Код ошибки: $code.");
} else {
write_log("Ok") if $config{extra_log};
# Загружаем файл на FTP
write_log("Начинаем загрузку файла \"$zip_file_name\" ...") if $config{extra_log};
my $upload_success = 0;
if ($ftp->put($zip_path)) {
unlink($file_path);
# Отправка GET-запроса
if (!$config{dev}) {
my ($file_no) = $file_name1 =~ /(\d+)$/;
unless (defined(get("http://xxxxxxxxxx?id=$file_no"))) {
write_log("Ошибка отправки GET-запроса");
}
}
write_log("Загружен файл \"$zip_file_name\"");
} else {
write_log("Ошибка при загрузке файла \"$zip_file_name\": " . $ftp->message);
}
unlink($zip_path);
}
undef($zip);
};
if ($@) {
write_log($@);
}
}
# Завершение соединения
$ftp->quit;
undef($ftp);
} else {
#print "Нечего загружать";
}
};
if ($@) {
write_log($@);
}
# Пауза
sleep $config{interval};
}
sub write_log {
my ($str) = @_;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
$mon++;
$year += 1900;
my (undef, $usec) = gettimeofday;
printf("[%02d.%02d.%04d %02d:%02d:%02d.%03d]\t%s\r\n", $mday, $mon, $year, $hour, $min, $sec, $usec / 1000, $str);
}
sub format_num {
my $num = shift;
$num =~ s/(?<=\d)(?=(\d{3})+(?!\d))/ /g;
return $num;
}
Простой