» Perl: Полезные решения

SQL::Abstract

очень понравился вместо ORM еще DBIx::Abstract
даже есть SQL оператор limit

Код:
#!/usr/bin/perl
#
use strict;
use warnings;
use SQL::Abstract;
use CGI::Carp qw(fatalsToBrowser);
use DBI;
# ---- print header ----
print "Content-Type: text/html; charset=utf-8\n\n";
# ---- connect to sqlie db file ----
my $dbh = DBI->connect("dbi:SQLite:dbname=my.db","","");
my $sql = SQL::Abstract->new;
# ---- prepare input data ----
my %data = (
name => 'John',
lastname => 'Miller',
);
my ($stmt,@bind) = $sql->insert('mytable', \%data);
# ---- insert data into my.db ----
my $sth = $dbh->prepare($stmt);
$sth->execute(@bind);

Юникод в UTF-8

Код: sub unicode_to_utf8 {
    return hex unpack('H12', pack ('U', shift));
}

Долго бился как в Active Perl выводить строки с кирилицей в консоль. Консоль в Windows XP в кодировке cp866, вот одно из решений, если файл в кодировке utf-8


Код: use Encode;
use utf8;
$str = 'Йо';
Encode::_utf8_off($str);
Encode::from_to($str, 'utf-8', 'cp866');

Смена 1 на 0, 0 на 1:


Код: $i = 1 - $i;

Преобразование IP-адреса в число.


Код: $ip = '127.0.0.1';
$int_ip = unpack('N', pack('C4', split /\./, $ip));

Народ подскажите где ошибка. Через командную строку передаю имя папки. И хочу вывести ее содержимое, при этом если в директории есть каталоги то вывести их отдельно. Проблема в том, что ключ "-d" определяет как каталог только файлы "." и ".." вот код:


#!/usr/bin/perl -w
chomp ($directory = $ARGV[0]);
print "DIRECTORY NAME IS $directory\n";
opendir (DIRECTORY, "$directory");                                                                                                        
@files=readdir(DIRECTORY);                                                                                                                 
print "There are: @files\n";


foreach (@files) {
        if (-d $_) {    
        print "This is a directory: $_\n";
        }            
        else {
        print "This is a file $_\n";
        }    
        }
closedir(DIRECTORY);

vecialfor


Цитата:

Народ подскажите где ошибка.

Со зрением все в порядке? ШАПКУ ЧИТАЙ!

Скрипт, ищущий файлы в директории и всех поддиректориях:


Код: print join "\n", f('E:/PICTURES', "*.jpg");

sub f {return ( grep {!-d} (glob("$_[0]/$_[1]"), (map {f($_,$_[1])} grep {-d} glob("$_[0]/*"))) )}

перебрать массив-хэшей и вывести в map с использованием next и last

не мог выйти из цикла с помощью next и last, нашел вариант просто отдать
Код: ()

часто использую такой скрипт, чтоб читать строки в обратном порядке из файла
писал я и очень давно :)

Код:
package OpenDB;

=head1 INFO

Библиотека функций для получения строк из файла в обратном порядке
Большие файлы, например из 50тыс строк съедает как семечку

Автор: Низовцев Алексей

E-mail: alex-niz(СБК)mail.ru


Использование:

use OpenDB;

my $db = new OpenDB('news.db') or die $!;

my $all_line = $db->{'all_line'}; # количество строк в файле

my @array = $db->ReadLine(11, 5); # Собирает массив из 5 строк начиная с 11-й из файла, тоесть возвращает 11, 12, 13, 14 и 15 строки, конечно если есть такие

$db->Close();

=cut

#####################################
use strict;

sub new {

my $class = bless { }, shift;

$class->{'file'} = shift;

open($class->{'db'}, "<$class->{'file'}") or return;
flock($class->{'db'}, 1) or return;

my $file = $class->{'db'};
while (<$file>) {}
$class->{'all_line'} = $.;

return $class;
}

#=============================================================

