Версия для печати темы Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Perl: разработка для Web > Физическое изменение фаула картинки при закачке

Автор: MaxPayne 18.10.2006, 16:53

Делаю скрипт для создания автоматизированного заноса новостей на сайт. Т.е. есть форма с полями + выбирается файл и все это подается на это скрипт (частичный код ниже). Картинки всегда JPG большого размера - нужно сделать чтобы картинки преобразовывались например в 300х300 с качеством 80 и в таком виде уже сохранялись на сервере. Код my $path="/home/www/htdocs/news/"; my $file=param('file'); my $file=~/([^\\\/:]+)$/; open(FILE,">$path$file");  binmode(FILE); print FILE <$file>; close(FILE); print header(); print start_html(); print "Content-type: text/plain\n\n"; print "Done"; Что нужно чтобы узнать размер картинки которая закачивается и как сделать чтобы она стала 300х300. (размер буду делать пропорциональным, но это уже не сложно, главное узнать начальный размер и как сделать еее нужного размера)

Автор: GoodBoy 18.10.2006, 17:19

Image::Magick тебя спасёт! :-))) Если картинка пропорциональна размеру 300х300, то вот так: Код use Image::Magick; my $image = Image::Magick->new; $image->Read($filename); $image->Scale(width=>"300", height=>"300"); $image->Write(filename=>$filename2, compression=>'JPEG', quality=>'80'); в общем случае: Код use Image::Magick; my $image = Image::Magick->new; $image->Read($filename); my ($img_width, $img_height) = $image->Get('width', 'height'); my ($res_width, $res_width) = (300, 300); my $scale_x = $img_width/$res_width; my $scale_y = $img_height/$res_width; if ($scale_x<$scale_y) {     my $scale = $img_width/$res_width;     $image->Scale(width=>$res_width, height=>int($img_height/$scale));     my ($img_width, $img_height) = $image->Get('width', 'height');     $image->Crop(width=>$res_width, height=>$res_height, x=>0, y=>int(($img_height-$res_height)/2)); } else {     my $scale = $img_height/$res_height;     $image->Scale(width=>int($img_width/$scale), height=>$res_height);     my ($img_width, $img_height) = $image->Get('width', 'height');     $image->Crop(width=>$res_width, height=>$res_height, x=>int(($img_width-$res_width)/2), y=>0); } $image->Write(filename=>$filename2, compression=>'JPEG', quality=>'80');

Автор: nitr 18.10.2006, 17:20

поиск на форуме Image::Magick и GD так же можешь глянуть модули тут: http://search.cpan.org/~jcristy/PerlMagick-6.29/Magick.pm и http://search.cpan.org/~lds/GD-2.35/GD.pm в комплекте есть неплохие примеры ;) ... да и на форуме поиск замечательный... много способов выдаст... Добавлено @ 17:22  снова меня опередили  ... плохо на работе сидеть ;) MaxPayne,  GoodBoy дал хороший пример  , ну а поиском можешь найти пример с http://search.cpan.org/~lds/GD-2.35/GD.pm ;)

Автор: MaxPayne 19.10.2006, 09:06

При таком коде не выдает размеры картинки: Код my $image = Image::Magick->new; $image->Read($max); my ($img_width, $img_height) = $image->Get('width', 'height'); print "File $image: $img_width x $img_height<br>"; Выводит: File Image::Magick=ARRAY(0x812c254): x  Поидее выводит что-то - значит модель установлен.

Автор: amg 19.10.2006, 09:44

Попробуй для начала  Код my $x = $image->Read($max); print "$x<br>" if $x;  чтобы узнать, успешно ли прочитался имидж

Автор: GoodBoy 19.10.2006, 09:55

MaxPayne, почитай доки к модулю...  У тебя может быть более новая версия, чем та, что юзал я...

Автор: MaxPayne 20.10.2006, 08:30

Цитата(amg @ 19.10.2006,  10:44) Попробуй для начала  Код my $x = $image->Read($max); print "$x<br>" if $x;  чтобы узнать, успешно ли прочитался имидж Код выводит: Exception 410: Must specify image size `\Documents and Settings\User\Рабочий стол\Новости\99.jpg' Куда то пропало С: Или сначала закачать, а потом его переделать? Пробовал подругому - брать уже выделенный файл Код $file=~/([^\\\/:]+)$/; Тогда выводит Exception 435: unable to open image `99.jpg': No such file or directory

