9月
20

 

ブラウザ上でテキストを選択してクリップボードにコピーし、Keynoteやoffice系ソフトにペーストしたとき、外部CSSで指定されているスタイルが適用されない。よくあるケースでは、プログラムのシンタックスハイライトを保ったままコピペしたいのにペースト先で色が再現しない。そこで、これを解決するブックマークレットを作りました。ページ内の全要素のスタイルをスクリプトで再設定することで、要素スタイルにするやつ。下記のリンクを右クリックでブクマしてね。

Freeze CSS

以下、注意。

  • めっちゃ重いかもしれない。
  • Firefoxでしか試してない。

 

 

9月
08

 

Mojoベースのフレームワークを作りました。コンセプトはPHPの代わりです。

https://github.com/jamadam/Marquee

フレームワークなんですが、その点は置いといて、付属のプラグインとそのコマンドラインインターフェースが便利なので、その説明。

インストール。

$ wget https://github.com/jamadam/Marquee/tarball/master -O marquee.tar.gz
$ cpanm marquee.tar.gz

とりあえず、marqueeのソースディレクトリでAutoIndexプラグインを試してみる。

$ tar -xvf marquee.tar.gz
$ cd marquee
$ mojo marquee --auto_index
[Fri Sep  7 21:10:22 2012] [info] Listening at "http://*:3000".
Server available at http://127.0.0.1:3000.

ブラウザでhttp://127.0.0.1:3000/を開くとインデックスが表示され、リンクを辿ってファイルを閲覧できます。htmlを開けば普通にtext/htmlとして開くので簡易HTTPサーバーとして使えます。

PODViewerとMarkdownというプラグインも付属しています。Pod::SimpleとText::Markdownがインストールされていれば、下記のコマンドでドキュメントビューワーとして機能します。

$ mojo marquee --doc_viewer

ブラウザで下記のURLにアクセスするとPODやMarkdownのリストが出ます。PODのリストは@INC内のすべてがリスト化されます。Markdownのリストはカレントディレクトリ以下の.mdファイルの列挙です。

http://127.0.0.1:3000/perldoc/

http://127.0.0.1:3000/markdown/

オフィシャルサイトも作ってみました。このサイト自体もMarqueeアプリとして動いていて、上記のソースに同梱されています。

動かしてみます。

$ ./official-site.pl daemon
[Fri Sep  7 21:21:52 2012] [info] Listening at "http://*:3000".
Server available at http://127.0.0.1:3000.

ブラウザでhttp://127.0.0.1:3000/を開くと、オフィシャルサイトと全く同じものが動きます。同梱のPODビューワーとMarkdownビューワーを駆使したドキュメントが閲覧できます。

ちなみに日本語版もあります。日本語版も同梱されてるので、下記で起動できます。

$ ./official-site-ja.pl daemon

 

8月
28

 

Audacityで数千のwavファイルの前後の無音をトリムする必要があったので、Lispで動くらしいNyquistプラグインってので対応した。ネットに落ちてた元ネタに設定項目を追加した改造版。

;nyquist plug-in
;version 1
;type process
;categories "http://lv2plug.in/ns/lv2core/#UtilityPlugin"
;name "Trim Silence jamadam..."
;action "Trimming..."
;info "by Steve Daulton (www.easyspacepro.com). Released under GPL v2.\n\nTrims silence from the beginning and end of the selection.\n"

;control thresh "Silence Threshold (dB)" real "" -48 -100 0
;control beforedur "Starting point [seconds before sound starts]" real "" 0.1 0.0 1.0
;control afterdur "Ending point [seconds after sound ends]" real "" 0.1 0.0 1.0

;; TrimSilence.ny by Steve Daulton. Aug 2011.
;; Released under terms of the GNU General Public License version 2:
;; http://www.gnu.org/licenses/old-licenses/gpl-2.0.html
;; Requires Audacity 1.3.8 or later.

;convert threhold to linear
(setq thresh (db-to-linear (min 0 thresh)))

;modulo
(defun mod (x y)
    (setq y (float y))
    (round (* y(-(/ x y)(truncate(/ x y))))))
    
;convert to hh:mm:ss
(defun to-hhmmss (seconds)
    (let* ((hh (truncate (/ seconds 3600)))
                (mm (truncate (/ (mod seconds 3600) 60)))
                (ss (mod seconds 60)))
        (format nil "~ah:~am:~as" hh mm ss)))