sub ReadLine {

my $class = shift;

my $start_line = shift;

my $all_line = shift;

if ($start_line < 1) {$start_line = 1}
if ($start_line > $class->{'all_line'}) {return}
if ($all_line eq 'all') {$all_line = $class->{'all_line'}}
if ($all_line < 1) {$all_line = 1}

seek ($class->{'db'}, 0, 0);

my @array;

my $start = $class->{'all_line'}-$start_line+1;
my $end = $class->{'all_line'}-$start_line+1-$all_line;
my $line = 0;
my $file = $class->{'db'};
while (<$file>) {
$line++;
if ($line > $start) {last}
if ($line > $end) {chomp ($_); push (@array, $_)}
}

return reverse @array;

}

#=============================================================

sub Close {

my $class = shift;

close($class->{'db'}) or return;

$class = ();

}

#=============================================================

sub AllLine {

my $class = shift;

return $class->{'all_line'};
}

1;

links
А вот не подскажешь ли какойнибудь модуль для работы с файлами ну очень большими.. к примеру 500тыс строк, миллион строк.. Чтобы легко можно было перебрать его, вывести произвольные строки..
Чтобы не грузить файл в оперативу, а как-нибудь пооптимальнее )

Anton_Y
попробуйте,потестируйте, миллион строк он точно переварит, но если вы их все в память не решите загружать
этот скрипт какраз весь файл в оперативу не грузит, грузит только выбранные строки

Спасибо за полезные советы.

может кому пригодится скрипт:


Код: =pod
MOdem COntrol over telnet script
Использует telnet-протокол для управления модемом. Позволяет
узнать внешний IP и перезагрузить модем. Вызов:

perl moco.pl
perl moco.pl reset

Протестирован на D-Link DSL-500T ADSL Router. Firmware Version:
V2.01B01T01.RU.20060620

http://forum.ru-board.com/profile.cgi?action=show&member=mark74
Tomsk, 2012
=cut
use strict;
use warnings;
use Net::Telnet ();

my $ip;
my $reset = 0;
my $t = new Net::Telnet (Timeout => 10,
Prompt => '/# $/',
Errmode => "return");

#-----------------------------------------------------------------------
# переустанавливает соединение
# возвращает внешний IP модема, или '' если нет интернета, или 'timeout'
#-----------------------------------------------------------------------
sub chk_ip () {
my @lines;
$t->close or die "chk_ip:1";
$t->open('192.168.1.1') or return 'timeout';
$t->login('admin', 'admin') or die "chk_ip:2";
@lines = $t->cmd("ifconfig ppp0") or die "chk_ip:3";
@lines = grep(/inet addr:/, @lines);
my $r = '';
if ($#lines >= 0) {
$lines[0] =~ /:([^\s]+)/;
$r = $1 or die "chk_ip:4";
}
return $r;
}

#------------------------------------------------------------------------
$|++; # autoflush after every print

$_ = shift @ARGV;
if (defined $_) {
$reset = 1 if $_ eq 'reset';
}

if ($reset) {
print "Подключение...\n";
$ip = chk_ip();
die "Не удалось подключиться к модему" if $ip eq 'timeout';
if ($ip) {
print "Старый IP: $ip\n";
} else {
print "Нет внешнего IP\n";
}
print "\n";

print "Перезагрузка...\n";
$t->cmd("reboot");
}

print "Подключение";
for (my $i = 0; $i < 30; $i++) {
print ".";
$ip = chk_ip();
next if $ip eq 'timeout';
last if $ip;
sleep 5;
}
print "\n";

if ($ip) {
if ($reset) {
print "Новый IP: $ip\n";
} else {
print "Внешний IP: $ip\n";
}
} else {
print "Нет внешнего IP\n";
}

Простенький поиск по шаблону с консоли по архиву рассылки Moscow.pm (*.pm) (с кэшированием).
http://codepaste.ru/11948/

