VPF::Физическое изменение фаула картинки при закачке

MaxPayne

Дата 18.10.2006, 16:53 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

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

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

Делаю скрипт для создания автоматизированного заноса новостей на сайт. Т.е. есть форма с полями + выбирается файл и все это подается на это скрипт (частичный код ниже). Картинки всегда 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 (ссылка)

(нет голосов)

Загрузка ...

Главный джедай

Профиль
Группа: Модератор
Сообщений: 3886
Регистрация: 8.1.2003
Где: КМВ

Репутация: 4
Всего: 83

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');

--------------------

Чем дальше в лес, тем толще партизаны...

Цитата(igorold @ 1.5.2016, 17:40

)

Индейцы не обратили внимания на поток беженцев из Европы… Теперь они живут в резервациях.

nitr

Дата 18.10.2006, 17:20 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

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

Репутация: 12
Всего: 84

поиск на форуме 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
снова меня опередили smile

... плохо на работе сидеть ;)

MaxPayne, GoodBoy дал хороший пример smile

, ну а поиском можешь найти пример с GD ;)

--------------------

I love ArchLinux

MaxPayne

Дата 19.10.2006, 09:06 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

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

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

При таком коде не выдает размеры картинки:

Код


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 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

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

Репутация: 1
Всего: 50

Попробуй для начала

Код

my $x = $image->Read($max);
print "$x<br>" if $x;

чтобы узнать, успешно ли прочитался имидж

GoodBoy

Дата 19.10.2006, 09:55 (ссылка)

(нет голосов)

Загрузка ...

Главный джедай

Профиль
Группа: Модератор
Сообщений: 3886
Регистрация: 8.1.2003
Где: КМВ

Репутация: 4
Всего: 83

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

--------------------

Чем дальше в лес, тем толще партизаны...

Цитата(igorold @ 1.5.2016, 17:40

)

Индейцы не обратили внимания на поток беженцев из Европы… Теперь они живут в резервациях.

MaxPayne

Дата 20.10.2006, 08:30 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

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

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

Цитата(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

Это сообщение отредактировал(а) MaxPayne - 20.10.2006, 08:33

GoodBoy

Дата 20.10.2006, 15:45 (ссылка)

(нет голосов)

Загрузка ...

Главный джедай

Профиль
Группа: Модератор
Сообщений: 3886
Регистрация: 8.1.2003
Где: КМВ

Репутация: 4
Всего: 83

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

--------------------

Чем дальше в лес, тем толще партизаны...

Цитата(igorold @ 1.5.2016, 17:40

)

Индейцы не обратили внимания на поток беженцев из Европы… Теперь они живут в резервациях.

nitr

Дата 20.10.2006, 16:22 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

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

Репутация: 12
Всего: 84

можно же прямо в каталог со скриптом
в Винде путь - .\99.jpg
В *nix путь - ./99.jpg

А по-моему он закачивает на сервер файлик неверно ;)
MaxPayne, я угадал?

--------------------

I love ArchLinux

MaxPayne

Дата 20.10.2006, 18:10 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

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

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

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

nitr

Дата 20.10.2006, 19:42 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

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

Репутация: 12
Всего: 84

MaxPayne, это как налету? smile

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

--------------------

I love ArchLinux

MaxPayne

Дата 20.10.2006, 22:13 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

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

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

Получилось его открыть и узнать размеры, дальше нахожу коэффициент сжатия (по барабану какая сторона больше)

$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 (ссылка)

(нет голосов)

Загрузка ...

Главный джедай

Профиль
Группа: Модератор
Сообщений: 3886
Регистрация: 8.1.2003
Где: КМВ

Репутация: 4
Всего: 83

по-идее ты не можешь перезаписать открытый файл... smile

Попробуй сохранять его под другим именем...

--------------------

Чем дальше в лес, тем толще партизаны...

Цитата(igorold @ 1.5.2016, 17:40

)

Индейцы не обратили внимания на поток беженцев из Европы… Теперь они живут в резервациях.

Zuzu

Дата 23.10.2006, 15:50 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

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

Репутация: 1
Всего: 4

Цитата(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');

=)

Это сообщение отредактировал(а) Zuzu - 23.10.2006, 16:01

--------------------

Проводить эксперименты на живом сервере опасно, а на мертвом - бесполезно.

GoodBoy

Дата 24.10.2006, 10:30 (ссылка)

(нет голосов)

Загрузка ...

Главный джедай

Профиль
Группа: Модератор
Сообщений: 3886
Регистрация: 8.1.2003
Где: КМВ

Репутация: 4
Всего: 83

Цитата(Zuzu @ 23.10.2006, 16:50

)

Может дело в "волшебных пузырьках"?

Замени на двойные кавычки =)

Тьфу ты... Ну естественно!!!!! В одинарных у тебя переменные твои не интерполитовались!!!!

--------------------

Чем дальше в лес, тем толще партизаны...

Цитата(igorold @ 1.5.2016, 17:40

)

Индейцы не обратили внимания на поток беженцев из Европы… Теперь они живут в резервациях.

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')";

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

--------------------

Проводить эксперименты на живом сервере опасно, а на мертвом - бесполезно.

MaxPayne

Дата 24.10.2006, 15:07 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

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

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

1) По поводу добаления нулей слева - спасибо. Переправил.

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

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

4)

Цитата

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

Убрал, просто не знал что она не нужна.

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;
}

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 "поднимаются" некоторые структуры типа массива - дополнительные затраты ресурсов).

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

--------------------

Проводить эксперименты на живом сервере опасно, а на мертвом - бесполезно.

MaxPayne

Дата 24.10.2006, 16:49 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

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

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

Код


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

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

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

--------------------

Проводить эксперименты на живом сервере опасно, а на мертвом - бесполезно.

gcc

Дата 25.4.2008, 19:19 (ссылка)

(нет голосов)

Загрузка ...

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

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

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

у меня тоже самое что у автора топика!

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

gcc

Дата 25.4.2008, 21:58 (ссылка)

(нет голосов)

Загрузка ...

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

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

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

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

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

gcc

Дата 26.4.2008, 16:04 (ссылка)

(нет голосов)

Загрузка ...

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

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

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

что за факство!!!?? smile

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

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

gcc

Дата 26.4.2008, 17:05 (ссылка)

(нет голосов)

Загрузка ...

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

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

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

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

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

MaxPayne

Дата 27.4.2008, 15:09 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

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

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

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

gcc

Дата 27.4.2008, 22:13 (ссылка)

(нет голосов)

Загрузка ...

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

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

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

Код


 $ = Image::Magick->new;

меняем на :

Код


my $ = Image::Magick->new;

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

smile

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Perl: разработка для Web \| Следующая тема »