Создание серверных приложений на языке PERL

Примеры скриптов


  • Как одновременно поставить куки и сделать редирект?


  • Вечная тема - закачка файла на сервер(upload).



  • Q: Как одновременно поставить куки и сделать редирект?

    A:

    sub ReLocate

    {

    my($url,$cookie)=@_;

    print "Status: 302 Moved\n";

    if ($cookie ne '') { print "Set-Cookie: $cookie\n" }

    print "Location: $url\n\n";



    }
    Примечание:

    Не забудьте, что URL должен быть полным, частичные "не прокатывают" под некоторыми ОС и веб-серверами.

    Q: Вечная тема - закачка файла на сервер(upload).

    A:
    #!/usr/bin/perl # используйте -T для CGI-скриптов

    $SIG{ALRM} = sub { die "$0 timed out" }; # эти 2 строки не работают под

    alarm 900; # Windows, но они необязательны

    use strict; # спасает от глупых ошибок

    use Fcntl; # O_EXCL, O_CREAT и O_WRONLY

    use CGI qw (:standard); # читайте "perldoc CGI"

    use CGI::Carp qw (fatalsToBrowser); # вывод ошибок к browser-у

    $CGI::POST_MAX = 131072; # максимальный ввод = 128 KB

    my $foto = param ('foto'); # имя файла и одноврем. handle

    my $DIR = '/home/alex/pics' # не забудьте "chmod 777 pics"

    my $JS = " // JavaScript-функция для пред-

    // варительной проверки формы

    function check (form)

    {

    if (form.elements['foto'].value.length < 4)// foto должно быть заполнено

    {

    alert ('A gde zhe foto?'); // показать JavaScript-окошко

    form.elements['foto'].select (); // выделить текст в поле foto

    form.elements['foto'].focus (); // и прыгнуть туда курсором

    return false; // false запретит browser-у

    } // отправлять данные к серверу

    return true; // все OK - можно отправлять

    }";

    print header (-type => 'text/html; charset=koi8-r'),

    start_html (-title => 'МИСС ИHТЕРHЕТ', # напечатать заголовок и $JS

    -script => $JS);

    # regex внизу проверяет, есть ли .gif или .jp(e)g в конце и кладет имя

    # файла в $1

    if ($foto !~ /([\w-]+ \. (?: gif | jpe?g ))$/ix) #только имя,путь выкидывается

    {

    print h1 ('Отправьте нам фото!'), #start_form работать не будет

    start_multipart_form (-onsubmit => 'return check (this)'),

    filefield (-name => 'foto'),

    submit (-value => 'Go baby go!'), # напечатать форму с кнопкой

    Содержание раздела