Есть поисковики, конечно, и они найдут многое гораздо лучше. Потому для нищевых задач, когда помнишь, что обсуждалось, но когда именно - нет.

Cпасибо! Попробую так! Обычно програмно менял.

Чтобы удалить элемент массива, зная его значение, делаем так:


Код: @array = [ grep $_!= 3 , @array ];

Добрый день!

Помогите написать скрипт
мне необходимо чтобы скрипт сравнил время изменения файла и текущее время
и если есть разница в 2 или больше минуты то выполнить действие

для текущего времи использую

Код:
my $nowtime = localtime(time);
print ("$nowtime\n");

вывод:
Tue Jun 25 12:42:10 2013

Требуется программист со знаниями php, js, html, css, git.

(удалено)

Генерация 100% уникальных кодов:


Код: #!/usr/bin/perl -w
$dict = '1234567890qwertyuipasdfghjklzxcvbnm';
$totalLength = 500000;
$codeLength = 12;
$dictLength = length($dict) - 1;

%codes = ();
while (keys(%codes) < $totalLength){
$res = '';
for ($i = 0; $i < $codeLength; $i++){
$res .= substr($dict,rand($dictLength), 1);
}
$codes{$res} = undef;
}

OLEX
с не нулевой вероятностью коды могут совпадать

добавлено:
не могут, см. ниже

народ, я знаю что вопрос не по теме, но я уже голову сломал. у меня не загружается 3 сайта , не загружаются они только у МЕНЯ и только на Моем компьютере. сначала я грешил на троян или ват, но сканировал и ничего не нашел. потом я грешил на файл HOSTS он и он без изменений (на всякий случай все равно его востановил). браузер пишет при попытке попасть на эти сервы что сервер не дал ответ/нет соединения/сервер не доступен. подскажите что делать я уже все перепробовал (даже win переустановил)

Цитата:

Генерация 100% уникальных кодов:

лучше....

perl -e 'print sprintf("%016X", rand(1000000));'

mark74
никаких вероятностей, коды абсолютно уникальны.

L_S_V
Вобще ваш пост не понятен, что чего лучше? К чему ваш код, выдающий одно число?

OLEX

L_S_V привел вполне рабочий, лаконичный пример получения одного случайного (или там псевдослучайного) кода. IMO, его "лучше" это не проблема: можно понять в каком смысле лучше, в каком хуже. А вот ваши "100%" и "абсолютно" - это ложные утверждения.

Да, вы привели рабочий способ получить какое-то количество кодов, случайным образом распределённых по множеству состоящему из 35**12 кодов. Но то что полученные коды уникальные, надо проверять. Где в вашем алгоритме проверка? Нет проверки - нет оснований для утверждений "100%", "абсолютно".

- вероятно... по аналогии с PGP - "вполне хорошая вероятность", но не абсолютность

Цитата:

позже можно будет архив форума сделать и подобные вещи собирать там кучками

Цитата:

Идея насчет примеров для начинающих -это похвально, только реализовыватье её в виде темы в форуме не есть хорошо

Цитата:

Svarga я за архив! Хорошая идея

Мне кажется эта тема действительно требует соответствующего оформления со стороны администраторов.
Не плохо будет и вопрос с правами на использование решить. Воткнул скрипт, а потом претензию получаешь - вы использовали часть моей программы.

Всем привет! Не могу найти дрова на РС камеру Если кто может помогите
USB\VID_0AD2&PID_900A&REV_0100
USB\VID_0AD2&PID_900A

mark74

Цитата:

А вот ваши "100%" и "абсолютно" - это ложные утверждения.

Ты блин перл видел хоть одним глазком дурик?
Еще раз повторюсь - я привел код для генерации гарантированно 100% уникальных кодов.
Никаких проверок там не требуется. Уникальность кодов гарантируется уникальностью ключей в хеше! Это и есть основание для "100%" и "абсолютно".

Цитата:

Уникальность кодов гарантируется уникальностью ключей в хеше!

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

ошибся темой...