Модераторы: korob2001, ginnie

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Физическое изменение фаула картинки при закачке, PERL 
V
    Опции темы
MaxPayne
Дата 24.10.2006, 13:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 72
Регистрация: 9.8.2005

Репутация: нет
Всего: нет
Все заработало - файлы сжимает пропорционально до 300 по ширине, а если начальная картинка по ширине меньше 300, то увеличивает ее до 300. Привожу кратко код - может кому пригодится. Всем еще раз спасибо.

Код

#!/usr/bin/perl
use CGI qw(:standard); 
use DBI;
use Image::Magick;

$day=param('day');
$month=param('month');
$year=param('year');
$hour=param('hour');
$minute=param('minute');
$tema=param('tema');
$opis=param('opis');
$url=param('url');
$autor=param('autor');
$perew=param('perew');

$tema =~ s/\'/\"/gi;
$opis =~ s/\'/\"/gi;
$url =~ s/\'/\"/gi;
$autor =~ s/\'/\"/gi;
$perew =~ s/\'/\"/gi;

$path="/home/www/htdocs/news/$year/";
$file=param('file');
$file=~/([^\\\/:]+)$/;  # Выделяем имя файла

#------------------------------------------------------------

# Ищем максимальный файл в дирректории (формата 00000000.jpg)
$max=0;
opendir (LOGDIR, "$path");
while($log = readdir LOGDIR)
    {
    next if (($log eq ".")or($log eq "..")or($log eq "Thumbs.db"));
    $logt = $log;
    $logt =~ s/\.jpg//gi;
    $logt =~ s/\.gif//gi;
    if ("$logt" > "$max"){$max="$logt";}
    }
closedir(LOGDIR);

$max+=1;

if ($max < 10){$max = "0000000$max";}
elsif ($max < 100){$max = "000000$max";}
elsif ($max < 1000){$max = "00000$max";}
elsif ($max < 10000){$max = "0000$max";}
elsif ($max < 100000){$max = "000$max";}
elsif ($max < 1000000){$max = "00$max";}
else {$max = "0$max";}

$max.=".jpg";

$dbh = DBI->connect("DBI:mysql:news:localhost", "", "");
$dbh -> do("INSERT INTO news VALUES ('', '$day', '$month', '$year', '$hour:$minute', '$tema', '$opis', '$url', '$autor', '$perew', '$max')");
$dbh->disconnect;

open(FILE,">$path$max"); 
binmode(FILE);
print FILE <$file>;
close(FILE);


my $image = Image::Magick->new;
$image->Read("$path$max");
($img_width, $img_height) = $image->Get('width', 'height');
$scale = $img_width/300;
$res_heigt=int($img_height/$scale);
$image->Scale(width=>"300", height=>"$res_heigt");
$image->Crop(width=>300, height=>$res_heigt, x=>0, y=>0);
$image->Write(filename=>"$path$max", compression=>'JPEG', quality=>'80');


print header;
print "File save: $path$max<br>";
print "SQL: INSERT INTO new VALUES ('', '$day', '$month', '$year', '$hour:$minute', '$tema', '$opis', '$url', '$autor', '$perew', '$max')";
PM MAIL WWW ICQ   Вверх
Zuzu
Дата 24.10.2006, 14:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 140
Регистрация: 19.10.2006
Где: Екатеринбург

Репутация: 1
Всего: 4
Можно пару комментариев, если позволите. Просто участвую в написании "каталога фотографий" примерно с таким-же количеством (расчетное количество - в районе миллиона фото + всякая мелочь к фото типа структурированного адреса, ключевых слов, описания, маленькой фото, датой съемки, датой обновления, кто из администраторов обновил и т.д.).

Чур, не обижаться! Скрипт-то работает.

0. use strict; лучше поставить сверху. Как-то привычнее с ней =)

1. Строчку с Crop можно убрать - она просто лишняя!

2. Метод поиска максимального номера файла - сомнителен. При большом количестве файлов задержка будет увеличиваться!

Насколько я понял, задача в определении имени нового файла.

