VPF::загрузка картинок на сервер - Форум программистов

Tigra

Дата 7.12.2006, 14:55 (ссылка)

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

Загрузка ...

Новичок

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

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

Делаю вроде все так, как написано на этом замечательном форуме:

Код


#!C:\WWW\perl\bin\perl.exe

use CGI qw(:standard);

print "Content-type: text/html\n\n";

print "<html>";
my $chek = writeUploadFile("C:/img.gif","new");
print (qq($chek));
print "</html>";
sub writeUploadFile {
 my $file = shift; #handle ôàéëà
 my $dir  = shift; #äèðåêòîðèÿ, êóäà ñîõðàíÿåì
  my ($filename, $file_ext) = $file =~m/^.*(?:\/|\\|^)(\w+)\.(\w+)$/;
  if (!$filename || !$file_ext) {return (0)}
  if (!grep{/^$file_ext$/}qw(gif jpg png)) {return (0)}
   open (SAVE, ">$dir/$filename.$file_ext") or die "Can\'t create file \"$dir/$filename.$file_ext\": $!";
   binmode SAVE;
   flock SAVE, 2;
   print SAVE while (<$file>);
   close(SAVE);
   close($file);
   chmod 0644, "$dir/$filename.$file_ext";
   return (1);
}

Возвращается 1, рисунок сохраняется, но его рамер 0 байт smile

korob2001

Дата 7.12.2006, 15:29 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2871
Регистрация: 29.12.2002

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

Код


my $chek = writeUploadFile("C:/img.gif","new");

Это ты указал путь к файлу, который закачиваешь? Если да, то это и есть ошибка. Не нужно считать, что поле <input type="file"> можно заменить полем <input type="text">.

Закачивай через такую форму:

Код


<form action="/cgi-bin/your_script.pl" enctype="multipart/form-data" method="POST">
<input type="file" name="myfile"/>
<input type="submit" value="Отправить">
</form>

Затем получай параметр myfile.

Это сообщение отредактировал(а) korob2001 - 7.12.2006, 15:29

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

"Время проходит", - привыкли говорить вы по неверному пониманию.
"Время стоит - проходите вы".

Tigra

Дата 7.12.2006, 16:36 (ссылка)

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

Загрузка ...

Новичок

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

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

Видимо, теперь я неправильно получаю параметр smile

Код


use CGI qw(:standard);

print "Content-type: text/html\n\n";

print "<html>";
print (qq(<form action="test1.cgi" enctype="multipart/form-data" method="POST">
<input type="file" name="myfile"/>
<input type="submit" value="Îòïðàâèòü">
</form>)); 
print "</html>";

Код


use CGI qw(:standard);

print "Content-type: text/html\n\n";

print "<html>";
my $query=new CGI;
my $myfile=$query->param('myfile');
my $chek = "hello";
print (qq($chek));
print "</html>";

Заветное "hello" на странице так и не появляется smile

korob2001

Дата 8.12.2006, 03:05 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2871
Регистрация: 29.12.2002

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

Странно, у меня появляется. Попробуй добавить тэги <body></body>.

PS: Если юзаешь ООП, то не нужно ничего экспортировать в текущее пространство имён. Т.е. пишешь просто:

Код


use CGI;

А не:

Код


use CGI qw(:standard);

В первом коде вообще нет смысла подключать CGI, так как там ты ниразу им не воспользовался.

Это сообщение отредактировал(а) korob2001 - 8.12.2006, 03:07

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

"Время проходит", - привыкли говорить вы по неверному пониманию.
"Время стоит - проходите вы".

korob2001

Дата 8.12.2006, 04:34 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2871
Регистрация: 29.12.2002

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

Вот пример:

Код


#!/usr/bin/perl -w
use strict;
use CGI::Carp qw(fatalsToBrowser);
use CGI;
$CGI::POST_MAX = 1024 ** 2; # Файлы размером больше 1 мегобайта не грузить.
# Создаём объект CGI
my $cgi = new CGI();

# Подпрограмма выводит форму
sub show_form {
    my $ms = shift || "";
    print
        $cgi->header(-charset => "Windows-1251"),
        $cgi->start_html(-title => "Форма"),
        $cgi->start_multipart_form(-action => $cgi->url(-relative=>1)),
        $cgi->p($cgi->b("Укажите путь к изображению, которое хотите загрузить на сервер"));

    # Если в подпрограмму была передана строка, то это говорит о том, что произошла ошибка
    # Выводим её пользователю
    if ($ms) {
        # Определяем стили сообщения об ошибке, вообше-то лучше передавать их в подпрограмму
        # Тогда появится возможность применять и другие стили для вывода сообщений. Например:
        # Warnings - синим цветом, а Fatal errors - красным, Success operation - зелёным.
        my $style = "background-color: #cc0000;color: #ffffff;padding: 5px; font-weight: bold; width: 300px;";
           $style .= "border-color: #000000; border-style: solid; border-width: 1px; font-size: 14px";
        print
           $cgi->div({-style => $style},$ms),
           $cgi->br();
    }

    print
        $cgi->filefield(-name => "myfile"),
        $cgi->br(), $cgi->br(),
        $cgi->submit(-name => "send",-value => "Отправить"),
        $cgi->end_form(),
        $cgi->end_html();
    exit 0;
}

