Perl

Счётчики

Из серии моих приколов. Самый короткий. Устойчивый. До миллиона - вполне удобный :)

open C,'>>C';print C 'C';close C;
$counter=-s 'C';

Suffle

Перемешиваем массив

# из массива A..Z
# получаем FDPGLRQJWUXKZBNOHEAVIYMSTC

@AZ=(A..Z);
for (@AZ){
  $r=int rand @AZ;
  ($_,$AZ[$r])=($AZ[$r],$_);
}
print for(@AZ);

Время

Время работы скрипта = текущее время - время старта скрипта

print time - $^T, " sec."; #текущее время - время запуска скрипта

Время

Время работы скрипта с точностью до сотых долей секунды

printf("%.2f sec.",times); # Время работы скрипта

Звук

Простейший BEEP

print chr 7;

Windows shutdown

Ждём 15 минут и выключаем компьютер

# Windows XP
# Ждём 15 минут и выключаем компьютер

print <<TEXT;
Выход из системы
(Ctrl-Break для прервыания сценария)
TEXT

sleep(60*15);
print '.';

for(1..10){
  print chr 7;
  sleep 1;
}
print `shutdown -s -f `;

Ждём пока машина закончит рендеринг и выключаем комп. Проверка каталога через каждые 3 секунды. Если в течении 10 проверок в каталоге не произошло изменений, то выключаем. Rendering делать в отдельные кадры.

for (;$flag<10;){
  $DIR=`dir /s /p`;
  if ($DIR ne $oldDIR) {
    $oldDIR=$DIR;
    $flag=0;
    print "\n";
  }
  $flag++;
  print '.';
  sleep 3;
}
print chr 7;

print `shutdown -s -f -t 10`;

Temporary

Поиск всех просмотренных flv файлов, перенос и переименование их на диск E: в текущий каталог.

use File::Find;
find(sub{
  if(/.flv$/){
    $i++;
    rename $_, "$i.flv";
    `copy $i.flv e:`;
    unlink;
    print "$_\n";
  }
},'C:\Documents and Settings\illari\Local Settings\Temporary Internet Files\Content.IE5');

print "\nFiles: $i";

No cache

Как заставить браузеры не кешировать выдаваемый результат?

print <<HTML;
Content-type: text/html; charset=windows-1251
Pragma: no-cache
Cache-Control: no-cache
Expires: Thu Jan  1 00:00:00 1970

<HTML>
<BODY>
HTML

print rand;

Windows: clipboard

Всё текстовое, что попадает в Clipboard (Буфер обмена), сохраняем в файл. То-есть: Выделил, Ctrl-C, Выделил, Ctrl-C, Выделил, Ctrl-C, ... а в файле всё собирается.

use Win32::Clipboard;

$beep=chr 7;
$DDA=(chr 13).(chr 13).(chr 10);
$clip = Win32::Clipboard;
$c0='';
undef $/;
undef $\;
foreach (;;) {
  $c1=$clip->Get;
  if ($c1 ne $c0) {
    if ($c1=~/^exit/) {print $beep x 3;exit;}

    $c0=$c1;
    @C=split /\015\015\012/ , $c1;
    open (my $out, ">>clipboard.txt");
    foreach (@C){
      print $out "$_\n";
    }
    print $beep;
  }
  sleep 1;
}

CGI

Что прописать в .htaccess чтобы скрипты выполнялись в этом каталоге?

Options +ExecCGI
AddHandler cgi-script .cgi .pl

ФОТО-книга

Как переименовать сотни три фотографий с книжки в нужный порядок? При этом на каждом снимке снят весь разворот (обе страницы).

#  переименовываем все файлы в каталоге в заданный порядок страниц
#  например, для сохранения в BAT файле:
#  ren DSCN3476.JPG page_000-001.jpg
#  ren DSCN3477.JPG page_002-003.jpg
#  ren DSCN3478.JPG page_004-005.jpg

foreach(<*.jpg>){
  printf("ren $_ page_%03d-%03d.jpg\n",$i++,$i++);
}

Crack BMP

Во всех BMP нужно было заменить пару байт. Без этого они не читались одной программой.

# замена байт:   00022H: 02 90 -> 00 00

$DIR=`dir /b *.bmp`;