Я бы воспользовался для определения имени файла либо MySQL (LAST_INSERT_ID) либо формировал временное имя случайным образом. С MySQL, естественно, нужно сначала добавить запись в таблицу news и при наличии в news поля со свойствами авто-инкремента, считать новый номер. Кстати, есть ли там такое поле? =) А как тогда обратится к строке с новостью?

Соответственно, всё, что связано с чтением файлов из каталога и увеличением номера файла можно убрать, можно не хранить имя файла - его имя (<номер>.jpg) будет совпадать с id строки новости.

Код

# Кусок кода, наверно, можно и проще - скажите как =)

if ($rv) {          # если добавили запись
  $sql = <<EO_SQL;
SELECT LAST_INSERT_ID() as last_insert_id
EO_SQL
  my $hash_ref = $dbh->selectrow_hashref($sql);
  #
  warn ((caller 0)[3] . "Last insert id: $hash_ref->{'last_insert_id'} \n") 
    if ($debug);
  $new_id = $hash_ref->{'last_insert_id'};
}



P.S. Добавление нулями слева (если уж оно нужно) проще написать так:

Код


$max = ('0' x (7 - length($max))) . $max . '.jpg';



P.P.S. Нет ни одной обработки "плохой ситуации". Типа скрипт всегда работает в идеальных условиях. И ни одной проверки целостности и правильности данных при вводе, результатов при обработке, при записи... Работаем все-таки в CGI-среде! Всюду враги!



Это сообщение отредактировал(а) Zuzu - 24.10.2006, 14:14
--------------------
Проводить эксперименты на живом сервере опасно, а на мертвом - бесполезно.
PM   Вверх
MaxPayne
Дата 24.10.2006, 15:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 72
Регистрация: 9.8.2005

Репутация: нет
Всего: нет
1) По поводу добаления нулей слева - спасибо. Переправил.

2) Программа работает в идеальных условиях, т.к. новости добавляю я сам, хотя попозже сделаю добавление сторонними людьми (с Логином и паролем), соответственно добавлю и проверки.

3) Что касается id файла = id новости, можно и так, просто новости идут с 2003 года, примерно по 1-2 новости в день - файлов получается немного (разбиты по папкам /2003/ ), пока нет необходимости делать как вы сказали. Хотя вопрос интересный, может со временем так и сделаем.

4) 
Цитата
 >> Строчку с Crop можно убрать - она просто лишняя!

Убрал, просто не знал что она не нужна.
 
PM MAIL WWW ICQ   Вверх
amg
Дата 24.10.2006, 16:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1145
Регистрация: 3.8.2006
Где: Новосибирск

Репутация: 1
Всего: 50
Победителей не судят, но попридиратся немного можно?
Вместо длинного перечисления
Код

$day=param('day');
$month=param('month');
$year=param('year');
$hour=param('hour');
$minute=param('minute');
$tema=param('tema');
$opis=param('opis');
$url=param('url');
$autor=param('autor');
$perew=param('perew');
так и просится
Код

foreach (qw(day month year hour minute tema opis url autor perew file)) {
  ${$_} = param($_);
}
Аналогично,
Код

s/'/"/g for ($tema,$opis,$url,$autor,$perew);
Код

# Выделяем имя файла
$file=~/([^\\\/:]+)$/;  # Так с переменной $file ничего не произойдет
$file=~s/([^\\\/:]+)$/$1/;  # Вот так
$file=~s/.*[\/\\]//; # Или классика (лучше, т.к. файл пришедший с *nix, запросто может иметь : в названии)
Кусочек из поиска максимального файла в директории я бы так написал:
Код

while($log = readdir LOGDIR) {
  $log =~ s/^(\d+)\.(jpg|gif)$/$1/ or next;
  $max = $log if $log > $max;
}
PM MAIL   Вверх
Zuzu
Дата 24.10.2006, 16:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 140
Регистрация: 19.10.2006
Где: Екатеринбург

Репутация: 1
Всего: 4
Цитата(amg @  24.10.2006,  19:05 Найти цитируемый пост)
код Perl

