Masters of CGI.Perl
 Сайт клуба знатоков CGI.Perl 
FAQ · Статьи · Конференция · Ссылки · Скрипты

Часто задаваемые Вопросы.. F.A.Q.

Дайджест от 15.11.2000

Если Вы не нашли ответ на свой вопрос в этом дайджесте, то попробуйте найти его в основной базе:

Ключевые слова

Напоминаем, Вы можете получать FAQ на свой e-mail !!! Достаточно подписаться на нашу почтовую конференцию.
 

  Название : Полезные функции  

  1. Как проверить, поддерживает ли сервер LWP?
  2. Как узнать IP машины, пришедшей из-за прокси?
    Помогите чем угодно, а то меня некоторые редиски достали, пришут в гостевую книгу что попало а ее иногда ректор читает.
  3. Как послать письмо с присоединенным файл-аттачем ?
  4. Как пользоваться функцией pack (getpwuid, dmbopen)?
  5. Как отправить почту из скрипта на Perl?
  6. Закачка файлов на сервер и решение глюка с закачкой
  7. Hадо записать в файл строку, а потом прочесть ее оттуда
  8. Как одновременно поставить куку и сделать редирект?
  9. Как передать из одного скрипта данные другому скрипту методом GET, вроде бы понятно. А как передавать данные методом POST?
  10. Как устроить загрузку файла с удаленного сервера? Проще говоря, скачать скриптом файл с http или ftp
  11. Как по дате вычислить день недели?
  12. Как послать по e-mail письмо с аттачем?
  13. Функция time() возвращает время с точностью до секунды. Как работать с меньшими промежутками?
  14. Где взять побольше полезных функций?
  15. Как округлить число?
  16. Хочу прочитать список файлов в каталоге, но почему-то не работает или глючит.
    Делаю так: @files=<*>;

 

Как проверить, поддерживает ли сервер LWP?


eval {require LWP};
if($@) { warn "LWP is not installed\n" }

Дата добавления: 5.10.2000 Прислать свои комментарии  Наверх 

Как узнать IP машины, пришедшей из-за прокси?
Помогите чем угодно, а то меня некоторые редиски достали, пришут в гостевую книгу что попало а ее иногда ректор читает.


Похожая проблема была у меня с http://simplex.ru (а у кого ее не было?)
Поэтому я сделал "черный список" и помещаю туда подсети. Может тебе пригодится моя функция внизу, а про подсети смотри на simplex.ru/olds.html

###############################################################################
#
# Convert dotted ip address into long number (same subnets - same numbers)

#
###############################################################################


sub subnet ($)
{
my ($a, $b, $c, $d, $l);
return 0 unless $_[0] =~ /^ (\d+) \. (\d+) \. (\d+) \. (\d+) $/x;
($a, $b, $c, $d) = ($1, $2, $3, $4);
if ($a < 128) # subnet class A
{ $b = $c = $d = 0; }
elsif ($a < 192) # subnet class B
{ $c = $d = 0; }
else # class C + others
{ $d = 0; }
$l = ($a << 24) + ($b << 16) + ($c << 8) + $d; # return long number
}
Источник: конференция FIDO - RU.CGI.PERL

Прислал: Alex Farber

Дата добавления: 8.09.2000 Прислать свои комментарии  Наверх 

Как послать письмо с присоединенным файл-аттачем ?


При отправке сообщений по электронной почте используется MIME формат сообщений. Тело письма разграничивается на области с различными форматами посылаемых данных. Перед отправкой файла его необходимо перевести в формат base64 и добавить как одну из частей multipart сообщения. Пример иллюстрирует этот метод:
open (MAIL1,"|sendmail $email");
print MAIL1 "From:$from\n";
print MAIL1 "To:$email\n";
print MAIL1 "Subject:E-mail you requested\n";    
print MAIL1 "X-Mailer:MNEMONIC Mailer\n";
print MAIL1 "MIME-Version: 1.0\n";
print MAIL1 "Content-Type: multipart/mixed; boundary=\"--------part2243673o4iu5y\"\n\n";
print MAIL1 "This is a multi-part message in MIME format (c) mnemonic\n";
print MAIL1 "--------part2243673o4iu5y\n";
print MAIL1 "Content-Type: text/plain; charset=koi8-r\n";
print MAIL1 "Content-transfer-encoding: 8bit\n";
print MAIL1 "Вот письмо с аттачем\n";
print MAIL1 "--------part2243673o4iu5y\n";
print MAIL1 "Content-Type: $mimetype; name=\"$result_filename\"\n";
print MAIL1 "Content-Transfer-Encoding: base64\n\n";

