Колоризируй это, колоризируй то

Иногда людям приходят в голову странные мысли и они спрашивают — «А как подсветить в блоке первые N символов но чтоб типа без встроенных тегов?»

Никак.

Ну, или так:

<script>
function colorize(id, num, empty, styleClass){
    // id — ID элемента
    // num — сколько символов подсвечивать
    // empty — считать ли пустые символы за символы для подсветки
    // styleClass — какой класс присваивать символам?
    var obj = document.getElementById(id);
    if(!obj) return;
    var regex = empty ? /^((?:[^\s]\s*){3})/ : /^(.{3})/;
    obj.innerHTML = obj.innerHTML.replace(regex, «<span class='»+styleClass+»‘>$1</span>»);
    
}

</script>
<style>
.red {
    color:red;
}
</style>
<span id=’test’>1 2 3 4 5</span>

<script>colorize(‘test’, 1, 1, ‘red’);</script>

Perl 6 — или грядёт апокалипсис

А знаете ли вы о том, что в Perl6 можно будет сделать так:

«perl -le ‘say q[Hello];'»

?

А можно будет сделать и так:

«perl -le ‘q[Hello].say;'»

Это — апофеоз.

Локальные модификаторы в RegEx — используй кластер, Люк

В жизни каждого программиста наступает момент, когда ему надо выцепить кусок текста, независимо от регистра — но в контексте зависимого от регистра текста.

На помощь приходят локальные модификаторы — например, — в пределах кластера это будет так:

-bash-3.2$ perl -le ‘my $x = «Abc»; print «ok» if $x =~ /(?i:a)b/;’
ok
-bash-3.2$ perl -le ‘my $x = «Abc»; print «ok» if $x =~ /(?i:a)B/;’
-bash-3.2$

ну или так

-bash-3.2$ perl -le ‘my $x = «Abc»; print «ok» if $x =~ /(?-i:A)b/i;’
ok
-bash-3.2$ perl -le ‘my $x = «Abc»; print «ok» if $x =~ /(?-i:A)B/i;’
ok
-bash-3.2$ perl -le ‘my $x = «Abc»; print «ok» if $x =~ /(?-i:a)B/i;’
-bash-3.2$

Bidirectional pipe для mystem в Perl

Когда нормализуешь слова с помощью mystem — лучше использовать bidirectional pipe, вместо того, чтобы каждый раз открывать новый процесс.

Это очень просто.

Учитывая долбанутость mystem, мы будем отбрасывать слова с цифрами и ждать подольше. На всякий там. Пробелы он превращает в _, так что триггеры обоснованы.

#!/usr/bin/perl -w
use strict;
use FileHandle;
use IPC::Open2;
use IO::Select;
my $s = IO::Select->new();
my $pid = open2(*Reader, *Writer, «mystem -c -n -eUTF8″ );
$s->add(\*Reader);
my @words = (‘слона майна виражей’, ‘моськи’, ‘мартышки’,’троллоло’, ‘слова1’);
$| = 1;

foreach(@words){
next if /\d/;
print Writer $_.»\n»;
print qq[Sent word $_\n];
while(){
chop;
next if $_ eq q[_];
next if $_ eq q[\n];
print $_.»\n»;
last unless $s->can_read(1,5);
}
print «-«x10;
print «\n»;
}
close(Reader);
close(Writer);

SQL-извращения для JIRA

Запрос оброс мясцом и приобрёл вид типа CONCAT(TRUNCATE(SUM(IF(wl.timeworked IS NULL, 0, wl.timeworked)/3600),1),’ h.’), конструкций :)

Ещё немного — и из этого родится или create view, или же он сьест мой мозг :)))

JIRA гаджет — перенос сурцов на другой инстанс

Делал плагин для JIRA. Запихнул сурцы в Dropbox, снёс систему, переставился, синхронизировался.

Открываю проект в NetBeans — а он мне — Mailformed Maven Project. Download deps ни к чему не привели.

Решение проблемы — это JIRA SDK. Качаем, ставим в PATH папку bin, и из папки сурцов плагина делаем atlas-run. Он подсосёт всё необходимое для системы самостоятельно.

Opera, Firefox и священная война

Под iPhone вышла Опера.

Попробовал и на компьютере ее поставить. Ну как была куцая — так и осталась.

Я пользуюсь FireFox, потому что уже не могу без милых плагинчиков — LiveHTTPHeader, TamperData, FoxMarks — да хоть того же FireBug. В Opera же так и не удосужились сделать что-то кроме виджетов — это чисто казуальный браузер, видно.

Притом виджетов этих — ну просто наискуднейший набор.

WoW — гребем достижения в ЖЖ

Суть проста — выгрести из Армори последние ачивы, проверить — не постили ли раньше, запостить в ЖЖ.
Накидалось на коленке, я использую БД в расширенной версии скрипта — но решил и такой мелкий написать :)
UPD — чёт ппц криво получился этот сниппет в опубликованном виде. Аттачу ссылку на оригинал.
Plain-Text

#!/usr/bin/perl -w
use strict;
use Digest::MD5 qw[md5_hex];
use WWW::Curl::Easy;
use LJ::Simple;                                     # Ставится из CPAN — cpan install LJ::Simple