# Выделяем имя файла
$file=~/([^\\\/:]+)$/;  # Так с переменной $file ничего не произойдет
$file=~s/([^\\\/:]+)$/$1/;  # Вот так
$file=~s/.*[\/\\]//; # Или классика (лучше, т.к. файл пришедший с *nix, запросто может иметь : в названии)



$file=~/([^\\\/:]+)$/;  # Так с переменной $file ничего не произойдет

И слава богу, что не происходит ничего!!! 
С именем файла ничего делать не нужно, строка просто лишняя в этом коде! Я не заметил. smile

Лично я использую upload() из CGI

(см. perldoc CGI)

По поводу 

Код

foreach (qw(day month year hour minute tema opis url autor perew file)) {
  ${$_} = param($_);
}


Код ИМХО потерял читабельность (нужно думать, что он делает, а сначала было все очевидно) и выполняться будет дольше. (возможность определения имени переменной с помощью подстановки расхолаживает + в foreach "поднимаются" некоторые структуры типа массива - дополнительные затраты ресурсов).

А вообще любой код можно "вылизывать" до бесконечности. 



--------------------
Проводить эксперименты на живом сервере опасно, а на мертвом - бесполезно.
PM   Вверх
MaxPayne
Дата 24.10.2006, 16:49 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 72
Регистрация: 9.8.2005

Репутация: нет
Всего: нет
Код

$file=~/([^\\\/:]+)$/;  # Выделяем имя файла


Я так понимаю что это код из c:/Document and settign/user/Рабочий стол/Новости/dfjsl.jpg выделяет именно dfjsl.jpg. Что в принципе и нужно для записи его уже в *nix систему.
PM MAIL WWW ICQ   Вверх
Zuzu
Дата 24.10.2006, 17:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 140
Регистрация: 19.10.2006
Где: Екатеринбург

Репутация: 1
Всего: 4
Цитата(MaxPayne @  24.10.2006,  19:49 Найти цитируемый пост)
код Perl

$file=~/([^\\\/:]+)$/;  # Выделяем имя файла

Я так понимаю что это код из c:/Document and settign/user/Рабочий стол/Новости/dfjsl.jpg выделяет именно dfjsl.jpg. Что в принципе и нужно для записи его уже в *nix систему. 


Редко использую регулярные выражения, поэтому поправьте, если что не так =)

Нет. Он смотрит наличие на хвосте строкИ наличие нескольких (1 или более) идущих подряд символом, таких, чтобы они не попали во множество { \  /  : } и заносит их в переменную $1, если найдет. Результат (нашли или нет) операции теряется. С $file ничего не происходит. Т.е. для строки $file="qqq/666\ddd:565ss"; $1 будет '565ss'.

По поводу file и upload рекомендую почитать perldoc CGI, где (на чистом русском языке =) ) говорится, что при приеме файла с помощью param может произойти абсолютно любая лажа (slightly different things).

Дальше говорится, что с именем файла ничего делать не нужно и приводится правильный способ приема файла с помощью upload(). И что ничего не нужно вырезать из имени, т.к. оно никак не связано (is unrelated) с реальным потоком данных, принимаемых посредством CGI =)

Код


Different browsers will return slightly different things for the name. Some browsers return the filename only. 
Others return the full path to the file, using the path conventions of the user's machine. Regardless, the name returned is
always the name of the file on the user's machine, and is unrelated to the name of the temporary file that CGI.pm creates
during upload spooling (see below).



Рекомендую! Очень увлекательное чтиво!




Это сообщение отредактировал(а) Zuzu - 24.10.2006, 17:53
--------------------
Проводить эксперименты на живом сервере опасно, а на мертвом - бесполезно.
PM   Вверх
gcc
Дата 25.4.2008, 19:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Агент алкомафии
****


Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17
у меня тоже самое что у автора топика!

только я бьюсь об стену пол дня, очень странная ошибка какая-то прямо аномалия!!!  smile 

 smile 

1. передаються данные из формы в скрипт, все проходит хорошо.
2. Принимаеться функцей param() данные и файл, нужно сохранить один файл в раширении 150 на 150, другой 75 на 75


выходит ситуациия,что первый записыаеться нормально, а другой файл записываеться пустой!!