(if (< len ny:all) ;max length that can be processed
    (let*
            ;make stereo sound mono
            ((mysound (if (arrayp s)(s-max (aref s 0)(aref s 1)) s))
            (start-count 0)
            (end-count 0)
            (flag 0)
            ;ratio provides tighter trimming for short selections
            ;while maintaining reasonable speed for long selections
            (ratio (max 10(min 200 (round (/ len 100000.0)))))
            (my-srate (/ *sound-srate* ratio))
            (mysound (snd-avg mysound ratio ratio op-peak))
            (samples (snd-length mysound ny:all)))
        ;loop through samples
        (dotimes (i samples)
            (setq new (snd-fetch mysound))
            (cond 
                ((= flag 0)
                    ;count initial silence
                    (if (<= new thresh)
                        (setq start-count (1+ start-count))
                        (setq flag 1)))
                (T
                    ;count final silence
                    (if (<= new thresh)
                        (setq end-count (1+ end-count))
                        (setq end-count 0)))))

        (let ((start (/ start-count my-srate))
                    (end (-(get-duration 1)(/ end-count my-srate))))
            ;ensure at least 1 sample remains
            (if (>= start (get-duration 1))
                (setq start (/(1- len)*sound-srate*)))
            ;leave some silence for safe
            (setq start (- start beforedur))
            (setq end (+ end afterdur))
            ;trim
            (multichan-expand #'extract-abs start end (cue s))
            ))
    ;OR print error message
    (format nil 
"Error.\nMaximum selected duration at ~a Hz is ~a.~%Selected track is ~a.~%"
    (round *sound-srate*)
    (to-hhmmss (/ ny:all *sound-srate*))
    (to-hhmmss (get-duration 1))))
8月
03

 

ほーむぺーじ制作な現場の話。

ここ数年でフレームワークやテンプレートエンジンの乗り換えとかアップグレードとかを何度となく繰り返してます。サイトの機能拡充をしようと思ったらシステムが古いので、一旦、最新のシステムに乗せ換えてから作業に取りかかりたい。でもレガシーウェブ制作なので、テストケースなんてないし、全部目視で確認するのは辛い。

新システムで旧システムと同じ動作を再現できたことを確認するためにCompBotというのを使ってます。Mojolicious + Text::Diffで2つのサイトのリンクを辿りながら差分を検出するモジュールです。
https://github.com/jamadam/CompBot

テスト全体は下記のような感じになります。diff.tとでもして保存します。

use strict;
use warnings;
use utf8;
use CompBot;

my $cbot = CompBot->new;
$cbot->url_match(qr{dev.example.com});
$cbot->url_translate(sub {
    my $url = shift;
    $url->host('example.com');
    return $url;
});
$cbot->start('http://dev.example.com/');

実行。

$ perl diff.t

CompBotは、対応する2つのページのレスポンスボディをText::Diffにかけて、その結果をTest::Moreに投げてるので下記のような出力が得られます。

ok 666 - exact match for http://dev.example.com/menu/list_s.html?sh=1301&ty=7
ok 667 - exact match for http://dev.example.com/menu/detail_s.html?sh=1873&ty=11&id=131
ok 668 - exact match for http://dev.example.com/shop/bm_shop.html?cond1=1992
ok 669 - exact match for http://dev.example.com/menu/detail_s.html?sh=110&ty=11&id=125
ok 670 - exact match for http://dev.example.com/menu/list_s.html?sh=1873&ty=7
ok 671 - exact match for http://dev.example.com/menu/list_s.html?sh=1873&ty=8
not ok 672 - exact match for http://dev.example.com/menu/list_m.html?ty=1
#   Failed test 'exact match for http://dev.example.com/menu/list_m.html?ty=1'
#   at /lib/CompBot.pm line 69.
#          got: '@@ -360,8 +360,7 @@
#  <span class="weight">100g</span>
#  </div>
#  </td>
# -</tr>
#  </table>
#  <div id="sidemenu">
#  <!-- a -->
#  <!-- b -->
#  
# '
#     expected: ''
ok 673 - exact match for http://dev.example.com/menu/detail_s.html?sh=1733&ty=6&id=88
ok 674 - exact match for http://dev.example.com/menu/detail_s.html?sh=1655&ty=0&id=23
ok 675 - exact match for http://dev.example.com/menu/detail_s.html?sh=203&ty=2&id=251
ok 676 - exact match for http://dev.example.com/menu/detail_s.html?sh=1053&ty=11&id=129

サイトAとサイトBを比較する場合、サイトAから検出したURLをurl_translateで加工してサイトB用のURLを作ります。Mojo::URLインスタンスが渡ってくるので、ホスト名をスイッチするなりパスを書き換えるなり、ポート番号を変えるなりしてreturnします。

$cbot->url_translate(sub {
    my $url = shift; # Mojo::URLインスタンス
    $url->host('example.com');
    return $url;
});

レスポンスボディは比較前に改変できます。新/旧のテンプレートエンジンでインデントスタイルとかが一致しないと散々な結果になるので、正規表現で無理やり一致させたりします。あと、Mojo::DOMを通すとHTMLタグが正規化されて、どうでもいい差分が吸収されるっぽいです。この辺テキトー。

$cbot->preprocess_a(\&preprocess);
$cbot->preprocess_b(\&preprocess);

use Mojo::DOM;

sub preprocess {
    my $body = shift;
    $body =~ s{[ \t]+$}{}gm;
    $body =~ s{^[ \t]+}{}gms;
    $body =~ s{\n+}{\n}gms;
    $body = Mojo::DOM->new($body)->to_xml;
    return $body;
}    

text/*なレスポンスは全部Text::Diffの対象になります。画像は単純にレスポンスボディを比較します。画像やCSSなどはあまり動的に書き出さないので、拡張子で対象から外すこともできます。あと、URLでフィルタもできます。

$cbot->extension_not([qw{jpg png gif css js}]);

$cbot->url_match(qr{dev.example.com/});
$cbot->url_not_match(qr{dev.example.com/test1/});
$cbot->url_not_match(qr{dev.example.com/test2/});

パラメータ含めると何万ページにもなったりして、全部チェックする気はありません。サンプリング検査的に実行したいのでキューをシャッフルします。

$cbot->shuffle(1);

これで、OKが1000件くらい並べば、正しく乗せ換えできたっぽいなあ、と少し安心できます。テキトーです。

5月
13

 

Casualを含めて今回3度目の参加でした。今回はWEBアプリ再入門がテーマということで、WAF(ウェブアプリケーションフレームワーク)のお話が中心でした。WAFは選択肢豊富で迷いそうだけど、一方で、どれも大差ないようにも感じました。いずれにしても今、Perlが熱い。

Amon2(akiymさん)

高校生にあんな立派な発表されたら敵いません。KENT WEBの掲示板を移植していたのが面白かった。ああいうのをサクっと作れちゃうのは素晴らしい。スライドもう一度みたいなあ。あがってた

http://akiym.com/slides/20120512-hokkaidopm7-amon2/index.html

Dancer(aloelightさん)

Dancerは、ルーターに渡すコールバックでレスポンス用の文字列をreturnしていた点に、Mojoliciousとの設計の違いを感じました。あと、プラグイン数の比較がためになりました。

http://www.slideshare.net/aloelight/using-dancer

Mojolicious(jamadam)

MojoliciousでPHPライクなことをするお話をしました。

http://www.slideshare.net/jamadam/mojolicious-12907706

Ops Tools with Perl(riywoさん)

カバンがかっこよかったです。運用のお話は僕にはちょっと難しかったですが、cron blueprintのあたりは楽しげでした。あとDSLの作り方も興味深かった。

http://www.slideshare.net/riywo/ops-tools-with-perl-20120512-hokkaidopm

LTではお二方が音系のお話をされていたり、この日、一番の爆笑をとったapache依存のWAFのお話など、充実の内容でした。

懇親会では多くの方とお話しできて幸せでした。perlの次バージョンはuse strictがデフォになると初めて知りました。古くて危険なスクリプトがやっと淘汰されていくのかな。

昼につけ麺、夜にラーメンは反省点でした。腹壊しました。

4月
29

 

Mojoliciousアプリの出力するDOMを詳細にテストするやつ。

https://github.com/jamadam/Test-Mojo-DOM

Test::Mojoだけだと、domのチェックはelement_exitsとelement_exits_notしかできないので、詳細なテストはcontent_*でやるか、DOMを取り出してからTest::Moreを使う。

$t->get_ok('/');
my $dom = $t->tx->res->dom;
is $dom->at('#hoge')->attrs('href'), 'http://example.com', 'right URL';

Test::Mojoと似た流れでDOMのテストもやりたい!

ということで、Test::Mojo::DOMを使うと下記のようにできるよ。APIは変わるかもだよ。

  use Test::Mojo::DOM;
  use Test::More tests => 35;

  my $t = Test::Mojo::DOM->new(MyApp->new);
  $t->get_ok('/')
      ->status_is(200)
      ->dom_inspector(sub {
          my $t = shift;
          $t->at('a')
              ->attr_is('href', '../')
              ->attr_isnt('href', './')
              ->attr_like('href', qr'\.\./')
              ->attr_unlike('href', qr'\.\./a')
              ->text_is('some link')
              ->text_isnt('some link2')
              ->text_like(qr'some')
              ->text_unlike(qr'some2')
              ->has_attr('href')
              ->has_attr('empty')
              ->has_attr_not('not_exists');
          $t->at('a')->get(1)
              ->text_is('some link2');
          $t->at('a:nth-child(2)')
              ->text_is('some link2');
          $t->at('a')->each(sub {
              my $t = shift;
              $t->text_like(qr{.});
              $t->text_unlike(qr{a});
              $t->attr_like('href', qr{.});
              $t->attr_unlike('href', qr{a});
          });
          $t->at('a')->parent->attr_is('id', 'some_p');
          $t->at('a')->parent->parent->attr_is('id', 'wrapper');
          $t->at('#some_p')->has_child('a');
          $t->at('#some_p2')->has_child_not('a');

          $t->at('#some_img')->has_class('class1');
          $t->at('#some_img')->has_class('class2');
          $t->at('#some_img')->has_class('class3');
          $t->at('#some_img')->has_class_not('class4');
      });
4月
08

 

 

Mojolicious v2.76

4月
07

 

mojoの最新版をmojo-legacyにマージする自分用メモ。

 

mojoリポジトリのクローンで作業開始。

$ cd mojo
$ git checkout master
$ git pull upstream master
$ git pull upstream master --tags
$ git checkout mojo-legacy
$ git merge v2.82

…コンフリクトを直す。ついでにChangesも追記

… qr/( ~~ | // | //= )/で検索するなどして、新たなperl-5.10.x依存を排除。正規表現も注意。

その後、テスト。

$ perlbrew use perl-5.8.7
$ export TEST_HYPNOTOAD=1
$ export TEST_TLS=1
$ export TEST_MORBO=1
$ export TEST_EV=1
$ export TEST_ONLINE=1
$ export TEST_CACHING=1
$ export TEST_IPV6=1
$ export TEST_PREFORK=1
$ export TEST_POD=1
$ prove -r t

…mojo-legacyリポジトリを差し換え

その後、コミット。

$ cd mojo-legacy
$ git add .
$ git add -u
$ git commit -m 'rebased on Mojolicious v2.82'
2月
18

PogoPlugを無事、ハックできたので、次はウェブサーバーを立ち上げてみた。最終的にはフォトギャラリーを身内と共有したいんだけど、とりあえずは、指定のディレクトリ以下を手軽に公開する。ただし、apacheとか大げさなものは使わず、自作のMojoX::Tusuっていう何かを使う。Mojoliciousプラグインなんだけど、apacheみたいにファイルをサーブする何か。

このブログにやたらと登場するMojoX::Tusuですが、ただ自分が好きで使ってるだけです。危険なのであまり真似しないほうがいいと思います。

 

root権限でcpanmのインストール。

$ perlbrew install-cpanm

前回インストールしたPerlに切り替え。

$ perlbrew switch perl-5.14.2

MojoX-Tusuっていう何かを入れる。最近、cpanmでgithubから直接インストールできなくなった。githubがSSLになったせいか、リダイレクトの関係か、不明。しょうがないのでwgetしてからcpanm。

$ cd ~
$ wget https://github.com/jamadam/MojoX-Tusu/tarball/v0.38
$ cpanm v0.38
$ rm v0.38

依存先のMojoliciousも入ったはずなので、tusu_appってものをジェネレートする。

$ mojo generate tusu_app Public

~/public/lib/Public.pmにindexesオプションを追記。これでapacheのauto indexみたいな動作。

        encoding                => ['Shift_JIS', 'utf8'],
        document_root           => $self->home->rel_dir('public_html'),
+       indexes => 1,
    });

アプリを起動する。

$ hypnotoad ~/public/script/public

以上で~/public/public_htmlがドキュメントルートになったので、8080ポートで見られる。あとは、public_html以下にファイルを突っ込めばハローワールド。身内用には別のtusu_appを乱立してhypnotoad.confでポートを割り当ててく。Mojolicious::Plugin::PlackMiddlewareとかでベーシック認証でもかけておけば良いんじゃないかと思う。

 

とりあえず、テキトーにMojo::Tusuのソースをアップしてみたけど、そのうち消す。

2月
14

昨年暮れに、自宅サーバーのHDDがぶっ壊れて、部屋に静けさが戻った。httpサーバーは、さくらのVPSに引越しした。けど、大容量ストレージがないと何かと不便なので、復活させることにした。

デスクトップマシンだとデカイしファンがうるさいので、流行のPogoplugをハックすることにした。

Pogoplugのラインナップがよく理解できなかったので、テキトーにAmazonで最安値だった中古のPOGO-P01を購入。4,800円也。合わせて、システム用にBUFFALOのUSBメモリー(8GB)を982円で購入。こちらは新品。以前のサーバーに外付けしていた1TBのUSB HDDを復活させる。宅内からはsambaで、外出先からはscpとhttpでデータ出し入れ、という予定。

ここを参考にしてdebian化。と思ったら、Pogoplug P01(Pro)はハックの対象外だった。気付くのに2日かかった。USBメモリにシステムをインストールまではできたんだけど、ubootの書き換えができず。しょうがないので、Arch Linux ARMというものを入れた。公式のドキュメントのとおりに進めたら、ものの30分で終わった。その後、下記の手順で追加の設定等。

データ用の1TBハードディスクを接続し、マウントする。/homeにまるごと当てがっちゃう。

# echo '/dev/sdb    /home   ext2    defaults    0 2' >> /etc/fstab
# mount -a

debianでいうaptはpacman。パッケージマネージャ、略してパックマンか。

pacman -Syuでエラーがでるので、下記に従う。

念のためバックアップ。

# cp /etc/mtab /home
# mv /etc/profile.d/locale.sh /home

上記の記事どおり。

# pacman -S filesystem --force
# rm /etc/profile.d/locale.sh

パッケージの更新。

pacman -Sy
pacman -Syu

viをvimのエイリアスに。

# alias vi='vim'
# export EDITOR=vim

ユーザー作成。

# adduser ore
# adduser yome
# adduser familyname
# groupadd familyname
# usermod -g familyname ore
# usermod -g familyname yome

ルートログイン禁止。

$ vi /etc/ssh/sshd_config
PermitRootLogin no

タイムゾーンの設定。

$ ln -sf /usr/share/zoneinfo/Asia/Tokyo /etc/localtime

samba入れる。公式ドキュメントに従ってnmbdとプリンター共有も停止。

# pacman -S samba

ddnsの設定。value domainのCGIを15分おきに叩く。本当はローカルにIPを保存しておいて変化を検出してから更新したほうがいいけど、とりあえず手軽に。

# crontab -e
*/15 * * * * wget -O - 'http://dyn.value-domain.com/cgi-bin/dyn.fcg?d=jamadam.com&p=XXXXXXXXXXX&h=home' > /dev/null 2>&1

固定IP

interface=eth0
address=192.168.11.2
netmask=255.255.255.0
gateway=192.168.11.1

perlbrew入れようと思ったらmakeコマンドがなかったので、base-develをインストール。

pacman -S base-devel

perlbrew自体をインストール

その後、perlbrew install perl-5.14.2しようと思ったらメモリー足りず。公式ドキュメントを参考に1GBのswapfileを作成。

# dd if=/dev/zero of=/swapfile.img bs=1M count=1024
# mkswap /swapfile.img
# swapon /swapfile.img
# echo '/swapfile.img none swap sw 0 0' >> /etc/fstab

non-rootユーザーでperl-5.14.2をインストール。2時間半かかった。普段は20分で終わるんだけど、やっぱりマシンが非力なせいかな。

$ perlbrew install perl-5.14.2

 

続く