foreach(split /\n/,$DIR){
  open(F,"<$_");
  binmode F;
  $bmp=<F>;
  $n=chr(0)x2;
  $bmp=~s/(.{34})(..)/$1$n/m;
  open(F, ">$_");
  print F $bmp;
  close F;
  print '.';
}

BAT+Perl

Пример Perl-срипта, написанного в BAT-файле

@perl -x "%0"

@goto endofperl

#!perl
use Math::BigInt ':constant';

for (1..64) {
  print " 2 ^ $_ = ";
  print 2**$_;
  print "\n";
}

__END__

:endofperl

Получить страницу

Набрав в командной строке, получаем страницу с сайта в файл 1.html

perl -MLWP::Simple -e 'getprint "http://illari.ru";' > 1.html

Декабрьское повышение цен

Все цены, а это цифры, находящиеся в конце строк, увеличить на 20 процентов.

perl -pe 's/(\d+)$/$1*1.2/e' < in.txt > out.txt

uuencode base64

Переводим картинку v.png в формат base64

perl -MMIME::Base64 -ne'print encode_base64($_)' <v.png
iVBORw0K
Ggo=
AAAADUlIRFIAAAAeAAAAHggDAAAADO5ekAAAAARnQU1BAACvyDcFiukAAAAZdEVYdFNvZnR3YXJl
AEFkb2JlIEltYWdlUmVhZHlxyWU8AAAABlBMVEX///+AgIBizNOVAAAAAXRSTlMAQObYZgAAAJhJ
REFUeNpiYMALAAKIAAIIIAIIIIAIIIAAIoAAAogAAgggAggggAgggAAigAACCBkxogKQEEAAIcti
4QMEEG5ZsAhAABGQBgggAtIAAURAGiCACEgDBBABaYAAIiANEEAEpAECiIA0QAARkAYIIALSAAFE
QBoggAhIAwQQgRgDCCAC8Q0QQAQQQAARQAABRAABBBABBBBgAF2iAD0bQolbAAAAAElFTkSuQmCC

utf-8

Необходимо вывести текст в unicode. При попытке напечатать выходит ошибка: Wide character in print at ... .

binmode(STDOUT, ":utf8");
print chr for (12032..12064);
Подобнее смотри на:
http://perldoc.perl.org/perluniintro.html

utf-8

Необходимо вывести текст в unicode. При попытке напечатать выходит ошибка: Wide character in print at ... .

binmode(STDOUT, ":utf8");
print chr for (12032..12064);
⼀⼁⼂⼃⼄⼅⼆⼇⼈⼉⼊⼋⼌⼍⼎⼏⼐⼑⼒⼓⼔⼕⼖⼗⼘⼙⼚⼛⼜⼝⼞⼟⼠

Подобнее смотри на:
http://perldoc.perl.org/perluniintro.html

Функция выбора окончаний

Подбор окончания, в зависимости от числа.

# Подстановка окончания: 1 метр, 2 метра, 11 метров.
# Пример вызова функции:
print "Найдено $n ",okonch($n,'файл','файла','файлов');

sub okonch{ 
  my ($num,$n1,$n2,$n5)=@_;
  my $ok=$n5;
  if ($num=~/1$/)    {$ok=$n1}
  if ($num=~/[234]$/){$ok=$n2}
  if ($num=~/1(.)$/) {$ok=$n5}
  return $ok;
}
Найдено 15 файлов

pack

Раскодировать такую строку: http://slovari.yandex.ru/~%D0%BA%D0%BD%D0%

s/%([0-9A-F]{2})/pack(c,hex($1))/ge;
http://slovari.yandex.ru/~книги

Случайная картинка

Задача: выбрать случайную картинку из текущего каталога

print $A[int rand (@A=<*.png>)];
# подробнее это выглядело бы так:
@A=<*.png>;     # получаем массив со списком всех картинок
$r=int rand @A; # генерируем целое случайное число в диапазоне от 0 до (размер массива)
print $A[$r];   # печатаем случайный элемент массива 

Размеры фотографии

Как узнать ширину и высоту изображения в Perl.

use Image::Size;

$jpg="pic/2.jpg";
($w, $h) = imgsize("$jpg");
print <<HTML;
  <IMG src="$jpg" alt="Фото" width="$w" height="$h">
HTML
  <IMG src="pic/2.jpg" alt="Фото" width="128" height="96">