права 777 права у веб сервера на всё!

вот скрипт, менял его много раз подскжаите ошибка пожалуйста!



Код



$photo=$query->param("photo");
$photot=$query->param("photo");


sub up1 {

if ($photo) {


my ($avatar, $downpath, $name, $a, $downpath, $ix, $iy, $file, $ox, $oy, $oc, $ic, $nx, $ny, $geo);



my $avatar="0000";

  my $downpath = "/site/p/";

  #my $in=param('picture'); 

  # �?�?�?�?�?�?�?�? �?�?�? �?�?�?�?�? �?�? ���?�?�?�?�?�?�?�? 
    my ($name)=$photo =~ m#([^\\/:]+)$#; 

my $a="jpg";

my $file = $downpath.$avatar.$tv.".".$a;

  #$open(OUT,">$file") || die "$!"; 
  #binmode(OUT); 
  # �?�?�?�?�?�? �?�?�?�?�?�?�? ���?�?�?�? �? ���?�?�?�? �? �?�?�?�? 


#   open (IMG, ">$file") || die $!;
#  binmode IMG  || die $!;
# 
#  while {
# print IMG (<$photo>);
# 
# }

 #$file = $path_image.$tv[1].".".$tv[0];
  open (IMG, ">$file"); binmode IMG;  print IMG while (<$photo>); close (IMG); chmod 0644, $file;


   $ix="150"; 
   $iy="150";


 $photo = Image::Magick->new;
  $photo->Read("$file"); # $file - ���?�?�?�?�?�? �?�?�? �?�?�? �?�?�?�?�?�? �?�?�? �?�?���?�?�?�?�?�?�?�? �?�?�?�?

my ($ox, $oy, $oc, $ic, $nx, $ny, $geo);
  ($ox,$oy)=$photo->Get('columns','height');
  if (($ox > $ix)||($oy > $iy)) {
   $oc = $ox/$oy; $ic = $ix/$iy;
   if ($oc < $ic) {$ny = $iy; $nx=int(($ox/$oy)*$iy);}
   elsif ($oc > $ic) {$nx = $ix; $ny=int(($oy/$ox)*$ix);}
   else {$nx = $ix; $ny = $iy;}}
  else {$nx=$ox;$ny=$oy;}

#�?�?�?�?�?�?�?�? �?�?�?�?�?�? �? �?�?�?�?�?�?�?�?�? �?�?�?�?�?�?�?�?�?�?�?:

  $geo = 'geometry';
  $photo->Resize(geometry=>$geo, width=>$nx, height=>$ny);
  #$file = $path_image."i".$tv[1].".".$tv[0];
  $photo -> Write("$file");

  #while (<$photo>) { 
  #  print OUT ; 
  #} 
  #close(OUT); 

  # �?�?�?�?�?�?�? �?�?�?���?�?�? �? �?�?�?�?�?�?�? �?�?�?�?�? <$name> 
  print "Upload file: $name"; 

}
}


