#!/usr/bin/perl -w
$basedir = "/usr/home/vovka/public_html/files";
$donepage = "http://www.myserver.ru/~vovka/files";
use CGI;
$onnum = 1;
while ($onnum != 9) {
my $req = new CGI;
my $file = $req->param("FILE$onnum");
if ($file ne "") {
my $fileName = $file;
$fileName =~ s!^.*(\\|\/)!!;
$newmain = $fileName;
open (OUTFILE, ">$basedir/$fileName");
while (my $bytesread = read($file, my $buffer, 1024)) {
print OUTFILE $buffer;
}
close (OUTFILE);
}
$onnum++;
}
print "Content-type: text/html\n";
print "Location:$donepage\n\n";
Соответственно указывая число в цикле while ($onnum
!= 9) можно подгружать нужное чилсо файлов при одном POST запросе. html-код формы для скрипта такой:
<form method="POST" action="/cgi-bin/fup.pl"
ENCTYPE="multipart/form-data">
File 1: <input type="file" name="FILE1">
<br>File 2: <input type="file" name="FILE2">
<br>File 3: <input type="file" name="FILE3">
<br>File 4: <input type="file" name="FILE4">
<br>File 5: <input type="file" name="FILE5">
<br>File 6: <input type="file" name="FILE6">
<br>File 7: <input type="file" name="FILE7">
<br>File 8: <input type="file" name="FILE8">
<br>File 9: <input type="file" name="FILE9">
<br>
<input type="submit" value="Upload!">
</form>
Пакеты вида multipart/form-data описываются rfc1867, который будет описан более подродбно на предмет автоматической посылки изображений через формы, в которых сказано ENCTYPE="multipart/form-data", помимо простого текста(закодированного URI). Т.е. скрипт, посылающий картинки и текст на удаленный сервер.
Программа иллюстрирует использование переменной HTTP_X_FORWARDED_FOR из хэша %ENV, которая позволяет(если прокси не совсем прокси :), узнать о локальном адресе машины, находящейся за брандмауэром(файрволом, он-же прокси).
#!/usr/bin/perl
use LWP::UserAgent;
use HTTP::Request::Common;
print "Content-type: text/html\n";
print "Location: http://www.fsb.gov.ru/\n\n" if (&is_proxy());
print "Location:http://www.udaff.com/\n\n" unless (&is_proxy());
sub is_proxy{
return 1 if ($ENV{'HTTP_X_FORWARDED_FOR'} ne "");
$addr = $ENV{'REMOTE_ADDR'};
$ua = new LWP::UserAgent;
$ua->timeout(5);
foreach(80, 8000, 8080, 3128){
$ua->proxy('http', "http://$addr:$_/");
$resp = $ua->request(GET "http://www.ru/");
$cont = $resp->content();
return 1 if ($cont =~ /Russia on the Net/)
}
return 0;
}
скрипт написан grange
Допустим нужно создать отчет в формате Excel, для этого нужно скачать и установить модуль Spreadsheet.pm c сайта www.cpan.org. Приведенная ниже программа позволяет генерить файлы в формате excel с нужным размером полей, цветом букв и выравниванием содержимого ячеек по запросу пользователя.
.
#!/usr/bin/perl -w
use strict;
use Spreadsheet::WriteExcel;
use Lingua::RU::Charset qw (:CONVERT);
my $fraze="Жехжкфиео хмфктжэ";
my $workbook = Spreadsheet::WriteExcel->new("pr.xls");
my $sheet1 = $workbook->addworksheet();
my $sheet2 = $workbook->addworksheet();
my $sheet3 = $workbook->addworksheet("Example");
my $format = $workbook->addformat();
$format->set_bold();
$format->set_size(15);
$format->set_color('blue');
$format->set_align('center');
$sheet3->set_column(0, 0, 50);
$sheet3->activate();
$sheet3->write(0, 0, koi2win($fraze), $format);
$sheet3->write(1, 0, koi2win($fraze), $format);
$sheet3->write(2, 0, koi2win($fraze));
$sheet3->write(3, 0, koi2win("Дюв"));
$sheet3->write(4, 0, koi2win("Жфк"));
$sheet3->write(5, 0, 4.00001);
my $date = $workbook->addformat();
$date->set_num_format('mmmm d yyyy h:mm AM/PM');
$sheet3->write(7, 0, 36050.1875, $date);
Cоответственно получаетcя что-то вида:
Далее программу можно совершенно свободно курочить как вздумается и, допустим, переводить данные из dbt(memo-тип) в Excel. В данном примере была применена библиотека для перекодирования от Алекса Фарбера, т.к. скрипт отлаживался под XWindows by Linux. В принципе все то-же самое действует и для просмотра файлов при помощи StarOffice.
Допустим проблема, есть диск с ufs, на котором есть директории, названные по русски. Нужно этот диск подмонтировать на ext2. А директории в ISO кодировке Samba не воспринимает, точнее не Samba, a пользователи Windows машин. Значит нужна программа, которая бы умела переделывать названия директорий из iso в win1251. Приведенная ниже программа использует ту-же самую библиотеку перекодировщик:
#!/usr/bin/perl
print "content-type: text/html\n\n";
use Lingua::RU::Charset qw (:CONVERT);
my $di="/raznoe";
&scan($di);
sub scan {
my $dir=$_[0];
my (@files,$filen,$ndir,$n,$mass,@dirs);
opendir D, $dir or warn "Cannot open $dir: $!" and next;
@dirs=grep {!(/^\./) && -d "$dir/$_"} readdir D;
rewinddir D;
closedir D;
for $n(0..$#dirs) {
my @ma=koi2win(iso2koi($dirs[$n]));
print "-----begindir-----\n [ ",win2koi("$dir/$dirs[$n]")," - ",
win2koi("$dir/$ma[$#ma]")," ]";
print " [ ",iso2koi($dirs[$n])," - NEW DIR ] " if rename
"$dir/$dirs[$n]", "$dir/$ma[$#ma]";
$ndir="$dir/$ma[$#ma]";
print "\n [ new scan dir - ",win2koi($ndir)," ] \n-----enddir-----\n\n";
&scan($ndir);
}
return 1;
}
Программа довольно проста, чтобы е╦ объяснять. Просто как иллюстрация использования языка perl для нужд системного администрирования в случае возникновения экстренных ситуаций. Самое сложное здесь было определить какая кодировка на ufstype=44bsd. Рекомендую пользоваться этой программой, имея некоторый опыт работы хотя-бы с Linux(дабы не было проблем при отладке с командами типа chmod -R 777 ., которая просто насмерть убивает sendmail). Вообще perl для админа Linux/FreeBSD лучшая находка. Не считая shell конечно(у которого нет http://www.cpan.org :).
То-же самое, но для файлов(можно было бы слинковать в одну программу, мне лень :)
#!/usr/bin/perl
use Lingua::RU::Charset qw (:CONVERT);
my $di="/raznoe";
&scan($di);
sub scan {
my $dir=$_[0];
my (@files,$filen,$ndir,$n,$mass,@dirs);
opendir D, $dir or warn "Cannot open $dir: $!" and next;
@dirs=grep {!(/^\./) && -d "$dir/$_"} readdir D;
rewinddir D;
@files=grep {!(/^\./) && -f "$dir/$_"} readdir D;
closedir D;
for $n(0..$#dirs) {
$ndir="$dir/$dirs[$n]";
&scan($ndir);
}
for $n(0..$#files) {
$filen=$dir."/".$files[$n];
my @mass=koi2win(iso2koi("$files[$n]"));
print " [ ",iso2koi($files[$n])," => NEW FILE!!! ]\n"
if rename "$dir/$files[$n]", "$dir/$mass[$#mass]"
or die "Cant rename $dir/$mass[$#mass]: $!\n" and next;
}
return 1;
}