Демотиватор

Скрипт для создания демотиватора на локальном компьютере.

#!/usr/bin/perl

# linux, локально
# на сервере не оказалось шрифтов (((

$f='foto.jpg';

print "
Создание Демотиватора
     Заголовок: ";

$h=<>; chomp $h;
print "Немного текста: ";
$t=<>; chomp $t;

`convert  $f -scale 500x \\
  -bordercolor '#fff' -border 1 \\
  -bordercolor '#000' -border 16 \\
  -background '#000' -fill '#fff' \\
  -pointsize 32 label:'$h' -gravity center -append \\
  -border 5 -pointsize 15 label:'$t' -append \\
  -border 16 \\
  -bordercolor '#333' -border 1 dem_$f`;
Демотиватор готов

utf8 -> win

Возникла необходимость перекодировать русскоязычный текст из UTF-8 в Windows-1251 при

use LWP::Simple;
use Encode;
$text=get("http://www.anekdot.ru/rss/export_j.xml");
Encode::_utf8_off($text);
Encode::from_to($text, "utf-8", "windows-1251");
Анекдоты в кодировке Windows-1251

Время после события

О событии сообщено на странице в формате "Thursday December 27 2012, 18:38:50 UTC". Нужно вывести, как давно это произошло в минутах или часах. Перевести UTC в секунды и вычесть из текущего времени.

use Date::Parse;
#Раходим в тексте время в формате "Thursday December 27 2012, 18:38:50 UTC"
/<td align="center">(.+?UTC)<\/td>/;
$tt=$1;
#Переводим его в секунды
$utcsec=str2time($tt);

#Вычисляем время в секундах с того момента
$sec=time-$utcsec;
#В минутах
$min=int $sec/60;

#Выводим в минутах или часах
if ($min<120) {
  $tt="$min minutes ago\n";
}else{
  $hour=int $sec/(60*60);
  $tt="$hour hours ago\n";
}
78 minutes ago

Перенумеровать изображения

Есть файлы IMGP0456.JPG - IMGP0876.JPG. Нужно перенумеровать так чтоб нумерация начиналась с 0001.

#!/usr/bin/perl
for(<*.JPG>){
  $name=sprintf("IMG_%04d.JPG",++$n);
  rename $_, $name;
}
IMG_0001.JPG
IMG_0002.JPG
...

FORM

Получение данных в скрипт из формы HTML

#!/usr/bin/perl
use CGI;
use CGI::Carp qw(fatalsToBrowser);
my $cgi = CGI->new();
if($n=$cgi->param('N')){
print <<HTML;
Content-type: text/html\n
Получено N=$n
HTML
} else {
print <<HTML;
Content-type: text/html\n
<FORM method="post">
Широта: <INPUT type='text' name='N'>
<INPUT type='submit' value='  >  '>
</FORM>
HTML
}
Широта:

Парсинг CSV в массив

,"Русский язык",5,"1,75",,"",Отлично,,,

for(<>){
  s/(("{0,1}).*?\2),/$1\t/g; # Заменим запятые между записями на табуляции
  @B=split /\t/; # И порежем по этим табуляциям в массив
  for (@B){
    chomp;
    s/^"(.+?)"$/$1/g;
    # Здесь работаем с ячейками
  }
}
@B=('','Русский язык','5','1,75','','','Отлично','','','');

Чтобы скрипты на Perl работали на сервере

и, дополнительно, отдавали сгенерированные страницы, а так же ошибки в браузер.

Как настроить LAMP в Ubuntu

чтобы Perl скрипты запускались не только в /usr/lib/cgi-bin/, а там, где разрешает .htaccess?

Проблема заключается в том, что после установки LAMP (Linux+Apache+MySQL+PHP) не удаётся запустить файлы с расширением .pl в папках по пути /var/www/*, а запускаются только скрипты из папки /usr/lib/cgi-bin/. (При этом хочу отметить, что файл /etc/apache2/httpd.conf отсутствует.)

Примечание: Результат работы файла /var/www/name.pl можно увидеть в браузере, перейдя по адресу http://localhost/name.pl

Установка модуля в LINUX

Чтобы доустановить необходимый модуль под LINUX, в данном примере NET::Ftp, в терминале набрать:

sudo perl -MCPAN -e "install NET::Ftp"

#Редактировать +Добавить