sub up2 {

#avator


my ($avatar, $downpath, $name, $a, $downpath, $ix, $iy, $file, $ox, $oy, $oc, $ic, $nx, $ny, $geo, $a);

$avatar="000";

 $downpath = "/s/t/";
  #my $in=param('picture'); 

  # �?�?�?�?�?�?�?�? �?�?�? �?�?�?�?�? �?�? ���?�?�?�?�?�?�?�? 

   ($name)=$photot =~ m#([^\\/:]+)$#; 

$a="jpg";

$file = $downpath.$avatar.$tv.".".$a;



  #$open(OUT,">$file") || die "$!"; 
  #binmode(OUT); 
  # �?�?�?�?�?�? �?�?�?�?�?�?�? ���?�?�?�? �? ���?�?�?�? �? �?�?�?�? 


#   open (IMG, ">$file") || die $!;
#  binmode IMG  || die $!;
# 
#  while {
# print IMG (<$photo>);
# 
# }

 #$file = $path_image.$tv[1].".".$tv[0];
  open (IMG, ">$file"); binmode IMG2;  print IMG2 while (<$photot>); close (IMG2); chmod 0644, $file;

$ix="75"; 
$iy="75";



 $photot = Image::Magick->new;
  $photot->Read("$file"); # $file - ���?�?�?�?�?�? �?�?�? �?�?�? �?�?�?�?�?�? �?�?�? �?�?���?�?�?�?�?�?�?�? �?�?�?�?

my ($ox, $oy, $oc, $ic, $nx, $ny, $geo);
  ($ox,$oy)=$photot->Get('columns','height');
  if (($ox > $ix)||($oy > $iy)) {
   $oc = $ox/$oy; $ic = $ix/$iy;
   if ($oc < $ic) {$ny = $iy; $nx=int(($ox/$oy)*$iy);}
   elsif ($oc > $ic) {$nx = $ix; $ny=int(($oy/$ox)*$ix);}
   else {$nx = $ix; $ny = $iy;}}
  else {$nx=$ox;$ny=$oy;}

#�?�?�?�?�?�?�?�? �?�?�?�?�?�? �? �?�?�?�?�?�?�?�?�? �?�?�?�?�?�?�?�?�?�?�?:

  $geo = 'geometry';
  $photot->Resize(geometry=>$geo, width=>$nx, height=>$ny);
  #$file = $path_image."i".$tv[1].".".$tv[0];
  $photot -> Write("$file");

  #while (<$photo>) { 
  #  print OUT ; 
  #} 
  #close(OUT); 

  # �?�?�?�?�?�?�? �?�?�?���?�?�? �? �?�?�?�?�?�?�? �?�?�?�?�? <$name> 
  print "Upload file: $name"; 
}



up1();
up2();


exit;





Это сообщение отредактировал(а) gcc - 25.4.2008, 19:21


--------------------
Perl FAQ
freelance
perl, jquery, js, php
perl, jquery
PM WWW ICQ Skype GTalk Jabber   Вверх
gcc
Дата 25.4.2008, 21:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Агент алкомафии
****


Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17
как всегда из-за тупой проблемы - тормоза, аж обидно  smile 


--------------------
Perl FAQ
freelance
perl, jquery, js, php
perl, jquery
PM WWW ICQ Skype GTalk Jabber   Вверх
gcc
Дата 26.4.2008, 16:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Агент алкомафии
****


Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17
что за факство!!!??  smile 
  smile  smile  smile  smile   smile  smile  smile  smile   smile  smile  smile  smile   smile  smile  smile  smile   smile  smile  smile  
подскажите в чем проблема??? пробовал по разному!! 


--------------------
Perl FAQ
freelance
perl, jquery, js, php
perl, jquery
PM WWW ICQ Skype GTalk Jabber   Вверх
gcc
Дата 26.4.2008, 17:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Агент алкомафии
****


Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17
по-моиму сделал...


--------------------
Perl FAQ
freelance
perl, jquery, js, php
perl, jquery
PM WWW ICQ Skype GTalk Jabber   Вверх
MaxPayne
Дата 27.4.2008, 15:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 72
Регистрация: 9.8.2005

Репутация: нет
Всего: нет
gcc, Показывай как сделал.
PM MAIL WWW ICQ   Вверх
gcc
Дата 27.4.2008, 22:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Агент алкомафии
****


Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 2
Всего: 17
Код

 $ = Image::Magick->new;

меняем на :
Код

my $ = Image::Magick->new;



абяву забыл сделать

 smile  smile  smile  smile  smile 


--------------------
Perl FAQ
freelance
perl, jquery, js, php
perl, jquery
PM WWW ICQ Skype GTalk Jabber   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Perl: CGI программирование"
korob2001
sharq
  • В этом разделе обсуждаются вопросы относящиеся только к CGI программированию
  • Если ваш вопрос не относится к системному или CGI программированию, задавайте его в общем разделе
  • Если ваш вопрос относится к системному программированию, задавайте его здесь
  • Интерпретатор Perl можно скачать здесь ActiveState, O'REILLY, The source for Perl
  • Справочное руководство "Установка perl-модулей", качать здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, korob2001, sharq.
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Perl: разработка для Web | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0548 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.