# Подпрограмма выводит изображение
sub show_file {
    my $file = $cgi->param('myfile');
    my $type = $cgi->uploadInfo($file)->{'Content-Type'};
    &show_form("Недопустимый тип файла '$type'.Принимаются только файлы jpg, png, gif.") unless ($type =~ /(?:p?jpe?g|png|gif)$/i);
    print $cgi->header(-type => $type);
    binmode STDOUT;
    print <$file>;
}

# Условия программы
if (defined $cgi->param('myfile') && !$cgi->param('myfile')) {
    &show_form("Вы забыли указать путь к файлу.");
} elsif (defined $cgi->param('myfile') && $cgi->param('myfile')) {
    &show_file();
} else {
    &show_form();
}

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

"Время проходит", - привыкли говорить вы по неверному пониманию.
"Время стоит - проходите вы".

Tigra

Дата 8.12.2006, 09:51 (ссылка)

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

Загрузка ...

Новичок

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

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

Тут у меня какая-то проблема с созданием объекта CGI

Код


my $cgi = new CGI();

Нижеследующий код к результату тоже не приводит smile

Код


use CGI;

print "Content-type: text/html\n\n";

print "<html>";
print "<body>";
my $query = new CGI(); 
my $chek = "hello";
print (qq($chek));
print "</body>";
print "</html>";

korob2001

Дата 8.12.2006, 17:10 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2871
Регистрация: 29.12.2002

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

А в чём ты его запускаешь?

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

"Время проходит", - привыкли говорить вы по неверному пониманию.
"Время стоит - проходите вы".

Tigra

Дата 8.12.2006, 20:16 (ссылка)

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

Загрузка ...

Новичок

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

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

Запускаю в Opera, IE. Сервер: Apache
С передачей текста - все ок, а вот с файлами не получается smile

korob2001

Дата 8.12.2006, 21:13 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2871
Регистрация: 29.12.2002

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

А код, который я привёл выше, не пробовал запускать. Он точно рабочий, так как я его протестировал перед тем как запостить сюда.

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

"Время проходит", - привыкли говорить вы по неверному пониманию.
"Время стоит - проходите вы".

Tigra

Дата 9.12.2006, 00:43 (ссылка)

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

Загрузка ...

Новичок

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

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

Там получаю ошибку. Судя по всему из-за

Код


use CGI::Carp qw(fatalsToBrowser);

А если убрать, то результат опять не получаю smile

korob2001

Дата 9.12.2006, 02:57 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2871
Регистрация: 29.12.2002

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

Какую ошибку? Вообще-то для этого я и добавил эту строку, легко же догадаться - fatalsToBrowser. Вобщем верни эту строку на прежнее место, запусти скрипт и ошибку скопируй сюда.

Это сообщение отредактировал(а) korob2001 - 9.12.2006, 02:59

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

"Время проходит", - привыкли говорить вы по неверному пониманию.
"Время стоит - проходите вы".

Tigra

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

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

Загрузка ...

Новичок

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

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

Internal Server Error
The server encountered an internal error or misconfiguration and was unable to complete your request.

Tigra

Дата 10.12.2006, 14:28 (ссылка)

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

Загрузка ...

Новичок

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

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

Спасибо большое за заботу, Короб!!! smile

Просто у меня была не полная версия Perl.
Теперь все работает!!!

korob2001

Дата 11.12.2006, 00:16 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2871
Регистрация: 29.12.2002

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

Нема за що. smile

Кстати была:
Внутренняя ошибка сервера. Так как мой код у меня прекрасно работал, потому с заголовками там всё нормально. Скорее всего ты юзаешь Денвер в котором, помоему, нет модуля CGI::Carp.

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

"Время проходит", - привыкли говорить вы по неверному пониманию.
"Время стоит - проходите вы".

Materium

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

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

Загрузка ...

Шустрый

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

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

Короб в Денвере есть Carp у меня работает. Правда я качал Денвер-2 может в этом фишка. )))

Добавлено @ 19:53
Tigra читай error.log он тоже рулит всегда. Неполная версия Перл это что значит??? Может не все библиотеки были установлены ты имеешь ввиду?

Добавлено @ 19:56
Если юзаешь Денвер то, например, при скачивании пакета ActiveState и при его интсалляции Денвер, на моё удивление, автоматически перехватил инсталяцию и начал к себе в папку инсталить всю библиотеку модулей. ))) Очень удобно получилось.

Это сообщение отредактировал(а) Materium - 20.12.2006, 19:53

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

#!sub abc {return "ok"}${&abc()}="TMTOWTDI";print "$ok";

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