Автор: GoodBoy 20.10.2006, 15:45

MaxPayne, как вариант: попробуй читать файл из папки C:\image. Т.е. чтобы в пути не было пробелов и не было русских букв.

Автор: nitr 20.10.2006, 16:22

можно же прямо в каталог со скриптом в Винде путь - .\99.jpg В *nix путь - ./99.jpg А по-моему он закачивает на сервер файлик неверно ;)  MaxPayne, я угадал?

Автор: MaxPayne 20.10.2006, 18:10

Так в том то и фикус - новости добавляются на ура (astronews.ru), закачивается файл и добавляется в базу новость. Но проблема в том, что картинку приходится перед заливкой менть например с 1024х768, на 300х??? (пропорционально). Т.к. все идеально добавлялось решил еще больше упростить свою задачу, предварительно не уменьшать картинки, а заставить сделать это скрипт. МОжет так нельзя вообще?  Может сначала нужно залить, потом открыть, подредактировать и перезаписать? МОжет на лету нельзя?

Автор: nitr 20.10.2006, 19:42

MaxPayne, это как налету? ) залить - изменить - получаем всё ок

Автор: MaxPayne 20.10.2006, 22:13

Получилось его открыть и узнать размеры, дальше нахожу коэффициент сжатия (по барабану какая сторона больше) $path$max = /home/www/htdocs/00000128.jpg Код 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'); ########################################### выдает 600х420 $scale = $img_width/300; $res_heigt=int($img_height/$scale); ###########################################в итоге должно быть 300х210 $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'); Но файл не изменился в размерах.

Автор: GoodBoy 23.10.2006, 10:44

по-идее ты не можешь перезаписать открытый файл...   Попробуй сохранять его под другим именем...

Автор: Zuzu 23.10.2006, 15:50

Цитата(nitr @  20.10.2006,  19:42 ) MaxPayne, это как налету? ) залить - изменить - получаем всё ок  На лету, это значит не сохряняя промежуточный результат во временный файл. Судя по документации, должно работать (код, который написАл здесь даже не компилировал, заранее прошу прощения за возможные ошибки): Код #!/usr/bin/perl use strict; use CGI; use Image::Magick; my $cgi = new CGI; my $file_field = "my_file";      # имя поля из <input type="file" ... my $filename = $cgi->param($file_field);   # по идее - имя файла на диске пользователя my $fh = $cgi->upload($file_field);      # по идее - FILE HANDLE # my $imgObj = new Image::Magick; $imgObj->Read(file=>$fh);   # не работает !!! в документации сказано, что должно. $imgObj->Read(file=>\$fh);   # чушь, но тоже не работает!!! Ссылки на документацию: (http://www.imagemagick.org/script/perl-magick.php) Код To read an image in the GIF format from a PERL filehandle, use:   $image = Image::Magick->new;   open(IMAGE, 'image.gif');   $image->Read(file=>\*IMAGE);   close(IMAGE); perldoc CGI Код   To be safe, use the upload() function (new in version 2.47).  When   called with the name of an upload field, upload() returns a filehandle,   or undef if the parameter is not a valid filehandle.   $fh = $query->upload('uploaded_file');      while (<$fh>) {             print;      }   This is the recommended idiom. В чем же дело? Понятно, что проблема решена путем промежуточного сохранения в файл и чтения в дальнейшем из него. Вопрос академический, поэтому отдельную тему решил не создавать. Добавлено @ 16:00  Цитата(MaxPayne @  20.10.2006,  22:13 ) $image->Write(filename=>'$path$max', compression=>'JPEG', quality=>'80'); Скорее всего, можно переписать существующий файл! Он ужЕ загружен в память! Может дело в "волшебных пузырьках"?  Замени на двойные кавычки =) Код #Было $image->Write(filename=>'$path$max', compression=>'JPEG', quality=>'80'); #Стало $image->Write(filename=>"$path$max", compression=>'JPEG', quality=>'80'); =)