open(FILE,$attach); # файл в кодировке base64 !
while ($str=<FILE>) { print MAIL1 $str; }
close(FILE);

print MAIL1 "--------part2243673o4iu5y\n";
close(MAIL1);
}

Дата добавления: 5.09.2000 Прислать свои комментарии  Наверх 

Как пользоваться функцией pack (getpwuid, dmbopen)?


man perlfunc или "perldoc -f имя_функции | pod2text"

Пара примеров для unpack:

Определение типа изображения и его размеров:

sub get_image_spec {
# Возвращает ($Тип_изображения, $ширина, $высота)
my $buf = $_[0];
my ($type, $width, $height);
if (unpack("n", $buf) == 0xffd8) {
return ('jpeg', 0, 0); # Про jpeg я пока не знаю как
# определить его размеры
} elsif (unpack("A4", $buf) eq "GIF8") {
my ($type, $width, $height) = unpack("A6 v v", $buf);
return ('gif', $width, $height);
}
}

read(STDIN, $buf, 120);

print join (", ", get_image_spec($buf));

Дата добавления: 2.09.2000 Прислать свои комментарии  Наверх 

Как отправить почту из скрипта на Perl?


Способ только для Unix oт Alex Efros
open MAIL, '|/path/to/your/sendmail -t'; # Pipe к sendmail
print MAIL "From: mailrobot@my.host\n",
"To: webmaster@my.host\n",
    "Subject: Wow! I got some mail for you!!!\n\n",
    $message;
close MAIL;
Подробности: man sendmail, http://www.sendmail.org    
У меня не Unix! Что делать?
Вероятно, Вам поможет модуль Net::SMTP

Источник: конференция FIDO7.RU.CGI.PERL

Дата добавления: 31.08.2000 Прислать свои комментарии  Наверх 

Закачка файлов на сервер и решение глюка с закачкой


#!/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!'), # напечатать форму с кнопкой
end_form; # напечатать </FORM>
}

# Этот скрипт никому не мешает вводить мусор (например xxxx.gif) в поле foto,
# что приведет к созданию пустых файлов; если это Вас беспокоит, установите
# новую версию CGI.pm и прочтите
# http://stein.cshl.org/WWW/software/CGI/#upload

elsif (not sysopen FILE, "$DIR/$1", O_EXCL | O_CREAT | O_WRONLY, 0444)
{
print h1 ("Hе могу создать $DIR/$1: $!"); # ошибка или такой файл уже есть
}

# Портятся файлы при посылке? См. ниже!

else # все в порядке - файл создан
{
binmode FILE; # включить binmode для Windows
print FILE while (<$foto>); # и скопировать данные в файл
close FILE;

print h1 ('Сердечное Вам спасибо!'); # воспитывать как собак Павлова
}

print end_html; # напечатать </BODY></HTML>

Если закачка некоторых файлов происходит с глюками - видимо, файл перекодируется на лету русским апачем.

Варианты решения:
  1. запретите все перекодировки для скрипта, который разбирает FileUpload, например таким способом:
      <Location /path/to/upload.cgi>
    CharsetDisable On
    </Location>
    и делайте перекодировку сами.
  2. Используйте директиву CharsetRecodeMultipartForms, которая появилась в PL23, но при этом вам все равно придется перекодировать вручную текстовые части запросов. Для этого можно использовать Russian Apache API, доступное в других модулях или Russian Apache Perl API, доступное из mod_perl.

Источник: FIDO - RU.CGI.PERL (FAQ created by SLY Golovanov, 2:5020/794.13)

Дата добавления: 31.08.2000 Прислать свои комментарии  Наверх 

Hадо записать в файл строку, а потом прочесть ее оттуда


# записать строку в файл
open FILE,'>file'; # открыть файл на запись
print FILE 'строка'; # записать строку
close FILE; # закрыть файл

# прочитать строку из файла
open FILE,'file'; # открыть файл на чтение
$string=<FILE>; # прочесть одну строку, включая символ "перевод строки"
chomp($string); # обрезать в конце строки "перевод строки", если он есть
close FILE; # закрыть файл
Источник: FIDO - RU.CGI.PERL (FAQ created by SLY Golovanov, 2:5020/794.13)

Дата добавления: 31.08.2000 Прислать свои комментарии  Наверх 

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


sub ReLocate
{
my($where,$cookie)=@_;
print "Status: 302 Moved\n";
if ($cookie ne '') { print "Set-Cookie: $cookie\n" }
print "Location: $where\n\n";
}
Источник: FIDO - RU.CGI.PERL (FAQ created by SLY Golovanov, 2:5020/794.13)

Дата добавления: 31.08.2000 Прислать свои комментарии  Наверх 

