div.main {margin-left: 20pt; margin-right: 20pt}Практические примеры программирования cgi-скриптов на Perl: работа с файлами и каталогами.
Прислал: OlegTr [ 12.03.2001 @ 08:39 ]
Раздел:: [ Статьи по Perl ]
Работа с файлами и каталогами.
Чтение и запись файлов и каталогов является едва ли не главным достоинством Perl.
Практически любой Perl-скрипт использует либо запись в файлы,либо поиск определенных строк в файле,либо запись или загрузку файлов в каталоги.
Кратко напомню основные положения:
Файл можно открывать для чтения,записи,добавления либо поиска определенных строк.
Открыть файл для чтения: open (FILE,"$file");
Открыть файл для записи: open (FILE,">$file");
Открыть файл для добавления: open (FILE,">>$file");
Открыть файл для чтения и добавления: open (FILE,"+<$file");
Где FILE-это дескриптор или описатель файла,т.е. имя,под которым он фигурирует в программе.Может быть любым набом символов,рекомендуется набирать прописными буквами во избежание неоднозначностей.
$file-переменная для файла,содержит обычно имя файла и путь к нему.Предпочтительно объявить эту переменную в начале скрипта.Это удобно,если файл находится где-то глубоко в подкаталогах,к примеру,неудобно все время набирать /usr/local/htdocs/main/pages/file.html.
Думаю,с этим особых вопросов не возникнет.Еще нужно отметить,что содержимое файла можно читать построчно или в массив:
#!/usr/local/bin/perl
open (STAT,"$file");#Прочесть одну строку из файла.
$count=;
close (STAT);
-------------------------------------------------
#!/usr/local/bin/perl
open (STAT,"$file");#Прочесть файл в массив.
@count=;
close (STAT);
Что касается каталога,то его тоже можно открывать для чтения командой readdir.Для того,чтобы понять как все это происходит,рассмотрим практические примеры.
Пример 1.
Рассмотрим сценарий регистрации пользователя на веб-сервере.Имя пользователя и его пароль записываются в текстовый файл и используются для его последующей аутентификации.
#!/usr/local/bin/perl
#Объявляем глобальные переменные.
$request=$ENV{'REQUEST_METHOD'};
$content=$ENV{'CONTENT_LENGTH'};
$basedir="http://www.mydomain.com/~";
$userdir="f:/home";
#Подпрограммы для декодирования данных из формы.
sub urldecode {
local($val)=@_;
$val=~ s/+/ /g;
$val=~ s/%[0-9a-hA-H] {2}/pack('C',hex($1))/ge;
return $val;
}
sub strhtml {
local($val)=@_;
$val=~s//g;
$val=~s/(http://+S)/<A href="$1">$1</A>/g;
return $val;
}
######################################################################
if ($request eq 'GET') {
$query=$ENV{'QUERY_STRING'};
}
else {
sysread(STDIN,$query,$content);
}
#Генерируем форму,если никакие данные не введены.
print "Content-type:text/htmlnn";
print <<HTML_gen;
<HTML><BODY bgcolor="e6e8fa">
HTML_gen
if ($query eq '') {
print <<HTML;
<h2 align=center><font color="ff0000">Registration.</font></h2>
<p><font face="serif" size=2> Please,fill in the form below.
<p>After registration you will receive your personal directory and unique
URL.Fill all fields carefully.
Form fields marked as <font color="ff0000">*</font>are required.</font>
<p><FORM ACTION="../cgi-bin/addlogin.cgi" METHOD="POST" name="reg">
<center><TABLE BGCOLOR="bfbfbf">
<TR><td><font color="ff0000">*</font>
<TD><b>Login:</b><TD><INPUT TYPE="text" NAME="login" SIZE="20">
<TR><td><font color="ff0000">*</font>
<TD><b>Password:</b>
<TD><INPUT TYPE="password" NAME="pass" SIZE="20">
<TR><td><font color="ff0000">*</font><TD><b>E-mail:</b>
<TD><INPUT TYPE="text" NAME="email" SIZE="20">
<TR><TD colspan=3><p><center>
<INPUT TYPE="submit" VALUE="Submit"></center>
</TABLE></center>
</FORM>
HTML
#Декодируем поля формы
else {
foreach (@fields=split(/&/,$query)) {
if (/^login=(.*)/) { $login=&urldecode ($1); }
if (/^pass=(.*)/) { $password=&urldecode ($1); }
if (/^email=(.*)/) { $email=&urldecode ($1); }
}
#Проверяем,не существует ли данное имя в системе.
open(INFO,"login.txt") ||die;
@data=<INFO>;#Читаем строки в массив.
close(INFO);
foreach $string(@data) {
@item=split(/&/,$string);#Разбиваем строку на части.
foreach (@item) {
if ($item[0] eq $login) { #Сравниваем полученное имя с первым полем файла
#для каждой строки и если такое найдено выдаем
#ошибку.
print <<HTML;
<h2 align=center><font color="ff0000">Error!</font></h2>
<p><center><b>The name <font color="ff0000">$login</font> already exists in the system.
<p>Please,go back and choose another name.</b>
<p><form><input type="button" value="Back" onClick="history.back()"></form>
</center>
HTML
exit;
}
}
}
#Если имя не найдено,открываем базу данных и добавляем информацию.
if ($item[0] ne $login) {
open(DATA,">>login.txt");
$string=join('&',$login,$password,$email,scalar localtime,$ENV {'REMOTE_ADDR'};
print DATA "$stringn";
close(DATA);
#Создаем домашний каталог пользователя и переходим в него.
mkdir("$userdir/$login",0700);
chdir("$userdir/login");
opendir(USER,"$userdir/$login");
#Помещаем файл index.html в каталог пользователя.
open(IN,">$userdir/$login/index.html");
print IN "This is the test!n";
close(IN);
closedir(USER);
#Содержание файла может быть любым,это только для примера.
#Генерируем ответ пользователю.
print <<HTML;
<p><h1 align=center><font color="ff0000">Congratulations!</font></h1>
<p><b>Your registration was successful and your data were added to
our database.Thank you for your time.</b>
<p><center><b><font color="ff0000">
You entered:</font>(print this page and keep it in safe place)</b>
<p><table>
<tr><td><b>Your login name:</b><td><font color="0000ff">$login</font>
<tr><td><b>Your password:</b><td><font color="0000ff">$password</font>
<tr><td><b>Your e-mail address:</b><td><font color="0000ff">$email</font>
</table></center>
HTML
}
}
Скрипт выдает ответ в виде html-страницы,содержащей всю информацию,введенную пользователем.
Пример 2.
Рассмотрим пример открытия и чтения каталога и вывод списка файлов,содержащихся в нем.Начало скрипта можно взять из предыдущего примера.Предположим,что пользователь,зарегистрированный на веб-сервере,хочет войти в свой домашний каталог.
#!/usr/local/bin/perl
#Объявляем глобальные переменные.
$request=$ENV{'REQUEST_METHOD'};
$content=$ENV{'CONTENT_LENGTH'};
$basedir="http://www.mydomain.com/~";
$file="login.txt";
$url="http://www.mydomain.com";
$dir="f:/home/";
$cgi="f:/usr/local/apache/cgi-bin";
#Подпрограммы для декодирования данных из формы.
sub urldecode {
local($val)=@_;
$val=~ s/+/ /g;
$val=~ s/%[0-9a-hA-H] {2}/pack('C',hex($1))/ge;
return $val;
}
sub strhtml {
local($val)=@_;
$val=~s//g;
$val=~s/(http://+S)/<A href="$1">$1</A>/g;
return $val;
}
######################################################################
if ($request eq 'GET') {
$query=$ENV{'QUERY_STRING'};
}
else {
sysread(STDIN,$query,$content);
}
#Генерируем форму,если никакие данные не введены.
print "Content-type:text/htmlnn";
print <<HTML_gen;
<HTML><BODY bgcolor="e6e8fa">
HTML_gen
if ($query eq '') {
print "Content-type:text/htmlnn";
print <<HTML;
<HTML><HEAD>
</HEAD><BODY bgcolor="e6e8fa">
<FORM ACTION="../cgi-bin/fileman.cgi" name="form1" METHOD="POST">
<h2 align=center><font color="ff0000">System login.</font></h2>
<p><center>Please,enter your login name and password:
<p><TABLE BGCOLOR="cccccc">
<tr><td colspan=2 align=center bgcolor="99cccc"><b><font color="ff0000">
I am registered user</font></b>
<TR><TD><p><b>Login:</b><TD><INPUT TYPE="text" NAME="login" SIZE="20">
<TR><TD><p><b>Password:</b><TD><INPUT TYPE="password" NAME="pass" SIZE="20">
<tr><td colspan=2 align=center><input type=submit value="Submit"></center>
HTML
}
#Если информация получена,декодируем поля формы.
else {
foreach (@fields=split(/&/,$query)) {
if (/^login=(.*)/) { $login=&urldecode ($1); }
if (/^pass=(.*)/) { $password=&urldecode ($1); }
}
#Открываем базу данных и проверяем логин и пароль.
open(INFO,$file) ||die;
@data=;
close(INFO);
foreach $string(@data) {
@item=split(/&/,$string);
foreach (@item) {
if (($item[0] eq $login) && ($item[1] eq $password)) {
#Если все нормально,переходим в пользовательский каталог.
print "Content-type:text/htmlnn";
print <<HTML;
<html><body bgcolor="e6e8fa">
#Приветствуем пользователя.
<p><h2 align=center><font color="ff0000">Hello,$login!</font></h2>
<p><center>Welcome to your home directory!
<p>Your URL is <a href="$basedir$login">$basedir$login.</a></center>
HTML
#########################
# Directories list #
#########################
$userdir=$dir.$login;
chdir ("$userdir");
#Открываем каталог и читаем список файлов в массив.
opendir(DIR,"$userdir") || die "Cannot open $userdir!";
while (@files=readdir(DIR)) {
#Если каталог содержит подкаталоги,выводим их отдельно,а также не показываем
#каталоги "." и ".." Печатаем шапку таблицы.
print <<HTML;
<p><center>
<table bgcolor="bfbfbf" width=600 border cellspacing=0 cellpadding=0 nowrap>
<tr><td colspan=5 align=center nowrap><b><font color="ff0000">Directories</font></b></td></tr>
<tr><td>.</td><td align=center><b>List</b></td><td><b>Size</b><td><td><b>Last accessed</b></td><td><b>Last modified</b></td>
HTML
foreach $file(@files) {
#Стстистика файлов-размер,время последнего обращения и модификации.
$size=(stat("$userdir/$file"))[7];
$atime=localtime((stat("$userdir/$file"))[8]);
$mtime=localtime((stat("$userdir/$file"))[9]);
#Печатаем список подкаталогов.
if ( -d "$userdir/$file" && "$file" ne "." && "$file" ne "..") {
print "<tr><td width=30><img src="$url/image/folder.gif"></td><td width=100 align=left>$file</td>n";
print "<td width=50>",$size,"</td><td width=200>",$atime,"</td><td width=200>",$mtime,"</td></tr>n";
}
}
print "</table>n";
################
# Files list #
################
#Ту же операцию проводим для файлов.Печатаем шапку таблицы.
print <<HTML;
<p><table bgcolor="bfbfbf" width=600 border cellspacing=0 cellpadding=0>
<tr><td colspan=5 align=center><b><font color="ff0000">Files</font></b></td></tr>
<tr><td>.</td><td><b>List</b><td><b>Size</b><td><b>Last accessed</b><td><b>Last modified</b></tr>
HTML
foreach $file(@files) {
$size=(stat("$userdir/$file"))[7];
$atime=localtime((stat("$userdir/$file"))[8]);
$mtime=localtime((stat("$userdir/$file"))[9]);
if (!-d "$userdir/$file" && "$file" ne "." && "$file" ne "..") {
push (@dir,"$userdir/$file");#Помещаем найденные файлы в массив
$number=@dir; #Подсчитываем их количество.
#Выдаем информацию.
print "<tr><td width=30><img src="$url/image/page.gif"></td><td width=100><a href="$basedir$login/$file">",$file,"</a></td>n";
print "<td width=50>",$size ,"</td>n";
print "<td width=200>",$atime,"</td><td width=200>",$mtime,"</td></tr>n";
}
}
print "</table>n";
print "<p><center><b><font color="0000ff">There are ",$number," files in this directory.</b></font></center>n";
}
Надеюсь,я объяснил все достаточно подробно.Я выбрал намеренно сложные примеры,чтобы
показать все операции,которые можно производить с файлами и каталогами.Файлы еще можно
загружать на сервер через веб.Этому посвящен следующий раздел.
Загрузка файлов на сервер через Интернет.
Файлы можно загружать на веб-сервер через Интернет,используя формы.Вы,наверное,сами не раз
это делали.Разберем более подробно,как это делается.
Нужно создать форму с полем типа file и методом кодировки multipart/form-data.
#!/usr/local/bin/perl
print "Content-type:text/htmlnn";
print <<HTML;
<html><head>
<script language="javascript">
<!--
function fill () {
if (fn==document.form.entry.value) {
document.form.file.value=fn; }
}
//-->
</script>
</head>
<body bgcolor="e6e8fa">
HTML
print "<p><table width=300 bgcolor="bfbfbf">n";
print "<h3 align=center><font color="0000ff">File upload:</font></h3>n";
print "<center><FORM action="../cgi-bin/upload.cgi" name="form"
METHOD="POST" ENCTYPE="multipart/form-data">n";
print "<tr><td align=center><b>Select file:</b></td>n";
print "<tr><td><input type="file" name="entry" onBlur="fill()"></td>n";
print "<tr><td><input type="hidden" name="file" value="1"></td>n";
print "<tr><td align=center><input type="Submit" value="Upload"></td></table>n";
print "</form></center></table></body></html>n";
Функция Javascript использована для того,чтобы передать на сервер имя загружаемого файла,
включая полный путь.Далее,скрипт декодирует его,отбросит путь и загрузит файл под его именем.
Функцию для декодирования в этом случае я использую готовую,нашел в Интернете,за что большое спасибо ее разработчику.
$content_type = $ENV{'CONTENT_TYPE'};
binmode STDIN;
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
if ((!$content_type) || ($content_type =~ m#^multipart/form-data#)){
($boundary = $content_type) =~ s/^.*boundary=(.*)$/1/;
@pairs = split(/--$boundary/, $buffer);
@pairs = splice(@pairs,1,$#pairs-1);
for $part (@pairs)
{
($dump,$fline,$value) = split(/rn/,$part,3);
next if $fline =~ /filename=""/;
$fline =~ s/^Content-Disposition: form-data; //;
(@columns) = split(/;s+/, $fline);
($name = $columns[0]) =~ s/^name="([^"]+)"$/1/g;
if ($#columns > 0)
{
if ($value =~ /^Content-Type:/)
{
($dump,$dump,$value) = split(/rn/,$value,3);
}
else {($dump,$value) = split(/rn/,$value,2);}}
else {($dump,$value) = split(/rn/,$value,2);
if (grep(/^$name$/, keys(%CGI))) {
if (@{$FORM{$name}} > 0) {
push(@{$FORM{$name}}, $value);}
else {
$arrvalue = $FORM{$name};
undef $FORM{$name};
$FORM{$name}[0] = $arrvalue;
push(@{$FORM{$name}}, $value);}}
else {
next if $value =~ /^s*$/;
$FORM{$name} = $value;}
next;}
$FORM{$name} = $value;}}
Как видите,довольно сложная и громоздкая,зато загрузка проходит без проблем.Далее нужно получить имя файла и отбросить путь,оставив только имя.
$upfile=$FORM {'entry'}; #Имя загружаемого файла.
$destfile=$FORM {'file'}; #Имя,под которым он будет записан в каталог назначения.
$destdir="/home/upload"; #Имя каталога для загрузки.
chdir ("$destdir");
#Отбрасываем путь,оставляя только имя.
$destfile=~s/w+//;
$destfile=~s/([^/\]+)$//;
$destfile=$1;
#Далее записываем файл в каталог назначения.
open(FILE, ">$destdir/$destfile"); #Открываем на запись новый файл.
binmode FILE; #Устанавливаем бинарный режим.
print FILE $upfile; #Записываем в него содержимое загруженного файла.
close(FILE); #Закрываем файл.
Все,загрузка завершена.Таким способом можно загружать сразу несколько файлов-5 или 10,создав для каждого элемент формы и,само собой,добавив в скрипте нужное количество обработчиков.
|