Автор: GoodBoy 24.10.2006, 10:30

Цитата(Zuzu @  23.10.2006,  16:50 ) Может дело в "волшебных пузырьках"?  Замени на двойные кавычки =) Тьфу ты...  Ну естественно!!!!!  В одинарных у тебя переменные твои не интерполитовались!!!!

Автор: MaxPayne 24.10.2006, 13:04

Все заработало - файлы сжимает пропорционально до 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')";

Автор: Zuzu 24.10.2006, 14:11

Можно пару комментариев, если позволите. Просто участвую в написании "каталога фотографий" примерно с таким-же количеством (расчетное количество - в районе миллиона фото + всякая мелочь к фото типа структурированного адреса, ключевых слов, описания, маленькой фото, датой съемки, датой обновления, кто из администраторов обновил и т.д.). Чур, не обижаться! Скрипт-то работает. 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-среде! Всюду враги!

Автор: MaxPayne 24.10.2006, 15:07

1) По поводу добаления нулей слева - спасибо. Переправил. 2) Программа работает в идеальных условиях, т.к. новости добавляю я сам, хотя попозже сделаю добавление сторонними людьми (с Логином и паролем), соответственно добавлю и проверки. 3) Что касается id файла = id новости, можно и так, просто новости идут с 2003 года, примерно по 1-2 новости в день - файлов получается немного (разбиты по папкам /2003/ ), пока нет необходимости делать как вы сказали. Хотя вопрос интересный, может со временем так и сделаем. 4)  Цитата  >> Строчку с Crop можно убрать - она просто лишняя! Убрал, просто не знал что она не нужна.

Автор: amg 24.10.2006, 16:05

Победителей не судят, но попридиратся немного можно? Вместо длинного перечисления Код $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; }

Автор: Zuzu 24.10.2006, 16:33

Цитата(amg @  24.10.2006,  19:05 ) код Perl # Выделяем имя файла $file=~/([^\\\/:]+)$/;  # Так с переменной $file ничего не произойдет $file=~s/([^\\\/:]+)$/$1/;  # Вот так $file=~s/.*[\/\\]//; # Или классика (лучше, т.к. файл пришедший с *nix, запросто может иметь : в названии) $file=~/([^\\\/:]+)$/;  # Так с переменной $file ничего не произойдет И слава богу, что не происходит ничего!!!  С именем файла ничего делать не нужно, строка просто лишняя в этом коде! Я не заметил.  Лично я использую upload() из CGI (см. perldoc CGI) По поводу  Код foreach (qw(day month year hour minute tema opis url autor perew file)) {   ${$_} = param($_); } Код ИМХО потерял читабельность (нужно думать, что он делает, а сначала было все очевидно) и выполняться будет дольше. (возможность определения имени переменной с помощью подстановки расхолаживает + в foreach "поднимаются" некоторые структуры типа массива - дополнительные затраты ресурсов). А вообще любой код можно "вылизывать" до бесконечности.

Автор: MaxPayne 24.10.2006, 16:49

Код $file=~/([^\\\/:]+)$/;  # Выделяем имя файла Я так понимаю что это код из c:/Document and settign/user/Рабочий стол/Новости/dfjsl.jpg выделяет именно dfjsl.jpg. Что в принципе и нужно для записи его уже в *nix систему.

Автор: Zuzu 24.10.2006, 17:46

Цитата(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). Рекомендую! Очень увлекательное чтиво!

Автор: gcc 25.4.2008, 19:19

у меня тоже самое что у автора топика! только я бьюсь об стену пол дня, очень странная ошибка какая-то прямо аномалия!!!       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, 21:58

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

Автор: gcc 26.4.2008, 16:04

что за факство!!!??                                                 подскажите в чем проблема??? пробовал по разному!!

Автор: gcc 26.4.2008, 17:05

по-моиму сделал...

Автор: MaxPayne 27.4.2008, 15:09

gcc, Показывай как сделал.

Автор: gcc 27.4.2008, 22:13

Код  $ = Image::Magick->new; меняем на : Код my $ = Image::Magick->new; абяву забыл сделать

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)