Как передать из одного скрипта данные другому скрипту методом GET, вроде бы понятно. А как передавать данные методом POST?


Вот пример использования:
#== Post (url, данные)
sub Post
{ my ($url, $data) = @_;
$ua = new LWP::UserAgent;
$ua->max_size(4200);
my $req = new HTTP::Request 'POST',$url;
$req->content_type('application/x-www-form-urlencoded');
$req->content($data);
my $res = $ua->request($req);
return $res->as_string;
}
Автор: Алексей (Мерлин)

Дата добавления: 31.08.2000 Прислать свои комментарии  Наверх 

Как устроить загрузку файла с удаленного сервера? Проще говоря, скачать скриптом файл с http или ftp


Вот пример использования LWP:
#!/usr/bin/perl
use LWP::UserAgent;
$| = 1;
print "Content-type: text/html\n\n";
$url= "http://perl.mastak.com/";
$line = &GetPage($url);
print $line;
exit;

#=================================================
#== Читает страницу по интернет
#=================================================
sub GetPage
{ my $url = shift;
$url = "http://$url" unless ($url =~ /^http:/i);
my $UA = new LWP::UserAgent;
$UA->agent("Mozilla/5.0 (InfoArt crawler)");
$UA->timeout(1000);
$UA->max_size(16000);
my $request=new HTTP::Request("GET"=>$url);
$request->header('Accept' => 'text/html');
my $response = $UA->request($request);
if ($response->is_success) {
return ($response->content);
} else {return 0;}
}
Автор: Сергей Щербаков и Алексей (Мерлин)

Дата добавления: 31.08.2000 Прислать свои комментарии  Наверх 

Как по дате вычислить день недели?


Date::Calc
Источник: FIDO - RU.CGI.PERL (FAQ created by SLY Golovanov, 2:5020/794.13)

Дата добавления: 31.08.2000 Прислать свои комментарии  Наверх 

Как послать по e-mail письмо с аттачем?


Mime::Lite
Источник: FIDO - RU.CGI.PERL (FAQ created by SLY Golovanov, 2:5020/794.13)

Дата добавления: 31.08.2000 Прислать свои комментарии  Наверх 

Функция time() возвращает время с точностью до секунды. Как работать с меньшими промежутками?


Time::HiRes
Источник: FIDO - RU.CGI.PERL (FAQ created by SLY Golovanov, 2:5020/794.13)

Дата добавления: 31.08.2000 Прислать свои комментарии  Наверх 

Где взять побольше полезных функций?


Полезные модули - все есть на http://search.cpan.org, либо входят в поставку.
Некоторые есть и для Activestate Perl, www.activestate.com/packages/zips/

Дата добавления: 31.08.2000 Прислать свои комментарии  Наверх 

Как округлить число?


sprintf("%3.2f",$dig)
Здесь 3 - кол-во знаков до запятой, 2 - после запятой.

Источник: FIDO - RU.CGI.PERL (FAQ created by SLY Golovanov, 2:5020/794.13)

Дата добавления: 31.08.2000 Прислать свои комментарии  Наверх 

Хочу прочитать список файлов в каталоге, но почему-то не работает или глючит.
Делаю так: @files=<*>;


Такой способ вызывает внешнюю программу glob (также, как и способ @files=glob("*")). Это неправильно не только потому, что на запуск внешней программы уходит время и ресурсы, но и потому, что где-нибудь этой программы может просто не оказаться. Более правильный способ - это:
opendir DIR,'/tmp';
@files=readdir DIR;
closedir DIR;
или
opendir DIR,'/tmp';
while $file (readdir DIR)
{
}
closedir DIR;
Заметьте, что в $file будут подставляться как имена файлов, так и имена подкаталогов.
Hесколько подсказок. Чтобы прочесть список файлов, в котором не содержалось бы '.' и '..', можно написать следующее:
opendir DIR,'/tmp';
@files=grep !/^\.+$/,readdir DIR;
closedir DIR;
Таким же способом,- с помощью regexp,- можно задавать любые другие маски файлов. Если вы хотите прочесть список каталогов, не трогая файлы:
opendir DIR,/tmp';
@dirs=grep {!/^\.+$/ and -d "/tmp/$_"} readdir DIR;
closedir DIR;
Источник: FIDO - RU.CGI.PERL (FAQ created by SLY Golovanov, 2:5020/794.13)

Дата добавления: 31.08.2000 Прислать свои комментарии  Наверх 

Сайт клуба знатоков CGI.Perl - Masters of CGI.Perl
Designed by MoveR Studio © 2000  - | -  Вопросы? Предложения? пишите