usuilog-プログラミングメモ

[Ruby][Rails]InputDrawとrailsで作る手書き掲示板

2007-08-09T14:24:00.000+09:00

InputDrawとrailsを使って手書き掲示板を作成してみました。InputDrawとは手書き可能なフォームを簡単に作成できるライブラリです。下記のような手書きキャンバスを作成できます。

scaffoldで雛型作成

まずはscaffoldで雛型を作成します。


rails inputdraw
cd inputdraw
./script/generate scaffold_resource post title:string nickname:string comment:text image:string svg:text created_at:datetime updated_at:datetime

データベース準備

inputdraw_developmentというデータベースを作成しておき、マイグレーションを実行します。


rake db:migrate

file_columnプラグインのインストール

画像アップロード処理にはfile_columnプラグインを利用します。これを使うとアップロード処理と、レコードとファイルパスの関連付けを自動でおこなってくれます

./script/plugin install http://opensvn.csie.org/rails_file_column/plugins/file_column/trunk

InpudDrawのインストール

サイトからファイルをダウンロードし、public/javascriptsディレトリに配置します。

|-- javascripts
|   |-- inputdraw
|   |   |-- inputdraw.free-non-commercial.1.2.swf
|   |   |-- inputdraw.js
|   |   `-- swfobject.js

ImageSizeのインストール

キャンバスのサイズは画像サイズから求めることにしました。
file_columではRMagickを使って画像を簡単に加工できるようになっていますが、今回はサイズが欲しいだけだったのでImageSizeを利用しました。

gem install imagesize

テンプレートの編集

app/view/layout/posts.rhtml

InputDrawに必要なファイルを読み込みます

<%= javascript_include_tag 'inputdraw/swfobject' %>
  <%= javascript_include_tag 'inputdraw/inputdraw' %>

app/view/layout/new.rhtml
Imageをfile_fieldに変更し、フォームタイプをmultipartにします。
svgとcreated_at,updated_atはとりあえず削除します。

<% form_for(:post, :url => posts_path, :html => { :multipart => true }) do |f| %>

    <b>Image</b><br />
    <%= f.file_field :image %>

app/view/posts/index.rhtml
イメージの部分をタグに置き換えます。svgは表示しないので削除します。

 <td><%= image_tag url_for_file_column(post, "image"), :height => 150 %></td>

app/view/posts/show.rhtml
svgの部分をInputDrawのキャンバスにする要素で置き換えます。表示用に使用したいのでここではsrc要素を指定しています。
imageタグの部分は削除します。

<p>
  <b>Svg:</b>
  <div id="place"></div>

</p>

<!-- 末尾に追加 -->
<script type="text/javascript">
//<[![CDATA
        new InputDraw("/javascripts/inputdraw/inputdraw.free-non-commercial.1.2.swf", "place",

        {src_svg:"<%=h @post.svg %>",
                 width:"<%= @post.image_width %>",
                 height:"<%= @post.image_height %>",

                 animation:60,
                 background_image: '<%= url_for_file_column(@post, "image") %>'});
//]]>
</script>

app/view/posts/edit.rhml
svgのテキストエリアは非表示にします。変わりにキャンバス用の要素とInputDrawのコードを追加します。編集用に使う場合はid要素でsvgデータを保持している入力コントロールのIDを指定します。

<div id="place"></div>

    <div style="visibility:hidden; display:none">

      <%= f.text_area :svg %>
    </div>

<!-- 末尾に追加 -->
<script type="text/javascript">

//<[![CDATA
        new InputDraw("/javascripts/inputdraw/inputdraw.free-non-commercial.1.2.swf", "place",
        {id:"post_svg",

                 width:"<%= @post.image_width %>",
                 height:"<%= @post.image_height %>",
                 animation:60,

                 background_image: '<%= url_for_file_column(@post, "image") %>'});     
//]]>
</script>

モデルの編集

app/models/post.rb
file_columnと、ImageSizeのコードを追加します。

require 'rubygems'
require 'image_size'

class Post < ActiveRecord::Base

  file_column :image

  def image_width
    image_file ? image_file.get_width : 0
  end

  def image_height
    image_file ? image_file.get_height : 0
  end

  def image_file
    if (image && !@image_file )
      open(image ,"rb") do |img|
        @image_file = ImageSize.new(img)
      end

    end
    @image_file
  end
end

以上で完成です。あとはサーバを起動してhttp://localhost:3000/postsにアクセスするだけです。

参考書籍

Railsを学ぶにはやはりRails開発者であるDavid Heinemeier Hanssonの著書がオススメです。前半はショッピングカートを題材にした実践的なＷｅｂアプリケーションのチュートリアル、後半はActiveRecordなど各コンポーネントの詳細説明とRailsの基本から詳細までが網羅された内容となっています。また、ところどころにある"David曰く"の囲みが面白く、例えば「テーブル名はなぜ複数形にするべきなのか？」といった内容に

テーブル名を複数形にしておくことで、Select a Product from products.(商品テーブルから商品を一つ選択してください）という文章が違和感なく理解できるようになります。

と回答されていたりと、Railsがなぜそういった設計にいたったのかという経緯が解説されていたりします。

参考

<InputDraw/> - The simplest draw editor to your forms

フォームで落書きを投稿できるようにするJavascriptライブラリ『<input type="draw" />』

[JavaScript][Ext]Ext.jsのフォームコンポーネントと入力チェック

2007-06-25T16:07:00.000+09:00

既存のhtmlを元にJavaScriptでリッチコントロール機能の追加や入力チェックを行う方法を紹介します。Ext1.1 beta1を元にしています。

基本構文

// フォームオブジェクト生成
var comp = new Ext.form.TextField();
// HTMLElementへフォームオブジェクトを適用
comp.applyTo('elem-id');

入力エラー時のツールチップを有効にするには以下のコードを入れておく必要があります。

Ext.QuickTips.init();

DateField
まずは何かと使い道の多そうなDateField。年/月/日形式にするためにはformatを指定する必要があります。

var date = new Ext.form.DateField({
    allowBlank:false,
    format: 'Y/m/d'
});
date.applyTo('birth-input');

これだけで通常のテキストフィールドにカレンダー入力コントロールと日付チェックを追加できます。

入力エラー時はツールチップでエラーメッセージが表示されます。デフォルトでは英語ですが、日本語リソースを読み込むとメッセージも日本語になります。

<script src="ext-1.1-beta1/source/locale/ext-lang-ja.js" type="text/javascript" charset="utf-8"></script>

Validation
通常のテキストフィールド。フォーマットチェックを行いたい場合はvtypeでvalidation typeを指定します。例えばurlなら以下のような感じ。

var url = new Ext.form.TextField({
  allowBlank: false,
  vtype: 'url' // SEE ALSO Ext.form.VTypes
});
url.applyTo('url-input');

Custom Validation
続いてemail。vtype: 'email'もできますがDoCoMo式のアットマークの前にピリオドがあるアドレスは通らないのでカスタムバリデーションでやってみます。validationに値一つを受け取るfunctionオブジェクトを設定します。チェックＯＫの場合はtrueを、エラーの場合はエラー文字列を返すという仕様です。

var mail = new Ext.form.TextField({
  allowBlank: false,
  // Custom validation
  validator: function(fvalue) {
   // Ext.form.VTypesより。@の前の.も許可
   var email = /^([\w]+)(.[.\w]+)*@([\w-]+\.){1,5}([A-Za-z]){2,4}$/;
   if (email.test(fvalue)) {
    return true;
   }
   return String.format('{0}はメールアドレスとして正しくありません。', fvalue)
      + Ext.form.VTypes.emailText;
  }
});
mail.applyTo('mail-input');

Number Field
数値のみ許可する入力フィールド。アルファベットが入力できなくなります(日本語は残念ながらOK)

var income = new Ext.form.NumberField({
 allowBlank: false
});
income.applyTo('income-input');

Combo Box
select要素からExt.form.Comboboxオブジェクトにするのは少し違う手順。applyToするのではなくtransformで元になるselect要素を指定します。

var combo = new Ext.form.ComboBox({
    typeAhead: true,
    triggerAction: 'all',
    width:135,
    forceSelection:true,
    transform: 'blood-select'
});

Textarea

テキストエリアも同様です。growを設定しておくと入力量に応じてエリアが自動的に拡張されます。
var carrier = new Ext.form.TextArea({
    grow: true, // 入力量に応じてテキストエリアが拡張される
    growMax: 200
});
carrier.applyTo('carrier-area')

Html Editor
Ext1.1からWYSIWYGなhtmlエディターコンポーネントが追加になっています。これも使い方は同様。

var promo = new Ext.form.HtmlEditor({
    width: 600,
    height: 300
});
promo.applyTo('promotion-area');

JavaScriptでフォームをデザインするサンプルは以下にあります。個人的にはデザインとロジックの分離ができる後からコントロールを追加するパターンの方が好みです。(サンプルでform.htmlが有りますがまだ作りかけなようです）

参考

Dynamic Forms built with JavaScript

[JavaScript][Ext]フォームコントロールと入力チェック・・・全ソースはこちら

[JavaScript][Ext]ソート可能なテーブルを実装する

[JavaScript][Ext]Ext.jsの使い方メモ(Core機能)

Ext JSメモ

【ハウツー】Apolloのサンプルで使われた、美しきJavaScriptフレームワーク「Ext 1.0」 | エンタープライズ | マイコミジャーナル

[JavaScript][Ext]ソート可能なテーブルを実装する

2007-06-12T20:15:00.000+09:00

絶対お勧め！JavaScriptでテーブルソート「Table Sorter」

普通のテーブルタグに対して、ヘッダ部分はtheadタグとthタグで作るだけでいい。データ部分は全体をtbodyタグで囲んで、tdタグで記述するだけだ。

Extを使っても同様の方法でソート可能なテーブルを実装できます。
以下のサンプルからExt.grid.TableGridクラスをもらってきて使うだけです。

From Markup Grid Example

Script

var grid = new Ext.grid.TableGrid('the-table');
grid.render();

ロード時にページ内のテーブル全てに適用したければ下記のような感じでＯＫです。

Ext.onReady(function() {
    Ext.select('table').each(function (e) {
        var grid = new Ext.grid.TableGrid(e);
        grid.render();
    } )
});

このGridはかなり高機能で、列クリックによるソートだけではなく、ドラッグによる列の入れ替えや、
ポップアップメニューでの表示列の切り替え、列の固定なども行えます。
インクルードファイルの数やリソースの数など設置は若干大変ですが、それさえ乗り越えればかなり手軽でよいと思います。

参考

[JavaScript][Ext]Ext.jsの使い方メモ(Core機能)

[JavaScript]Ext.js 1.0が正式リリース

Ext JSメモ

【ハウツー】Apolloのサンプルで使われた、美しきJavaScriptフレームワーク「Ext 1.0」 | エンタープライズ | マイコミジャーナル

[JavaScript][Ext]Ext.jsの使い方メモ(Core機能)

2007-05-22T19:38:00.000+09:00

Ext.jsの使い方メモです。Core機能をまとめてみようと思います。

最初に必要なライブラリを読み込みます。(ext-1.0に展開されたソースがある前提)

<script src="ext-1.0/adapter/yui/yui-utilities.js" type="text/javascript" charset="utf-8"></script>
<script src="ext-1.0/adapter/yui/ext-yui-adapter.js" type="text/javascript" charset="utf-8"></script>
<script src="ext-1.0/ext-all-debug.js" type="text/javascript" charset="utf-8"></script>

スタイルシートの読み込みます。
自分で全部定義するのは大変なので付属のものを使います。

<link rel="stylesheet" href="ext-1.0/resources/css/ext-all.css" type="text/css" media="screen" charset="utf-8" />

テーマを変更したい場合は上に加えてythema-xxx.cssを読み込むだけです。

<link rel="stylesheet" href="ext-1.0/resources/css/ythema-aero.css" type="text/css" media="screen" charset="utf-8" />

基本はExt.Elementオブジェクトです。

var elem = Ext.get('my-div');

でExt.Elementオブジェクトが返ってきます。これはHTMLElementオブジェクトをラップしたオブジェクトで、各種プロパティの設定／取得や、アニメーション、AJAX機能が利用できます。

表示非表示の切り替えは、show(), hide()メソッドでそれぞれ行います。

elem.show();
elem.hide();

デフォルトではvisibilityプロパティを変更して表示／非表示を制御します。
要素ブロックごと消したい場合はenableDisplayMode()としてからそれぞれのメソッドを呼び出すとdisplayプロパティで表示／非表示を切り替えてくれます。

elem.enableDisplayMode();
elem.hide();

イベントハンドラの設定

イベントハンドラの設定はExt.Element.onメソッドで行います。これはxt.Element.addListnerのaliasになっています。

elem.on('click', function(event, target) {
    // 処理
});

ハンドラの第一引数はExt.EventObject、第２引数はイベントソースのHTMLElementオブジェクトとなります。

アニメーションエフェクト
エフェクト系はExt.Fxで定義されています。
Ext.FxのメソッドはExt.Elementのprototypeにコピー(Ext.apply)されているので、Ext.Elementオブジェクト経由なら特に意識することなく利用できます。

elem.highlight();
elem.fadeOut();
elem.fadeIn();
elem.switchOff();
elem.switchOn();
// etc...

またFx系のメソッドはElementが返ってくるので、でつないでアニメーションチェーンにすることができます。

elem.highlight().fadeOut().fadeIn().switchOff().switchOn();

セレクター
CSSセレクターで要素を選択するにはExt.selectメソッドを使用します。

var elems = Ext.select('.myclass');

戻り値はExt.CompositeElementオブジェクトです。こちらは名前のとおりCompositeパターンに
なっているので、Ext.Elementのメソッドを呼び出すと透過的に全てのオブジェクトに対して
メソッドが呼び出されます。

// myclassクラスが設定されている全ての要素に対してclickイベントハンドラを設定
elems.on('click', function() { ... } );

要素を一つずつ処理する場合はeachを使います。途中でbreakしたい場合はfalseを返します。
continueは単にreturnです。

elems.each(function (elem) {
    if ( condition ) {
        // ... なんらかの処理
        return false; // breakする
    } else {
        // ... なんらかの処理
        return; // continueする
    };
    // ...
});

XPathセレクター
XPathで要素を選択するにはExt.queryメソッドを使います。こちらはDomQuery.selectのaliasです。
こちらの戻り値はExt.CompositeElementではなくHTMLElementのArrayオブジェクトとなります。
おそらくExt.queryの実装であるDomQueryクラスがExtに依存しないようにするためだと思われます。

Ext.Elementオブジェクトに対してselect, queryを行うと、その要素の子要素以下に限定して
要素を選択します。

elem.select('.myclass') // same as '#' + elem.dom.id + ' .myclass';
elem.query('.myclass') // same as '#' + elem.dom.id + ' .myclass';

ただselectの方はグループ化に対応していない(1.0.1a)らしく最初のセレクターにしかidを追加して
くれないようです。(queryの方は上手くいく）

Mindomoでマインドマップにしてみました。

次はAJAX周りで遊んで見る予定。

参考

[JavaScript]Ext.js 1.0が正式リリース

Ext JSメモ

【ハウツー】Apolloのサンプルで使われた、美しきJavaScriptフレームワーク「Ext 1.0」 | エンタープライズ | マイコミジャーナル

[JavaScript]Ext.js 1.0が正式リリース

2007-04-19T10:35:00.000+09:00

リッチなJavaScriptライブラリのExt.jsが正式リリースされたようです。

サンプルのようにかなりカッコイイコンポーネントが用意されています。ドキュメントも充実していて結構使いやすい印象です。

最近話題のApolloでも、サンプルアプリケーションで使われていたりします。
Fresh Reader

また超リッチJavaScriptコンポーネント集「Ext」がprototype.jsに対応にもあるようにCoreとなるライブラリを切り替えられるというのもユニークな点かと思います。

さらに全てをダウンロードしなくても、必要な部分だけをbuildしてダウンロードさせてくれるサービスも公開されています。
コアライブラリを選択し必要なコンポーネントを選択すると、その分だけのコードをまとめてダウンロードできます。ただしcssや画像などは別途ダウンロードしておく必要があるようです。（zip中のresourcesを使う）

UIコンポーネント以外でもDomQueryも便利そうです。XPath、CSSセレクターで、CSS3レベルのセレクターをほぼサポートしていて、しかもかなり高速とのこと。CSSセレクターの実装はブラウザによって結構差がありますが、これを使えばそういった心配もいらないので助かりそうです。

[Testing][Perl]Test::WWW::SeleniumでPerlからSelenium RCを操作する

2007-01-29T17:57:00.000+09:00

Selenium IDEを使うとhtmlの各種プログラミング言語用のテストコードも出力してくれます。
Perlの場合はTest::WWW::Seleniumモジュールを利用します。

前記事「Selenium RCとSelenium IDEでWEBアプリのUIテストを簡単自動化」の操作で出力されるPerlコードは以下のようになります。

Selenium IDEによって出力されるコード

use strict;
use warnings;
use Time::HiRes qw(sleep);
use Test::WWW::Selenium;
use Test::More "no_plan";
use Test::Exception;

my $sel = Test::WWW::Selenium->new( host => "localhost", 
                                    port => 4444, 
                                    browser => "*firefox", 
                                    browser_url => "http://localhost:4444" );

$sel->open_ok("/");
$sel->type_ok("q", "Perl");
$sel->click_ok("btnG");
$sel->wait_for_page_to_load_ok("30000");
$sel->is_text_present_ok("Perl の検索結果");

スクリプトはutf8で保存します。browser_urlがlocalhostになってしまうようなのでwww.google.co.jpに変更します。

スクリプト実行前にSelenium RCを起動しておきます。

java -jar selenium-server.jar

続いてテストスクリプトを実行します。

ok 1 - open, /
ok 2 - type, q, Perl
ok 3 - click, btnG
ok 4 - wait_for_page_to_load, 30000
not ok 5 - is_text_present, Perl の検索結果
#   Failed test 'is_text_present, Perl の検索結果'
#   at test_utf8.t line 19.
1..5
# Looks like you failed 1 test of 5.

最後のテストで失敗してしまいました。verboseモードを使って実行手順をトレースしてみまると以下のようなコードを送信しているようでした。

---> Requesting http://localhost:4444/selenium-server/driver/?cmd=isTextPresent&1=Perl%20%C3%A3%C2%81%C2%AE%C3%A6%C2%A4%C2%9C%C3%A7%C2%B4%C2%A2%C3%A7%C2%B5%C2%90%C3%A6%C2%9E%C2%9C&sessionId=1170055300866
Got result: OK,false

日本語の部分がおかしいようなのでコードを追ってみると以下のようにutf8フラグ付を前提としているようです。

URI::Escape::uri_escape_utf8(shift @args);

テストスクリプトにuse utf8をつけて再度実行してみます。

ok 1 - open, /
ok 2 - type, q, Perl
ok 3 - click, btnG
ok 4 - wait_for_page_to_load, 30000
ok 5 - is_text_present, Perl の検索結果
1..5

上手く実行できました。

このようにプログラムからテストを実行すると、テストに必要なデータの準備から後始末までを自動化できます。例えばユーザーの新規登録フローをテストするといったケースでは登録しようとするユーザーのデータがないことが前提になりますので、まずテストユーザのデータを削除してからブラウザを起動して登録フローのテストを実行することで繰り返しテストすることが可能です。DBがトランザクションをサポートしているものであれば最後にrollbackしてしまえば不要なデータも残らず快適です。

このあたりのノウハウは前項でも紹介したWEB+DB Pressで詳しく紹介されています。Perlは無いですが。。。

最終的なコード

use strict;
use warnings;
use Time::HiRes qw(sleep);
use Test::WWW::Selenium;
use Test::More "no_plan";
use Test::Exception;
use utf8;

my $sel = Test::WWW::Selenium->new( host => "localhost", 
                                    port => 4444, 
                                    browser => "*firefox", 
                                    browser_url => "http://www.google.co.jp",
                                     );

$sel->open_ok("/");
$sel->type_ok("q", "Perl");
$sel->click_ok("btnG");
$sel->wait_for_page_to_load_ok("30000");

$sel->is_text_present_ok("Perl の検索結果");

[Perl]Benchmarkモジュールの小ネタ

2007-01-18T18:56:00.000+09:00

PPerlのベンチを取りたくて、timeコマンドとかでも充分差は出るのですが、繰り返し実行される際の差を取りたかったのでBenchmarkモジュールでやろうとしたら少しおかしな結果になりました。

ちなみにPPerlとはスクリプトをコンパイルしてデーモンとして常駐させることで、起動時のオーバーヘッドをなくして高速化するというモジュールです。これもPerl Hacksに載ってます。

ベンチ対象(hello.pl)

use strict;
use Template;

my $tmpl = <<__TMPL__;
str = [% str %]
__TMPL__

my $tt = Template->new();
$tt->process(\$tmpl, { str => 'hello' });

print "hello\n"だけでやるとプロセス間通信のオーバーヘッドの方が大きいのかかえって遅くなったので、適当に大きめなモジュールを使えということでTemplateを使用。

で、ベンチのプログラムですが、以下のようにSYNOPSISどおりに実行すると

#!/usr/local/bin/perl
use strict;
use Benchmark qw(timethese);

timethese(100, {
    pperl => sub {
        my $ret = `/usr/bin/pperl -w --no-cleanup hello.pl`;
        die "error" unless ($ret =~ m|hello|);
    },
    perl => sub {
        my $ret = `/usr/bin/perl -w hello.pl`;
        die "error" unless ($ret =~ m|hello|);
    },
});

こんな感じになります。

Benchmark: timing 100 iterations of perl, pperl...
    perl: 42 wallclock secs ( 0.01 usr  0.03 sys + 38.64 cusr  2.56 csys = 41.24 CPU) @ 2500.00/s (n=100)
    pperl:  6 wallclock secs ( 0.01 usr  0.03 sys +  0.34 cusr  0.38 csys =  0.76 CPU) @ 2500.00/s (n=100)

wallclockとかはちゃんと出ているんですがRateがおかしい。これでも結果はわかるといえばわかるのですが気にいらないのでいろいろ調べていると、第３引数にstyleを指定することができるというのを見つけました。これを使うと親プロセスだけの時間とか子プロセスだけの時間とか計ってくれるようです。今回は子プロセスの実行時間が欲しいので'nop'としました。

スタイルの指定

#!/usr/local/bin/perl
use strict;
use Benchmark qw(timethese :hireswallclock);

timethese(100, {
    pperl => sub {
        my $ret = `/usr/bin/pperl -w --no-cleanup hello.pl`;
        die "error" unless ($ret =~ m|hello|);
    },
    perl => sub {
        my $ret = `/usr/bin/perl -w hello.pl`;
        die "error" unless ($ret =~ m|hello|);
    },
}, 'nop');

実行結果

Benchmark: timing 100 iterations of perl, pperl...
    perl: 47.9732 wallclock secs (44.66 cusr +  3.14 csys = 47.80 CPU) @  2.09/s (n=100)
    pperl: 7.10064 wallclock secs ( 0.35 cusr +  0.47 csys =  0.82 CPU) @ 121.95/s (n=100)

うまく出ました。それにしてもallのとき（デフォルト）は親子の合計で/sも出してくれればいいのにと思うのは私だけでしょうか？

ちなみにこれを調べている過程で':hireswallclock'を見つけました。これをuseのときに指定しておけばwallclockもTime::HiResで出してくれます。ちょっと便利。

[Book][Perl]Perl Hacks日本語版

2007-01-18T10:20:00.000+09:00

ついに日本語版が出るようです。

すぐに使えるものから、ちょっとマニアックなものまで、Perlプログラミングに関する１０１のTIPSが集められています。英語版を買って全部は読みきれていないのですが印象に残ったハックを紹介。

Hack 3　Perlドキュメントをオンラインでブラウズしよう
Pod::Webserverモジュールが紹介されています。
Pod::Webserver::Sourceも組み込むとソースコードも閲覧できて便利です。ただいずれも日本語が上手く表示できないのが難点。

Hack 27　反復子から複数の値を引き出そう
wantarrayよりも豊富なcontext情報を提供するWantモジュールが紹介されています。
リストの数や、HASHかどうかまで判定できたりまします。

Hack 47　メソッド引数の自動宣言
B::Deparseモジュールの応用例です。CODEREFからCODEテキストを取得してそれを置換処理して$selfを自動宣言するという力技です。

Hack 74　使われているすべてのモジュールをトレースしよう
Devel::TraceUse
モジュールのuse順をトレースしてくれます。
当ブログの[Perl]useなしでどこでもDump(@INCにオブジェクトを格納するパターン）はここで知った知識を使っています。
でもこのTraceUseモジュール、じつはrequireのところでエラーになっていて本当にrequireするのにかかった時間を計っているわけではないようです。バグな気がしたので直そうとしたのですがrequireのネストが上手く処理できず直そうとしても上手くいきませんでした。。。

Hack 78　サブルーチンの中身を覗こう
Bモジュールのsvref_2objectを使うとCODEREFからシンボル名などさまざまな情報が取得できます。Bモジュール面白いですね。

そのほかにもvimでパッケージ名(::も含めて）をコード補完したりだとかデバッガをカスタマイズしたりなど使えるマニアックなハックが満載です。

原著

[Testing]Selenium RCとSelenium IDEでWEBアプリのUIテストを簡単自動化

2007-01-10T11:35:00.000+09:00

WEB+DB PressでSelenium特集が掲載されていたので試してみました。

Seleniumとはブラウザからのテストを自動化するツールです。テストケースをHTMLのtableタグで記述するため、比較的簡単にテストケースを作成できます。Selenium-Coreのみではテストケースをテスト対象アプリケーションがあるサーバと同じ場所に置かなければならない為若干面倒ですが、Selenium RCを使うとアップロードが不要になる為非常に便利です。

インストール
Selenium Remote Control
現時点での最新バージョンは0.90ですが-htmlSuiteオプションが使えないとのことなのでバージョン0.81を使用します。解凍して適当なところに置いてください。

Selenium IDE
Firefoxエクステンションです。バージョン0.86を使用しました。

テストに必要なファイル
作成するファイルは以下のとおりになります。
TestCase.html ・・・　個々のテストケース
TestSuite.html ・・・　テストケース一式をまとめたファイル。個々のテストケースへのリンクを貼る

少量のテストであればテキストエディタでも作成できますが、Selenium IDEを使うとブラウザの操作を記録してテストケースとなるhtmlファイルを作成してくれます。使い方はIDEを起動して記録ボタンを押した後、テスト対象となるアプリケーションを操作するだけです。

サンプル動画(Flash)
のように操作すると以下のようなhtmlファイルが生成できます。

<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<title>TestCase1</title>
</head>
<body>
<table cellpadding="1" cellspacing="1" border="1">
<thead>
<tr><td rowspan="1" colspan="3">TestCase1</td></tr>
</thead><tbody>
<tr>
    <td>open</td>
    <td>/</td>
    <td></td>
</tr>
<tr>
    <td>type</td>
    <td>q</td>
    <td>Perl</td>
</tr>
<tr>
    <td>clickAndWait</td>
    <td>btnG</td>
    <td></td>
</tr>
<tr>
    <td>assertTextPresent</td>
    <td>Perl の検索結果</td>
    <td></td>
</tr>

</tbody></table>
</body>
</html>

続いてTestSuiteファイルを作成します。こちらはテストケースを一覧したhtmlとなります。

<html>
<head><title>Test Suite</title></head>
<body>
  <table cellpadding="1" cellspacing="1" border="1">
    <tbody>
      <tr><td><b>Test Suite</b></td></tr>
      <tr><td><a href="./TestCase1.html">TestCase1</a></td></tr>
    </tbody>
  </table>
</body>
</html>

テストの実行
Selenuim RCを起動してテストを実行します。
コマンドの構文は

java -jar selenium-server.jar -htmlSuite <ブラウザ> <テスト対象サイトURL> <テストスイートファイル> <テスト結果ファイル>

です。

上記TestSuiteの場合は以下のようにします。

java -jar selenium-server.jar -htmlSuite "*firefox" "http://www.google.co.jp" tests/TestSuite.html tests/result.html

とします。

以上で自動的にブラウザが起動してテストが実行され、結果がresult.htmlファイルに出力されます。

ただこのままですテストが終わると即ブラウザが終了してしまうため、いちいちresult.htmlを開いて見ないと結果がわからないのが面倒です。そこで
[Selenium]assertEvalの活用方法(ブレイクポイント、終了通知)
を参考にJavaScriptが使えることを利用してalertするテストケースを用意しておき、TestSuite.htmlの最後に追加してやると、テストの最後にalertが出るので即結果が確認できます。

テスト実行結果

Seleniumではブラウザを会してテストを行う為JavaScriptの実行結果もテストできます。Selenium RCを使うとコマンド一つでブラウザの起動からテスト結果の保存までが行えるので回帰テストが非常に楽になると思います。

参考URL
Selenium 0.7利用手順書（前編）
これはすごい! Web案件必須 Selenium - 人気急上昇中自動テストツール

[Perl]Exporter::Global-任意の関数をグローバルにエクスポートする

2006-12-22T13:01:00.000+09:00

[Perl]useなしでどこでもDump(@INCにオブジェクトを格納するパターン）でやった@INCにオブジェクトを格納するコードを使って任意関数をグローバルにエクスポートするモジュールを作ってみました。名づけてExporter::Global

例えばErrorモジュールのtry catchを使いたいけどuse Error qw(:try)するのが面倒だとか、アプリケーション内で標準で使うことにしているようなケースで以下のようにしておくとどこでもtry - catch構文が使えるようになります。

# まずはエクスポートしたい関数を定義（またはインポート）する
use Error qw(:try)
# Exporter::Globalにエクスポートしたい関数を渡す
use Exporter::Global qw(try finally with);
# これ以降ロードされるモジュールではすべてtry catchが使える
no Exporter::Global; # Exporter::Globalをオフにする

また、;で区切ってエイリアスをつけられるようにしているので

perl -MYAML -MExporter::Global=YAML::Dump;p

や

perl -MData::Dumper -MExporter::Global=Data::Dumper::Dump;p

といった感じで任意のDump関数を指定することができます。また、前記事では想定されていなかった１ファイル内に複数のパッケージがあるケースにも対応しています。

ソース

package Exporter::Global;

use warnings;
use strict;
use Carp;
use Fatal qw(open close);

sub import {
    my $class = shift;
    my $args = ref $_[0] eq 'HASH'
             ? $_[0] : { subroutines => [ @_ ] };

    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
    unshift @INC, $class->new($args)
        unless (grep {ref $_ eq $class } @INC);
}

sub unimport {
    my $class = shift;

    @INC = grep { ref $_ ne $class } @INC;
}

sub new {
    my $class = shift;
    my $self = { %{ _parse_arguments(@_) } };
    croak "Pass the export subroutines"
        unless (@ { $self->{subroutines} });

    bless $self, $class;
    $self->{modules} ||= [];
    $self->{caller_pkg} ||= caller($Carp::CarpLevel);

    return $self;
}

sub _parse_arguments {
    my (@args) = @_;
    my $h;
    if (ref $args[0] eq 'HASH') {
        $h = $args[0];
    } else {
        my @subrutines = map { split /[\s,]+/, $_ } @args;
        $h = {
            subroutines => \@subrutines,
        };
    }
    return $h;
}

sub Exporter::Global::INC {
    my $self = shift;
    my $module = shift;

    my $mod_name = _mod_name($module);
    return unless ($self->_is_export_target($mod_name));

    my @pkgs = ($mod_name);
    push @pkgs, $self->_find_inner_packages($module);

    for my $export_sub ( @{ $self->{subroutines} } ){
        my ($import_sym_name, $export_alias)
            = $self->_extract_sym_name($export_sub);

        for my $pkg (@pkgs) {
            no strict 'refs';
            *{"$pkg\::$export_alias"} = \&{"$import_sym_name"};
        }
    }
    return;
}

sub _is_export_target {
    my $self = shift;
    my $mod_name = shift;

    if (my @modules = @{ $self->{modules} }) {
        return unless ( grep { $mod_name =~ qr($_) } @modules);
    }
    return 1;
}

sub _mod_name {
    (my $mod_name = shift) =~ s|/|::|g;
    $mod_name =~ s|\.pm$||;
    return $mod_name;
}

sub _extract_sym_name {
    my $self = shift;
    my $export_sub = shift;
    
    my ($sub_name, $alias) = split /;/, $export_sub, 2;
    die "Can't extract subroutine name" unless ($sub_name);

    $alias ||= $sub_name;

    my $import_sym_name 
        = $sub_name =~ /::/ ? $sub_name : "$self->{caller_pkg}::$sub_name";

    return ($import_sym_name, $alias);
}

sub _find_inner_packages {
    my $self = shift;
    my $module = shift;

    my $mod_name = _mod_name($module);

    my @pkg;
    for my $inc (@INC) {
        next if (ref $inc);
        my $path = $inc;
        $path .= '/' unless ($path =~ m|/$|);
        $path .= $module;
        next unless (-e $path);
        open (my $fh, $path);
        while (<$fh>) {
            next if (/^=(?!cut)/ .. /^=cut/);
            last if (/^__END__$/);
            if (my ($pkg) = m|^package\s+(.+?);|) {
                next unless ($self->_is_export_target($pkg));
                next if ($mod_name eq $pkg);
                push @pkg, $pkg;
            }
        }
        close $fh;
    }
    return @pkg;
}
1; # End of Exporter::Global

[Service]ブログバトラー

2006-12-19T01:42:00.000+09:00

ブログバトラーなるサービスがリリースされたそうです。

ブログバトラーβオープン

ブログに貼り付けて使うタイプのサービスで、ブログのフィードからキーワードを抽出してブログに会ったキャラクターの特性を作ってくれるとのこと。面白そうなので早速貼り付けて見ました＞右下参照

そして対戦してみたら見事に勝利！！ｗ

というわけで勝ち逃げにて失礼しますm(_ _)m

[感想]はてなの開発体制

2006-12-15T10:58:00.000+09:00

ライブドアでやってるセミナーは一度行ってみたいのですがいつも気付いたときには締め切られているのでこうやって資料をアップしてもらえるのは非常にありがたい。

ライブドアのテクノロジーセミナーでしゃべってきました。

技術的な点もLVSとか興味深くて試してみたいことはたくさんあるのですが、特に気になったのが開発体制のところの話。以下いくつか抜粋してみますと。。。

開発者が企画/運用
新しいことの正しさは本人にしか分からない

まさにそうですよね。
うちの会社の場合は企画者も開発者も運用者も全部別の人なので、新しい技術でサービスをといっても距離を感じてしまいます。自分の力量不足もあるんでしょうが。別の人でもいいんですがもうちょっと見通しがよくなるようにしていけたらなぁと。

デュアルモニタ購入サポート

これ羨ましいｗ

休日選択制 (水 or 土)

平日休めるのいいなぁ。

半年続けると流行るの法則。継続は力。

流行ってるサービスを真似するんじゃなくて流行るサービスを生み出したい。

プログラマのモチベーションは会社の原動力です。

すばらしい。開発者主導で楽しんでサービスを作っていっている感じが伝わってきます。
うちもそういう部分を出していきたいなぁ。

[Perl]UMLクラス図の自動生成(UML::Class::Simple)

2006-12-14T20:11:00.000+09:00

UML続きでこんどはこれを試してみました。

http://search.cpan.org/~agent/UML-Class-Simple/

まずGraphvizをインストールしておく必要があります。

私はソースからインストールしました。(Graphviz version 2.12)

./configure
make
make install

で問題なくインストールできました。
つづいてcpanコマンドでUML::Class::Simple(0.07)をインストール。
大量のモジュールをインストールした後最後にこれをインストールしようとするがテストでこけまくる。
とりあえずforceでインストールしてみてだめだったら考えようということでインストールしてしまいました。

とりあえず以下のような簡単なクラス構成で実行してみます。

package Base;
sub new { bless {}, shift }
sub base_method {
    print "I am base\n";
    shift->protected_method();
}
1;

package Foo;
use strict;
use base 'Base';

sub new { bless {} };
sub method_foo {
    print "method_foo called\n";
    shift->base_method;
};

sub protected_method {
    print "overrided\n";
}

1;

package Hoge;
use Foo;
sub foo {
    my $self = shift;
    return $self->{foo} ||= Foo->new();
}

1;

# umlclass.pl -M Hoge -o hoge.png -p "^(Hoge|Foo|Base)$"
Error: syntax error in line 8 
...  ...
in label of node class_1
 at /usr/bin/umlclass.pl line 102

~~となりエラー。。。~~追記(2007/04/11)作者の方が上記内容をパッチとしてアップデートしてくださいました(コメント参照)。

どうもfontタグの中身が空だからエラーを出しているんじゃないかと思い、
仕方ないのでデバッガでソースを追っていると、Graphvizのdotコマンドに渡すファイルをTTで作っていることがわかったので、その結果を一時ファイルに保存するようにコードを変えて見てみると、属性にあたるところだということが分かりました。そこで属性が無いときはfontタグを出さないように変更してやると上手く動きました。（その後操作の部分も同様に修正）

# diff Simple.pm Simple.org 
327,329d326
<       open (my $fh, '>', 'dotresult.txt');
<       print $fh $dot;
<       close $fh;
359c356
<     <td>[% IF class.properties.size > 0 %]<font color="red">
---
>     <td><font color="red">
363c360
<     [%- END %]</font>[% END %]</td>
---
>     [%- END %]</font></td>
377c374
<     <td>[% IF class.methods.size > 0 %]<font color="red">
---
>     <td><font color="red">
381c378
<     [%- END %]</font>[% END %]</td>
---
>     [%- END %]</font></td>

結果

わりといい感じに見えますがメソッドと継承関係しか出してくれないことと、pngとかで出されても修正できないのであまりうれしくないかもしれません。
UML::Sequenceとあわせてこの辺がXMIで出力してくれたら便利なんですけどね。
誰か作ってくれないですかね。

[Perl]UMLシーケンス図の自動生成(UML::Sequence)

2006-12-14T17:07:00.000+09:00

UMLのシーケンス図を出力してくれるというので試してみました。

http://search.cpan.org/~philcrow/UML-Sequence/

インストールした環境は以下のとおりです。

CentOS 4.3

Perl 5.8.5（CentOS 4.3のデフォルト）

svgで出力するだけならGDが無くても大丈夫ですが、イメージにしたい場合はGDをインストールしておく必要があります。

まずこんなパッケージを作ってみます。

package Base;
sub new { bless {}, shift }
sub base_method {
    print "I am base\n";
    shift->protected_method();
}

package Foo;
our @ISA = qw(Base);

sub method_foo {
    print "method_foo called\n";
    shift->base_method;
};

sub protected_method {
    print "overrided\n";
}

package Hoge;
sub new { bless {} };

sub call_foo {
    my $foo = Foo->new();
    $foo->method_foo();
}

1;

つづいて起動ファイル

use Hoge;

my $h = Hoge->new();
$h->call_foo;

シーケンスを出力するためには、監視するメソッドの名前をパッケージ名つきでリストアップしておく必要があります。
listとしてこんな感じで作っておきます。

Base::new
Base::base_method
Foo::new
Foo::method_foo
Foo::protected_method
Hoge::new
Hoge::call_foo

これらを使ってシーケンス図を生成してみます。

まずはgenericseq.plコマンドでコールシーケンスをXMLファイル化します。

genericseq.pl UML::Sequence::PerlSeq list main.pl >sequence.xml

あとはこれをグラフィック形式に変換します。
SVGの場合はseq2svgを、jpegやpngの場合はseq2rast.plを使用します。

seq2svg.pl sequence.xml > sequence.svg

PNGに変換

seq2rast.pl -o sequence.png sequence.xml

画像タイプは拡張子で判断してくれるようです。

サンプル画像

とりあえずいい感じに出てはいますがリストを作らないといけないのが若干面倒な感じです。想像ですがこのリストからサブルーチンを置き換えてトレースできるようにしているためだと思われます。
パッケージが多くなってくると手動でリストを作るのはきついのでワンライナーあたりで生成するのが現実的でしょう。
サブルーチン呼び出しのグローバルフックみたいなのってないんですかね。

[Perl]useなしでどこでもDump(@INCにオブジェクトを格納するパターン）

2006-12-13T15:11:00.000+09:00

PERL HACKSを読んでいたら@INCにはhookが仕込めるということが書いてありました。

■[Perl]use無しでどこでも変数をダンプするpackage P;p

でも言及されているとおりかねてからuseがめんどうだと思っていたのですが、これを使えばうまくいくんじゃないか？ということでやってみました。

@INCの仕組み

http://perldoc.perl.org/functions/require.html

によると@INCにはCODEやオブジェクトを格納することができます。
これを利用するとモジュールロード前にhookを仕込むことができます。

There are three forms of hooks: subroutine references,
array references and blessed objects.

とあります。subroutine referencesが簡単ですがどーせならblessed objectsの方がということでこちらでやってみます。
オブジェクトの場合はINCというメソッドを定義するとモジュールをロードするたびにそのメソッドを呼び出してくれます。ただmainパッケージになってしまう（ここがよくわらかなかった）らしいのでパッケージ名をフル指定しないといけないようです。

package P;
use strict;
use YAML;

sub new {
  my $class = shift;
  return bless { modules => [ @_ ] }, $class;
}

sub import {
  my $class = shift;
  my (@modules) = @_;
  push @modules, split /[,\s]+/msx, $ENV{P} || q{};

  unshift @INC, P->new(@modules)
     unless (grep {ref $_ eq __PACKAGE__ } @INC);
  
}

sub p {
  my ($package, $file, $line) = caller();

  warn "[$file at line $line] " . YAML::Dump(@_);
}

sub P::INC {
  my ($self, $module) = @_;
  if (my @modules = @{$self->{modules}}) {
   return unless ( grep { $module =~ m|^$_| } @modules);
  }

  (my $mod_name = $module) =~ s|/|::|g;
  $mod_name =~ s|\.pm$||;

  no strict 'refs';
  *{"$mod_name\::p"} = \&p;
  return;
}

1;

こんな感じで実装してみました。

pを使う方

package PUser;
use strict;
use base 'Class::Accessor';

sub hoge {
  p "Hello Debug P";
  p { hoge => 'foo' }, "bar bar";
  warn "hoge called";
}

1;

起動ファイル(run_p.pl)

use strict;
use PUser;
PUser->hoge();

これで


perl -MP run_p.pl

とやると全てのパッケージでp関数が利用できます。

[JavaScript]JSONPでdel.icio.usのfeedを取得する

2006-12-06T12:23:00.000+09:00

JavaScript学習。JSONPを試してみました。

JSONPとはJavaScriptでのRemote Procedure Callの一種です。同様なものとしてXMLHttpRequestが一般的ですが、これはリクエストの送信先が同じドメイン内に限定されているのに対し、JSONPでは異なるドメインにリクエストを送信し、結果を受け取ることができます。
JSONPではscriptタグのsrc属性はドメインが限定されていないことを利用します。
リクエストを受け取ったサーバはレスポンスをJavaScriptの関数呼び出しの形式で返します。クライアントは側ではそれをscriptタグを使って読み込むとコードが関数呼び出しとして評価されるので、その関数を実装しておくことでサーバのレスポンスを処理できるという仕組みです。
例としてdel.icio.usを使ってみます。
以下にリクエストを投げると

http://del.icio.us/feeds/json/usuihiro?callback=handleResponse

handleResponse([{ .. }, ... ])

という形式でレスポンスが返されます。クライアント側はこのhandleRequest関数を定義しておき、引数から受け取ったデータを処理すればよいという仕組みです。

実装手順

まずsubmitボタンが押されるとsendJSONPが呼ばれるようにイベントハンドラを登録します。onSubmitでも充分なのですがここではprototype.jsを使用してみました。


function startup() {
Event.observe('form', 'submit', sendJSONP );
}

つづいてJSONPリクエストを送信するためのスクリプトタグを生成し、HTMLの要素に追加します。


var src = 'http://del.icio.us/feeds/json/'
 + user_name + '?callback=handleResponse';
var script = document.createElement("script");
script.setAttribute('type', 'text/javascript');
script.setAttribute('charset', 'utf-8');
script.setAttribute('src', src);
var head = document.getElementsByTagName('head').item(0);
head.appendChild(script);

最後にレスポンスを処理する関数を定義します。del.icio.usの場合はリクエスト送信時にcallbackパラメータで指定した名前の関数を呼び出す形でレスポンスが返されるので、その名前で関数を作成します。


function handleResponse(json) {
// ...
}

こんな感じで外部ドメインとのやり取りをJavaScriptで実現できます。

サンプルコード
以下のサンプルではアカウント名を入力してsubmitするとdel.icio.usのfeedsを取得して表示します。


<html><head>
<script language="JavaScript" src="lib/prototype-1.4.0.js" />
<script language="JavaScript">
<!--
function startup() {
Event.observe('form', 'submit', sendJSONP );
}

// JSONPの結果呼び出される関数
function handleResponse(json) {
var html = "";
if (json.length == 0) {
 var user_name = $F('user_name');
 alert("Feeds not found of " + user_name);
 return false;
}

json.each( function (elem) {
 var text = '<a href="' + elem["u"] + '">'
  + elem["d"] + '</a>';
 // タグがあれば追加する
 if ( elem["t"]　&& elem["t"].length > 0) {
  text += ' tags: (' + elem["t"].join(',') + ')';
 }
 html += "<li>" + text + "</li>\n";
} );
$("list_html").innerHTML = html;
return true;
}

// JSONPリクエストを送信。結果が関数呼び出し形式で返ってくるので
// それを評価させる為にscriptタグを生成する
function sendJSONP(e) {
var user_name = $F('user_name');
if (!user_name) {
 alert ('input user_name');
 return false;
}

// scriptタグの生成
var src = 'http://del.icio.us/feeds/json/'
  + user_name + '?callback=handleResponse';
var script = document.createElement("script");
script.setAttribute('type', 'text/javascript');
script.setAttribute('charset', 'utf-8');
script.setAttribute('src', src);
var head = document.getElementsByTagName('head').item(0);
head.appendChild(script);

 // これを呼ばないと通常のGETリクエストも送信されてしまう。
Event.stop(e); 
return false;
}
//-->
</script>
</head>
<body onload="startup()">
<h1>del.icio.usからJSONPを利用してfeedを取得します。</h1>
<form id="form" method="get">
 user_name: <input id="user_name" type="text" />
 <input type="submit" value="Get del.icio.us feeds"/>
</form>
<ul id="list" />
</body>
</html>

[Perl]例外をオブジェクトとして扱う

2006-11-30T15:07:00.000+09:00

例外をオブジェクトとして扱うと以下のような利点があります。

エラーの種類を正規表現ではなくオブジェクトの型で分けられる
オブジェクトに複雑な情報を付加できる

例外オブジェクトを扱うモジュールとしてErrorモジュールやException::Classが有りますが、そういったモジュールを使わなくてもPerl5.005以降ではdieにblessされたリファレンスが渡せるため、普通に例外オブジェクトが使えます。

たとえばこんな感じでエラークラスを定義しておくと

use strict;
package MyException;
use base 'Class::Accessor';
use overload qw{""} => \&as_string;
use Carp;
__PACKAGE__->mk_accessors(qw(description stacktrace associated));
sub new {
my $class = shift;
my $desc  = shift;
my @args  = @_;
unless ($desc =~ /\n\z/) {
        my $line = (caller($Carp::CarpLevel))[2];
        $desc .= " at line $line.";
}
my $self = $class->SUPER::new({ description => $desc, @args });

$self->stacktrace("$class".  Carp::longmess() );
return $self;
}
sub throw {
my $proto = shift;
my $desc  = shift;
die $proto if ref $proto;
local $Carp::CarpLevel = $Carp::CarpLevel + 1;

my $self = $proto->new($desc, @_);
die $self;
}

sub as_string {
my $self = shift;
return
qq{$self->{description}
------------------- stacktrace ---------------------
$self->{stacktrace}
};
}

package HogeException;
our @ISA = qw(MyException);

package SystemException;
our @ISA = qw(MyException);

以下のようにisaで判断して関連するオブジェクトを取り出したりできます。

#!/usr/local/bin/perl
use strict;
package App;
use MyException;
use Data::Dumper;

sub hoge_func {
 my $obj = { hoge => "@_" };
 HogeException->throw('normal throw', associated => $obj);
}

sub run {
 my $class = shift;
 eval {
         $class->hoge_func('hoge_func', @_);
 };
 if (my $err = $@) {
     print "#####\n$err#####\n"; # MyException->as_stringが呼ばれる
     if (UNIVERSAL::isa($err,'HogeException')) {
     # オブジェクトの型で処理を分岐。関連付けられている情報を取り出す
     print Dumper($err->associated);
   } else {
     die $err;
   }
 }
};

package main;
App->run('hoge');

実行結果


#####
normal throw at line 9.
------------------- stacktrace ---------------------
HogeException at die2.pl line 9
 App::hoge_func('App', 'hoge_func', 'hoge') called at die2.pl line 15
 eval {...} called at die2.pl line 14
 App::run('App', 'hoge') called at die2.pl line 29

#####
$VAR1 = {
   'hoge' => 'App hoge_func hoge'
 };

ただこのままだとモジュール内で普通にdieされているものはスタックトレースがでなかったりと不便なので、シグナルハンドラを使ってもうひと頑張りしてみます

local $SIG{__DIE__} = sub {
 if (ref $_[0] && $_[0]->isa('MyException') ) {
     $_[0]->throw;
 }
 else {
     # スタックトレースにここの呼び出しを含めないようにする
     local $Carp::CarpLevel = $Carp::CarpLevel + 1;
     SystemException->throw( join " ", @_ )
 };
};

これを設定しておくと普通にdieが使われている場所でも例外オブジェクトに変換されてスタックトレースが取れるようになります。
スタックトレースだけを考えたら

local $SIG{__DIE__} = \&Carp::confess

で充分だと思います。

[Perl]YAMLでblessさせる

2006-11-30T11:54:00.000+09:00

YAMLファイル内に!perl/packageというタグを記述することでファイルロード時に値をblessさせることができます。
例えばこんなかんじで

#!/usr/local/bin/perl
use strict;

package Model::Book;
use base 'Class::Accessor';

my @accessors = qw(author title publisher);
__PACKAGE__->mk_accessors(@accessors);

sub as_string {
 my $self = shift;
 return join "\n", map {"$_: " . $self->$_()} @accessors;
}

package main;
use YAML::Syck;
use Data::Dumper;

my $data = do { local $/; <DATA>};
my $yml = YAML::Syck::Load($data);

print Dumper($yml);
for my $model (@{$yml->{models}}) {
       print "############\n";
       print $model->as_string . "\n";
}

__END__
models:
  - !perl/Model::Book
      author: Damian Conway
      title: Perl Best Practice
      publisher: O'REILLY
  - !perl/Model::Book
      author: Larry Wall
      title: Programming Perl
      publisher: O'REILLY

としておくと


$VAR1 = {
         'models' => [
                       bless( {
                                'publisher' => 'O\'REILLY',
                                'title' => 'Perl Best Practice',
                                'author' => 'Damian Conway'
                              }, 'Model::Book' ),
                       bless( {
                                'publisher' => 'O\'REILLY',
                                'title' => 'Programming Perl',
                                'author' => 'Larry Wall'
                              }, 'Model::Book' )
                     ]
       };
############
author: Damian Conway
title: Perl Best Practice
publisher: O'REILLY
############
author: Larry Wall
title: Programming Perl
publisher: O'REILLY

のような結果になります。

これを使えば引数にオブジェクトをとるプラグインなんかも容易にYAMLでDIできるなぁと思ったのですが、以下のような問題が発覚しました。

newなどの初期化メソッドを一切呼んでくれない
単にblessするだけでuseすらしてくれない

これらのことから結局はなんらかのフレームワークに頼らないと上手く実現できなさそう。。。Rubyの場合はYAML for Rubyにもあるようにいろいろできるみたいですが、PerlのYAMLサポートはいまいち充分ではないようです。なんかやり方あるのかなぁ。。。

[Perl]Time::Piece::localime + ONE_YEARで小ハマリ

2006-11-30T11:50:00.000+09:00

http://d.hatena.ne.jp/usuihiro1978/20061117
から移動。

Time::PieceとTime::Secondsを使って日付の比較を行うときに以下のようなコードを書いていて小ハマリしました。


use Time::Piece;
use Time::Seconds;

if ($t1 >localtime + ONE_YEAR) {
   # コード
} else {
   # コード
}

上記コードでの


localtime + ONE_YEAR

は


localtime( + ONE_YEAR)

となってしまいます。
よって


localtime() + ONE_YEAR

と書かないとだめ。

localtimeがプロトタイプ宣言で


sub localtime ()

となっていれば()つけなくても大丈夫なわけですが、引数を渡せる為そうはなっていません。
こういう関数に引数を渡さないときは明示的に()をつけておいたほうがよさそうですね。

[Perl]無限ループを書く最も簡単な方法？

2006-11-30T11:48:00.001+09:00

普通無限ループといったら


while(1){
   # なんらかの処理
}

といった形で書くと思います。
しかしPerlプログラマは怠惰です。一文字でも多くタイプするのを好まないでしょう。1をタイプするのが面倒なので次のように書きましょう。


while(){
   # なんらかの処理
}

これで見事に無限ループしてくれます。

尚、当然ですが以下のように明らかに偽と評価されるものだとループに入りません。


while(undef){
   # なんらかの処理
}

while(''){
   # なんらかの処理
}

while(()){
   # なんらかの処理
}

while(0){
   # なんらかの処理
}

残念なのは後置にすると無限ループしないところです。これができれば更にタイプ量が減ってうれしいのですが。


print "hello." while();

きっと役に立たない知識ですね。。。（というより紛らわしいので迷惑です）
Perlがどう解釈しているのかさっぱりわからない。。。

[Perl]myと後置ifでstatic変数が作れる？

2006-11-22T12:28:00.001+09:00

myと後置ifでstatic変数のような動きになるけどこれは仕様上想定内の動きなのだろうか？


use strict;
sub counter {
  my $cnt if (0);
  ++$cnt;
}

print (counter() . "\n") for (1..3);

実行結果


1
2
3

はじめに

2006-10-31T14:12:00.001+09:00

プログラミング関連のこととか書いていきます。多分。