my $wow_realm       =   q[Дракономор];              # Игровой реалм
my $wow_char        =   q[Юмаш];                    # Имя на реалме
my $lj_login        =   q[дас юзернейм];               # Логин жежешечки
my $lj_pass         =   q[der пароль];           # Пароль в жежешечку
my @tag_list        =   qw(wow);                    # Теги записи — через пробел
my $lj_subject      =   q[Мои достижения в WoW];    # Заголовок записи

my $tmp_file        =   q[/tmp/wow.achieve.tmp];    # Чтоб ачивы не дублировались.
                                                    # Для винды — C:\\tmp\\wow.tmp, например
                                                    
                                                    

eval{`touch $tmp_file`};        #   Потрогаем файлик, если его ещё нет.
                                #   Завернуто в eval чтоб не гадил в stdout, если директория недоступна для записи
if(!-w $tmp_file){  # Ну тут очевидно :)
    die(q[File $tmp_file недоступен для записи. Он нужен для того, чтобы не дублировались записи с ачивами.]);
}

my $entry   =   q[];        # Тут будет сама запись
my $href    =   qq[http://eu.wowarmory.com/character-feed.atom?r=$wow_realm&cn=$wow_char&locale=ru_RU];
my $result  =   ‘false’;    # Это — для курла, хендл курловской баги

open my $oldout, «>&STDOUT» or die «Can’t dup STDOUT: $!»;

close STDOUT;
open STDOUT, «> /dev/null»;
my $retcode;

my $curl;
{
    $curl = new WWW::Curl::Easy;
    $curl->setopt(CURLOPT_URL, $href);
    $curl->setopt(CURLOPT_CONNECTTIMEOUT, 60);
    $curl->setopt(CURLOPT_TIMEOUT, 60);
    $curl->setopt(CURLOPT_NOPROGRESS, 0);
    $curl->setopt(CURLOPT_PROGRESSFUNCTION, sub {$_[2]>1_000_000?1:0});
    $curl->setopt(CURLOPT_USERAGENT,q[AchieveBotGrabber 1.0]);
    open (my $tmp_for_curl, «>», \$result);
    $curl->setopt(CURLOPT_FILE,$tmp_for_curl);
    $retcode = $curl->perform;
}

close STDOUT;
open STDOUT, «>&», $oldout or die «Can’t dup \$oldout: $!»;

if($retcode == 0 && $curl->getinfo(CURLINFO_HTTP_CODE) == 200){
    my $old_achieves = {};
    if(-e $tmp_file){
        open FF,»<$tmp_file»;
        while(<FF>){
            chop;
            $old_achieves->{$_} = 1;
        }
        close FF;
    }
    open FF, «>$tmp_file»;
    while($result =~ /<entry>\s*.*?<updated>(\d{4}\-\d{2}\-\d{2})T.*?<content type=»html»>(.*?)<\/content/ismg){
        my $date    = $1;
        my $achieve = $2;
        $achieve    =~ s/\<!\[CDATA\[//;
        $achieve    =~ s/ class=»achievement staticTip»//;
        $achieve    =~ s/\]>//;
        $achieve    =~ s/ id=»[^»]+»//;
        my $achieve_md5 = md5_hex $achieve;
        print FF qq[$achieve_md5
];
        next if exists $old_achieves->{$achieve_md5};
        $entry .= qq[$date — $achieve<br>];
    }
    close FF;
    exit if $entry =~ /^\s*$/;
    
    my %Results = ();
    my %Event=();
    
    my $lj = new LJ::Simple ({
            user    =>      $lj_login,
            pass    =>      $lj_pass,
            site    =>      undef,
    });
    
    (defined $lj) || die «$LJ::Simple::error
«;
    
    $lj->NewEntry(\%Event) || die «$LJ::Simple::error
«;
    
    $lj->Setprop_backdate(\%Event,1)            || die «1 $LJ::Simple::error
«;
    $lj->SetSubject(\%Event, $lj_subject)       || die «2 $LJ::Simple::error
«;
    $lj->Setprop_taglist(\%Event, @tag_list)    || die «3 $LJ::Simple::error
«;
    $lj->SetEntry(\%Event,$entry)               || die «5 $LJ::Simple::error
«;
      
    my ($item_id, $anum, $html_id)   =   $lj->PostEntry(\%Event);
    
    (defined $item_id) || die «6 $LJ::Simple::error
«;
    
    print qq[http://$lj_login.livejournal.com/$html_id.html
];
}

Perl, RegEx и LookAhead — форматируем MAC-адрес

Задача — из 001e8c15ffbc сделать 00:1e:8c:15:ff:bc

Решение —

perl -le ‘my $x = «001e8c15ffbc»;$x =~ s/(..(?!\Z))/\1:/g; print $x’

Разберем по кусочкам этот примитив.
(..(?!\Z))/\1:

.. — два любых символа (можно написать длиннее, если сомневаемся, что к нам придёт именно мак) — например, [a-f\d]{2}
(?!\Z) — заглянем вперёд — нет ли там конца строки. Если есть — не попадаем в условие и, соответственно, не заменяем.

Вот собственно и вся сложность лукахедов и прочего.

Perl — удалить из массива несоответствующие условию элементы

Удаляем все элементы, которые не цифры. Работаем с референсом.

#!/usr/bin/perl
use strict;
use Data::Dumper;
my $a = [234235,’a’,345,34234,23121];
$a = [grep {/^\d+$/ } @$a];
print Dumper $a;

UPD Rommeech заметил багу, исправил