May 2008 Archives

Mooseに入門してみたよ

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

はじめまして、市川(ichikaway)です。

最近、Moose, MooseというキーワードがPerlな人たちから聞こえてきたので、Mooseに興味を持ちました。

とりあえず入門してみたので、簡単に書いておきます。

Mooseって何?

Perl5のための現代的なオブジェクトシステムで、Perl5で手軽にオブジェクト指向プログラミングができるパッケージです。

詳細は下記を参照

http://okilab.jp/project/document/japanate/perldoc/html/Moose-0.12/Moose.htm

Mooseのインストール

cpanコマンドを実行してインストール

cpan

>install Moose

今までのPerl5でのオブジェクト指向プログラミング(OOP)

Mooseの話をする前に、今までPerl5ではどのようにOOPがされてたのでしょうか。

簡単な例です。


use strict;
use warnings;

package hogeclass;

sub new {
    my $class = shift;
    my $self = {
        moji => shift,
    };
    return bless $self, $class;
}

#setter,getter method
sub moji {
    my $self = shift;
    if(@_){
        $self->{moji} = shift;
    }
    else{
        $self->{moji};
    }
}

package Main;

my $inst = new hogeclass('hogehoge');
print $inst->moji . "¥n";

$inst->moji('fuga');
print $inst->moji . "¥n";

Package Mainの中でhogeclassのインスタンスをnewで生成しています。

その際に、変数 mojiにhogehogeという文字列をセットしています。


Setter, Getterメソッドとして sub mojiというサブルーチンを用いています。

$inst->mojiで値を取得し、$inst->moji('fuga')で値をセットしています。


このようにnewやらセッター、ゲッターメソッドを毎回実装するのは面倒ですし、

変数にintなどの型を持たせたくなるとそれも実装しなくちゃいけなくて、萎えてしまいます。

Mooseで楽できるよ

Mooseを使うと、下記のように書けます。

package hogeclass;
use Moose;

has 'moji' => (isa => 'Str', is => 'rw');

package Main;

my $inst = hogeclass->new(moji => 'hogehoge');
print $inst->moji . "¥n";

$inst->moji('fuga');
print $inst->moji . "¥n";

mooseですと、型の定義もできます。今回はmoji変数をStr型にしています。


では、今度はmojiの型をIntにしてみましょう。

has 'moji' => (isa => 'Str', is => 'rw');

has 'moji' => (isa => 'Int', is => 'rw');

に書き換えるだけです。


実行すると、

Attribute (moji) does not pass the type constraint

というエラーが出ます。

では、文字列を与えている箇所を数字に変えてみます

my $inst = hogeclass->new(moji => 10001);

にすると、今度は下記の箇所

$inst->moji('fuga');

でも文字列を与えているのでエラーが出ます。

ここも下記のように変更

$inst->moji(9999);

これで問題なし。このようにして、クラスを利用する際に型の制約を持たせることができました。


それ以外にも、

has 'moji' => (isa => 'Int', is => 'rw');

のrwを下記のようにroにするとリードオンリとなり、参照のみしかできません。

has 'moji' => (isa => 'Int', is => 'ro');

リードオンリにして値を

$inst->moji(9999);

のようにセットすると下記のエラーが出るようになります。

Cannot assign a value to a read-only accessor

最後に

今回は、Mooseの触りのところを書きました。

Mooseには様々な機能がありますので、興味を持った方はCookBookなどを参照すると良いかと思います。

http://search.cpan.org/~stevan/Moose-0.48/lib/Moose/Cookbook.pod

追記

ちょっと前にMooseに関して調べてた時は、Moose入門みたいな記事が見つからなかったので今回の記事を書いたのですが、よく調べたら色々とありましたので紹介させて頂きます。


はこべにっき#

 Kansai.pmで発表されたMooseのPPTがあります

 http://d.hatena.ne.jp/hakobe932/20080531/1212255159


初めてのMoose - Mooseのすすめ

 http://d.hatena.ne.jp/hide-K/20080527/1211880701

muxtapeのタイトルをRSSから取得する

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

まめこさんが「Web::Scraperを使ってmuxtapeのタイトルを取得する?」というエントリーを投稿しましたね。

http://perl-mongers.org/2008/05/webscrapermuxtape.html


おそらく Web::Scraper の勉強のために、ページをスクレイピングしてますが、

muxtape は RSSフィードを吐いているため RSS をパースすればもっとシンプルに記述できます。


今回は

  • XML::Feed
  • XML::RSS
  • WebService::Simple

の3つのモジュールをそれぞれ使って、タイトルを print するサンプルコードを書いてみました。なんか まめこさんのmuxtapeだと日本語が文字化けているので asano さんの muxtape から取得してみます。

XML::Feed 版
use strict;
use warnings;
use XML::Feed;

my $user = $ARGV[0] || "asano";
my $feed = XML::Feed->parse( URI->new("http://$user.muxtape.com/rss") );
for my $entry ( $feed->entries ) {
    print $entry->title . "\n";
}

XML::RSS 版
use strict;
use warnings;
use XML::RSS;
use LWP::Simple;

my $user    = $ARGV[0] || "asano";
my $content = get("http://$user.muxtape.com/rss");
my $rss     = XML::RSS->new;
$rss->parse($content);
foreach my $item ( @{ $rss->{items} } ) {
    print $item->{title} . "\n";
}

WebService::Simple 版
use strict;
use warnings;
use WebService::Simple;

my $user = $ARGV[0] || "asano";
my $ws  = WebService::Simple->new( base_url => "http://$user.muxtape.com/rss" );
my $res = $ws->get;
my $ref = $res->parse_response;
foreach my $item ( @{ $ref->{channel}->{item} } ) {
    print $item->{title} . "\n";
}

他にもRSSもしくはXMLのパーサーのモジュールがあるので、他にもやり方がいろいろありますね。用途にもよりますが個人的には、XML::Feed を使うのがいいのかなと思います。皆さんはどんな感じでしょうかね。これまたツッコミ歓迎です!

実用! Perlで法律改正日を調べる

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

Perlを実務で役に立てようと思ったら、やんなきゃいけないのは、つらい事務仕事をいかに楽にできるか、ていうことだと思います。というわけで、法令遵守確認の第一歩、法律改正日をチェックするスクリプトです。

法令データ提供システム [law.e-gov.go.jp] で出てくる法律のページが対象です。

Filename: law_test.pl

#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use Encode;
use LWP::Simple;
use DateTime::Format::Japanese;
 
my $url  = 'http://law.e-gov.go.jp/htmldata/H05/H05HO091.html';
my $html = get_html( $url );
my $dt   = parse_date( $html );
print "$dt\n";
exit;
 
sub get_html {
  my $uri = shift;
  my $res = get( $uri );
  return decode( 'cp932', $res);
}
 
sub parse_date {
  my $html = shift;
  (my $date = $html) =~ s/^.+最終改正:(.+?日).+$/$1/s;
  my $dt = DateTime::Format::Japanese->parse_datetime( $date );
  return $dt;
}
実行結果:
$ perl law_test.pl 
2007-06-13T00:00:00
$ 
ポイントは、DateTime::Format::Japaneseというモジュールで、法令ページの和暦漢数字の日付文字列をパースしていることです。

~~~

このままじゃあんまり役に立ちませんから、ちょっと工夫して、法令掲載URLのリストを渡して、巡回させます。

Filename: law_check.pl

#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use Encode;
use LWP::Simple;
use DateTime::Format::Japanese;
 
my @urls = (
  'http://law.e-gov.go.jp/htmldata/H05/H05HO091.html',
  'http://law.e-gov.go.jp/htmldata/H09/H09HO081.html',
  'http://law.e-gov.go.jp/htmldata/H14/H14HO103.html',
);
 
my $fmt = DateTime::Format::Japanese->new(
  number_format => 2,
);
 
foreach my $url (@urls) {
  my $html = get_html( $url );
  my $dt   = parse_date( $html );
  my $str  = ($dt)?$fmt->format_ymd($dt):q();
  print "$url\t$str\n";
}
 
exit;
 
 
sub get_html {
  my $uri = shift;
  my $res = get( $uri );
  return decode( 'cp932', $res);
}
 
sub parse_date {
  my $html = shift;
  my $dt;
  if ( $html =~m/^.+最終改正:(.+?日).+$/m ) {
    my $date = $1;
    $dt = DateTime::Format::Japanese->parse_datetime( $date );
  }
  return $dt;
}
実行結果:
$ perl law_check.pl 
http://law.e-gov.go.jp/htmldata/H05/H05HO091.html       平成19年6月13日
http://law.e-gov.go.jp/htmldata/H09/H09HO081.html       平成19年3月31日
http://law.e-gov.go.jp/htmldata/H14/H14HO103.html       平成19年7月6日
$ 
これで今度から楽できますね! こんな業務しているPerl使いがどのぐらいいるか知りませんけれども!

初出はM.C.P.C.: 法律改正日を確かめるPerlスクリプト [blog.dtpwiki.jp] です。

Web::Scraperを使ってmuxtapeのタイトルを取得する?

| 2 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

perl初心者のまめこです

こんなに場違いなところで記事を書くのは初めてです!


tomyheroからの課題で muxtapeのタイトルを取得して表示させるスクリプトを書いてみましたー。ほげほげ。

正解コードはこちら

#!/usr/local/bin/perl

use strict;
use Web::Scraper;
use LWP::UserAgent;
use Perl6::Say;
use Data::Dump;

my $user = $ARGV[0] || 'woopsdez' ;
my $web = scraper{
        process '//div[@class="name"]',
                'titles[]' => 'TEXT',
};

my $ua = LWP::UserAgent->new( agent =>'Mozilla/5.0 (Macintoch; U; Intel Mac OS X; ja-JP-mac; rv:1.8.1.14) Gecko/20080404 Firefox/2.0.0.14' );
$web->user_agent( $ua );
my $response = $web->scrape( URI->new( "http://$user.muxtape.com/") );

for my $title ( @{$response->{titles}} ){
        say $title;
}

まめの書いた間違いコードはこちら

#!/usr/local/bin/perl

use strict;
use Web::Scraper;
use URI;
use Perl6::Say;
use Data::Dump;

my $scraper = scraper {
        process '#onge5ad938d2abd7574eb1900542c5a4a21 .name','title' => 'TEXT';
};

my $uri = new URI('http://woopsdez.muxtape.com/');

my $res = $scraper->scrape($uri);

say dump($res->{title});

print $res->{title};

参考にしたところ

use Web::Scraper; - 今日のCPANモジュール

つまづいたところ

Web::Scraperっていうので

process ' cssのid or class名 ' , '自分の好きな名前' => 'TEXT';

ってやれば$scraperに指定したidやclassの中身のテキストが取得出来るんだー。と簡単に考えてたけど上手く取得出来てないみたいですた。

dumpをしてみても[Abort trap]って出るばかり。なんだったんだろう。


先生の言うとおり書いてみたら動いた!

試しに書きかえてFlickrの写真タイトルを取得しようとやってみたけど失敗しました。


むー。(´・ω・`)


次はyusukebeさんが作ったWebService::Simple;でやってみたいと思うます!

Catalyst からのメール送信

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

Catalyst::View::Email と Catalyst::Plugin::Email のどちらがいいのかというと、View::Email の方がいいって mst がいってた。


View::Email の方つかわないとDIS られるから要注意だお ><

Acme::Oppaiで学ぶメソッドチェイン

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

CPANにはSex-0.69をはじめとしてセクシャルなモジュールがいくつかありますが、今回はAcme::Oppaiを紹介します。

http://search.cpan.org/~yappo/Acme-Oppai-0.03/lib/Acme/Oppai.pm

print Acme::Oppai->Oppai->Oppai->Oppai;

と書くとOppaiメソッドをつなげた数だけ

    _  ∩
  ( ゜∀゜)彡 おっぱい!おっぱい!
  (  ⊂彡
   |   | 
   し ⌒J

と腕を振ってくれます。


ただ腕を振るだけでは無くてOppaiを一回呼ぶと

$ perl -MAcme::Oppai -e 'print Acme::Oppai->Oppai'
    _  ∩
  ( ゜∀゜)彡 おっぱい!おっぱい!
  (  ⊂彡
   |   | 
   し ⌒J

2回で

$ perl -MAcme::Oppai -e 'print Acme::Oppai->Oppai->Oppai'
    _  ∩
  ( ゜∀゜)彡 おっぱい!おっぱい!
  (    | 
   |   | 
   し ⌒J
    _  
  ( ゜∀゜)  おっぱい!
  (  ⊂彡
   |   | 
   し ⌒J
$ perl -MAcme::Oppai -e 'print Acme::Oppai->Oppai->Oppai->Oppai'
    _  ∩
  ( ゜∀゜)彡 おっぱい!おっぱい!
  (    | 
   |   | 
   し ⌒J
    _  
  ( ゜∀゜)  おっぱい!
  (  ⊂彡
   |   | 
   し ⌒J
    _  ∩
  ( ゜∀゜)彡 おっぱい!
  (    | 
   |   | 
   し ⌒J

と4回め移行は交互に腕を上げ下げします。


ここまでは普通に

sub hoge {
    my $self = shift;
    push @{ $self->{stack} }, 'up';
}

みたいなコードでスタックしてけばいいだけですが

こんなコードだと出力が出来ません。


そこでoverloadです。

http://search.cpan.org/src/YAPPO/Acme-Oppai-0.03/lib/Acme/Oppai.pm

の use overload してるとこ見ると分かりますが文字列として評価してほしくなったときにstackされたおっぱい内容をAAに再構築してあげてかえしています。


ね、簡単でしょ?

Mail::Sendmail でメール送信

| 1 Comment | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

こんばんは。さっき小さな虫が髪の毛の中に侵入してきて、いつのまにか住処にされたっぽい yusukebe です。さて、今日はとあるアプリの実装で「メール送信」の機能を書いていたので、それを踏まえPerlから簡単に「メールを送信」するスクリプトを紹介します。


メール関係のモジュールはCPANに山ほど登録されていてどれを使えばわけわかめです。今回は「メールの機能は送信のみが欲しい」という目的の元、一番使われてそうで扱いやすいようなモジュールを利用することしました。そのモジュールは Mail::Sendmail という 任意の smtp サーバを経由してメールを送信するモジュールです(ソース見ずにsendmailコマンドをたたくものだと思っていました>< コメントありがとうございます)


http://search.cpan.org/dist/Mail-Sendmail/


今改めて確認したのですが、Mail-Sendmail-0.79 ではテストが「277 PASS」という状態なので信頼できそうですね。


まず、メール送信で注意したいのはタイトルと本文の文字コードです。最近は utf8 のメールもメーラーなどで扱えるようになってきましたが、それでもまだ日本の場合「iso-2022-jp」が主流です。よって、日本語のタイトルと本文を扱う場合「iso-2022-jp」にしてしまいましょう。


今回はタイトルと本文に関して、ソースに直接、utf8 の文字を記述しています。それを「iso-2022-jp」に変換するのに、Encode モジュールの encode メソッドを使っています。

  • さらにはてぶで、メールのSubjectはMIMEエンコーディングするべきということを指摘いただきました。ありがとうございます。以下修正したコードです。
use Encode;
use utf8;

$subject = encode("MIME-Header-ISO_2022_JP", $subject);
$message = encode("iso-2022-jp", $message);

さてそうしたら準備完了です。Mail::Sendmail の sendmail メソッドに送りたいメールの情報をハッシュで渡して実行すれば、メールが送られます。ここでのポイントは Content-Type で charset を iso-2022-jp にしておくことです(デフォルトは iso-8859-1 )。

my %mail = (
    "Content-Type" => 'text/plain; charset="iso-2022-jp"',
    To             => 'to@example.com',
    From           => 'from@example.com',
    Subject        => $subject,
    Message        => $message,
);

sendmail(%mail);

メーラーで確認をとるとうまく届いています。 日本語も文字化け無しです。

全てのコードはこんな具合です。

#/usr/bin/perl

use strict;
use warnings;
use Mail::Sendmail;
use Encode;
use utf8;

my $subject = "テスト";
my $message = "テストです。ほげほげ。";

$subject = encode("MIME-Header-ISO_2022_JP", $subject);
$message = encode("iso-2022-jp", $message);

my %mail = (
    "Content-Type" => 'text/plain; charset="iso-2022-jp"',
    To             => 'to@example.com',
    From           => 'from@example.com',
    Subject        => $subject,
    Message        => $message,
);

sendmail(%mail);

Mail::Sendmail の詳しい使い方は POD を参考にしてください。

以上、今回はそんなに「悪くない」 Perl をスクリプトを紹介しました。

何かツッコミ、要望あれば、受け付けております。

++しようぜ!

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

なんかIRCとか使ってるとみんなよく++するよね!

tomyhero++とか。あ、tomyheroはデクリメントされてる事が多いけど。


さて、perlでのインクリメント(++)についておもしろいのを紹介するよ!

my $cnt = 0;
$cnt++;
$cnt++;
$cnt++;

print $cnt;  #=> 3

ま、これは普通だよね!つまりインクリメントは数値が入ってる変数については+1される感じ。


じゃあこれはどうだろう!

my $str = 'a';
$str++;
$str++;
$str++;

print $str;  #=> ・・・・?

'a' に3回++してみたよ!どうなるかな?


じゃあまず、答えを発表する前にこんなことやってみる!

my $str = 'a';

print $str + 3;  #=> 3

my $str2 = 'a';
$str2 += 3;
print $str2;     #=> 3

これだと3になる。perlってその場の空気で変数の中身を数値として扱ったり文字として扱ったり・・・まぁ変な^H^Hおもろい言語なんだけど、通常文字列を数値として扱う場面では0って扱う。


じゃ、インクリメント3回でも3になりそうなのに、実は『 'a' 』を3回インクリメントすると『 'd' 』になっちゃうんだ!おもしろいね!

my $str = 'a';
$str++;    #=> 'b'
$str++;    #=> 'c'
$str++;    #=> 'd'

# 略
$str++;    #=> 'z'
$str++;    #=> 'aa'

こんな感じにa, b, c, d, e, ・・・・ zっと続き、その次はなんと2文字!『 aa 』になるんだ!


じゃ、'a'を 285075回++すると・・・・?

my $str = 'a';
$str++ for (1..285075);

print $str;  #=> ・・・・?

答えは自分でやってみてね!

良い子のお約束。use strict;

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

こんばんは!みんな! use strict; してるかい?

use strict; ってなに?

perlがあまりにも自由に書けすぎちゃうんで、ある程度マナーを守ることを強要してくれるモジュールだよ。

得すること

スペル間違いがあると、エラーになる!


use strict;

my $foo = 'foo';
print $fooo ; # エラー

つまり、宣言していないメソッドがあると、エラーにしてくれるよ!

もう一つの使い方

use strict;と書くたびに、今日も僕達を見守ってくれてあがとう、間違いを指摘してくれてありがとうと、感謝するために心を込めてタイプするんだよ。この魔法の行をタイプするだけで、心が落ち着いて、よし、良いコード書くぞ!そういう気持ちになるはずだよ。


use strict;がもし、デフォルトでONだったら、感謝の気持ちを忘れちゃうからね。ウンウン。デフォルトでonじゃなくて、本当によかったよ。

参照

cpan

最後に

他にも、色々な特典があるんだけど、多分他のもっと詳しい方が書いてくれると思うよ!もしくは、そこのあなた、なにか知ってたら書いて教えてください!

YourFileHost の flv を WWW::YourFileHost を使って簡単にダウンロード

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

こんばんは。インプラントの手術を1ヶ月後に控えている yusukebe です。今回も「悪い」ダウンロード系スクリプトの紹介をします。題材は、みんな大好き YourFileHost の flv の動画を簡単にゲットしてしまおうというものです。よい子は真似しないでね。


実はわたくし、某サイトを作るときに必要になり YourFileHost の API をたたくモジュール「WWW::YourFileHost」を作成しました。


http://search.cpan.org/dist/WWW-YourFileHost/


このモジュールを使うと指定したURLの flv 動画ファイルへのパスを簡単に見つけることができます。その URL を以前の記事でも扱った LWP::UserAgent を使いファイルに保存するよう指定し完成です。大体10行ちょいで書けました。

use strict;
use warnings;
use LWP::UserAgent;
use WWW::YourFileHost;

my $url =
    $ARGV[0] ||
    "http://www.yourfilehost.com/media.php?cat=video&file=guns_dont_kill_people.flv";
my $ua = LWP::UserAgent->new( agent => "WWW::YourFileHost" );
my $response = WWW::YourFileHost->new( url => $url , ua => $ua );
$ua->get( $response->video_id, ":content_file" => $response->id . ".flv" );

こんな感じで実行します。あ、繰り返しになりますが、よい子は真似しないでね。

perl fetch.pl "http://www.yourfilehost.com/media.php?cat=video&file=080128.4_exo_part001.wmv"

WWW::YourFileHost では動画のページをスクレイピングして、裏APIへのURLを解析しています。スクレイピングには Web::Scraper というとってもクールで便利なモジュールを使用しています。Web::Scraper のことをもっと知りたい方はとみたさんが詳しい記事を書いてくれているので、そちらを参照してみてください


http://e8y.net/mag/013-web-scraper/


あ、そうそう、WWW::YourFileHost は CPAN モジュールになっているので、

sudo -H cpan 

とCPANシェルを起動し

install WWW::YourFileHost

とすればインストールができます(sudo 権限があれば。CPANシェルについて誰か解説してー)。


このようによく使う処理やデータはモジュールにすると再利用ができて便利な上、いろんな方に使ってもらえます。モジュールの書き方、CPANへのアップロード方法などは、今後このページで紹介されるでしょう。というわけで Enjoy!

Text::Vim-Colorを使えなくてもText::HatenaでSuperPreを使う

| 0 Comments | 1 TrackBack | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

こんにちわ。自分のブログでtypoしまくりのmattnです。


tokuhirom氏がApp::Chariotをリリースしたので、さっそく動かしてみましたが結構使い勝手は良くて色々と弄ってます。

App::ChariotにはFormatterとしてHatena(Text::Hatena)と、Markdown(Text::Markdown)が選べるのですが、Text::Hatenaの最大の魅力と言えばやはりソースコードハイライトが出来るスーパーpre記法だと思います。

ただし、Text::Hatenaのversion0.16頃まではText::Vim-Colorを使ったシンタックスハイライトが動いていましたがversion0.20では無くなってしまいました。かつ、vimをサーバで動かせない人もいるかと思います。そこで今日はText::Hatenaを若干弄ってソースハイライトする仕組みをご紹介したいと思います。


まず、Text::Hatenaに各言語のハイライト処理を入れるのは間違いなく脳が爆発してしまいますので、ここはクライアント側にハイライトさせるべくjavascriptライブラリを使用したいと思います。

著名な所では

が有名かと思います。今日はどちらでも対応出来る様にしたいと思います。

まず、現状スーパーpre記法でもpre記法と変らないpreタグを取得するText::Hatenaを触ります。

--- lib/Text/Hatena.pm.orig	Wed May 28 15:27:34 2008
+++ lib/Text/Hatena.pm	Wed May 28 15:04:04 2008
@@ -209,9 +209,11 @@
 sub super_pre {
     my $class = shift;
     my $items = shift->{items};
-    my $filter = $1 || ''; # todo
+    my $item = $items->[0] or return;
+    $item =~ s/^.*?>|(\w+)|$/$1/;
+    my $filter = $1 || $item;
     my $texts = $class->expand($items->[1]);
-    return "<pre>\n$texts</pre>\n";
+    return "<pre name=\"code\" class=\"$filter\">\n$texts</pre>\n";
 }
 
 sub pre {

何をしているかと言うと、syntaxhighlighterが扱える形式は属性「name」に"code"という値、かつ属性「class」に言語名という形式になりますので、スーパーpre記法のハイライト指定

>|perl|

で指定されたperlをclass属性に、name属性に"code"を埋め込む修正となっています。

あとはこれを使って

use strict;
use Text::Hatena;

Text::Hatena->parse($text);

とすればsyntaxhighlighter向けのコードが出力されます。

さてクライアント側ですが、syntaxhighlighterの場合はCSSとjavascriptをHTMLに付け加え

<script type="text/javascript"><!--
dp.SyntaxHighlighter.HighlightAll('code');
--></script>

とすればokです。またgoogle-code-prettifyの場合は

<script type="text/javascript"><!--
  (function(onload){ // load 
  	if (window.addEventListener) {
  		window.addEventListener('load', onload, false);
  	} else if (window.attachEvent){
  		window.attachEvent('onload',  onload, false);
  	} else {
  		window.onload = onload;
  	}
  })(function(){
  	if (typeof prettyPrint === 'function') {
  		var pre = document.getElementsByTagName('pre');
  		for (var n = 0; n < pre.length; n++) {
  			if (pre[n].getAttribute('name') === 'code') {
  				var classNames = pre[n].className;
  				classNames = classNames ? classNames.split(/\s/) : [];
  				classNames.push('prettyprint');
  				pre[n].className = classNames.join(' ');
  			}
  		}
  		prettyPrint();
  	}
  });
--></script>

のコードをヘッダ部に入れればそれだけでok。google-code-prettifyの場合は言語名を指定しなくても良いのです(コレデイイノダ)。

見事サーバでvimを動かさないText::Hatenaを使い、スーパーpre記法が実現出来ました。


以下App::Chariotの実行結果。

http://perl-mongers.org/2008/05/28/syntaxhighlight-with-text-hatena/app-chariot-text-hatena-thumb-400x560.png

鯖でvim動かすなんてXXXって人向けですね。

追記

ちなみにこの例で使ったChangeLogは以下

2008-05-27  mattn <mattn.jp at gmail dot com>

	* yahoo-text-conversion.pl: Convert Japanese Sentence by Yahoo API.

	*perl-mongers.orgに記事を書いた
	>|perl|
	use strict;
	use warnings;
	use Encode;
	use WebService::Simple;
	use YAML::Syck;

	if ($^O eq 'MSWin32') {
		binmode(STDERR, ':encoding(shift_jis)');
		Encode::from_to($ARGV[0], 'cp932', 'utf-8');
	}

	my $yahoo = WebService::Simple->new(
		base_url => "http://jlp.yahooapis.jp/JIMService/V1/conversion",
		params   => { appid => "YahooDemo", }
	);

	my $response = $yahoo->get( { sentence => $ARGV[0] || 'となりのきゃくはよくかきくうきゃくだ。' } );
	warn Dump $response->parse_response->{Result};
	||<

	* simple.c: 後で書く

	>|
	書かないな、きっと
	|<

WebService::SimpleでYahoo!の「かな漢字変換Webサービス」を使ってみる

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

こんにちわ。IMEの使いすぎで、どんどん頭が悪くなっているmattnです。

Yahoo!から昔なつかしIME(その頃はFEPと呼んだか)、「VJE」を使ったWebサービスが公開されたようです。


ヤフー、かな漢字変換Webサービスを公開--MS-DOS時代に全盛の「VJE」をAPI化:ニュース - CNET Japan

ヤフーは5月27日、「Yahoo!デベロッパーネットワーク」で「かな漢字変換Webサービス」を公開した。

Yahoo!デベロッパーネットワーク - テキスト解析 - かな漢字変換

ローマ字、ひらがなの文を文節に区切り、変換候補を提示します。短い文字列から変換候補を推測するモードも提供します。VJEと同じ方式のかな漢字変換です。

今日はこのWebサービスをperlから呼び出すサンプルを書いてみたいと思います。使うモジュールはご存知WebService::Simpleです。

WebService::SimpleはWebアプリケーションへの問い合わせや応答を透過的に扱えるモジュールでゆーすけべー氏の処女作として有名です。現在ではCodeReposの有識者の方々により更なる拡張も行われています。

早速コードです。

上記リンクにもある通り、このAPIではsentenceというパラメータを受け取ります。通常だとこのパラメータをURI::query_formでクエリとして作成し、LWPでリクエストを送り、結果をXMLパーサで解析するという流れになるのですがWebService::Simpleはこの流れに特化したWebServiceを扱いやすいモジュールになっています。

use WebService::Simple;
my $yahoo = WebService::Simple->new(
    base_url => "http://jlp.yahooapis.jp/JIMService/V1/conversion",
    params   => { appid => "YahooDemo", }
);

これだけでリクエストを送信する準備は整いました。以下がリクエストの送信。

my $response = $yahoo->get( { sentence => $value } );
warn Dump $response->parse_response->{Result};

通常はXML::Simpleを使ったXMLパースが行われますが、パーサとしてJSON、XML(XML::LibXML、XML::Parser::Lite::Tree::XPath)を選ぶ事も出来ます。

(XML::TreePPを使うパーサもあるようですね)

上記WebService::Simpleインスタンスを使って何度でも(API制限の許す限り)簡単にリクエストを送信できるのです。

便利ですね。一通り動く物としては以下の様な形になります。

use strict;
use warnings;
use Encode;
use WebService::Simple;
use YAML::Syck;

if ($^O eq 'MSWin32') {
	binmode(STDERR, ':encoding(shift_jis)');
	Encode::from_to($ARGV[0], 'cp932', 'utf-8');
}

my $yahoo = WebService::Simple->new(
    base_url => "http://jlp.yahooapis.jp/JIMService/V1/conversion",
    params   => { appid => "YahooDemo", }
);

my $response = $yahoo->get( { sentence => $ARGV[0] || 'となりのきゃくはよくかきくうきゃくだ。' } );
warn Dump $response->parse_response->{Result};

結果は

--- 
SegmentList: 
  Segment: 
    - 
      CandidateList: 
        Candidate: 
          - 隣の
          - 隣りの
          - となりの
          - 戸なりの
          - 都なりの
          - 徒なりの
          - 途なりの
          - 斗なりの
          - 外なりの
          - 杜なりの
      SegmentText: となりの
    - 
       ... snip ...

こんな感じ。

たった十数行でここまで書けるWebService::Simple、便利ですね。


このAPIを使ったWebのIMEを作ってみても面白いかもしれませんね(あ、どこかにあったな)。

opendirとglobとFile::Find::Rule

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

ログファイルを処理したいとかで、とあるディレクトリのファイル一覧がほしいときってありますよね!そんなときのための三題話。

opendir

入門書には必ず載ってるopendir。使い方は簡単。ディレクトリ名を入れて開くだけ。あとはopenと同じように開いたハンドルを読み出していくだけ!

opendir(DIR, $dname);
while (defined($fname = readdir(DIR))) {
    print "$fname\n";
}
closedir(DIR);

実行したら、'.' (現在のディレクトリ)とか '..' (ひとつ上のディレクトリ)とかも入ってくるけど、単純に一覧がほしいときは簡単だね!

glob

opendirだととってくるファイル名は何も決められなかったけど、globを使ったら指定できるようになるよ!

たとえば、'accesslog*'ってのに当てはまるものだけがほしいときは

@fnames = glob("$dname/accesslog*");

とやれば配列に入ってくるよ。正規表現チックだけどシェルで'ls'とかやるときの表現なので注意が必要だね。でも、単純だけど便利だよね!

globの中にはスペース区切りでいくつでも指定できるし、シェルで機能する"*.{bz2,gz}"とかも使えるけど、マッチ指定のない文字列を入れたらそれもかえってくるので注意が必要だよ!

% perl -e 'my @temp = glob("*.{bz2,gz} x"); print join("\n", @temp) . "\n";'
wordpress-2.2.1.tar.gz
wp-2.3.2.tar.gz
wp-2.5.1.tar.gz
x
% ls x
ls: x: No such file or directory

File::Find::Rule

最後にモジュールを使ってみるよ!これまでより無駄に高機能だし、OSによってディレクトリの区切りが違う(Winは'\'、Unixは'/'、Macは':'とか)のを気にせず使えるよ!

use File::Find::Rule;
my $rule =  File::Find::Rule->new;
$rule->file; # ファイルであるものを指定
$rule->name( '*.pm' ); # *.pmにマッチするもののみ
my @files = $rule->in( @INC );

これだけで、*.pmってファイルだけが配列でかえってくるよ!

条件を追加するときは'$rule->xxxx'の行を増やしていくだけだよ。たいていのファイルテスト演算子は->readableとかであるし、サイズ指定(->size())もあるし、->maxdepth()とか->mindepth()とかでディレクトリの深さも指定できるよ! File::Find::Ruleのオブジェクトをand/orできるから、複雑な条件でも対応できるよ!

my $rule = File::Find::Rule
$rule->any(
    File::Find::Rule->name('*.pm'), 
    File::Find::Rule->size('<10k'),
    File::Find::Rule->maxdepth(5)
);

・・・・・でも、だいぶ遅い。普通のときは、無名関数とか関数へのリファレンスが必要だけどFile::Findを使えばいいと思うよ!こっちは標準モジュールだしね!(ファイル数が多いと遅いけど。。。)

もっとも、この系統のモジュール、File::Finderとかいろいろあるけど、何が一番いいんだろう。

TYPO - スペルミス

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

スペル間違いが多いことで有名なtomyheroです。


少し前まで、すべてのSYNOPSIS を SYNOPSYS と書いていました。

酷いですね。ひど過ぎますね。今日は、その問題を同解決したかを書きたいと思います。

テスト化のきっかけ

で、どうしたものかと、woremacxさんのircチャンネルでつぶやいたところ、otsuneさんに、「plaggerで使ってる、Test::Spelling を使ってはどうか?」と教えてもらいました。

ktkr

テストスクリプト配備

ということで、spelling.t というのをモジュールに配備して、スペルをなおしました!やった!


 例 http://search.cpan.org/src/TOMYHERO/Acme-PSON-0.03/t/spelling.t


ほとんどのモジュールに配備して、スペルを直したぜ!

ところが

.... CPANのtesterからアホみたいにspelling testエラーが届くようになりました。 T_T これは... testerが持ってる辞書が違うので、こけまくっちゃうんですね。ひどいですね。

考えた

spelling.tは、自分のローカルだけでやった方が良いなぁと反省しました。


http://search.cpan.org/src/TOMYHERO/Config-Multi-0.04/t/spelling.t

$ENV{TEST_SPELLING} or  plan skip_all => "Test Spellingはスキップしちゃうよー";

こんな感じで、環境変数がなければテストをスキップするようにしました。

そして今

スペル間違いも減って、テストも通るようになりました!やったね!


http://cpantesters.perl.org/show/Config-Multi.html#Config-Multi-0.04

最後に

困っているといつの間にか対応する方法(perlの人々、CPAN経由で)がわかってしまうのがperlの良いところですね!


perlって一つの出会い系ですね!

追記

http://d.hatena.ne.jp/tokuhirom/20080526/1211810476


出会い系ですね!

YouTube の mpeg4 を Perl からゲットするよ

| 0 Comments | 1 TrackBack | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

こんにちは、自分も perl newbie な yusukebe です。

僕は「ちょっと悪い」 Perl の使い方を紹介したりしようと思っています。

よい子の方々は真似しないでね。


一発目はみんな大好き YouTube に関する Perl スクリプトだよ。

どんなものか簡単に言っちゃうと公開されている YouTube 動画の mpeg4 をダウンロードできるものです。

お好きな YouTube の動画 URL をコマンドライン引数で渡すとよいです。


簡単なコードの解説をします。

ネットにあるものを Perl で取得し利用するのには LWP::UserAgent というモジュールが定番になっています。

最初はそのモジュールを使って、一度 YouTube 動画のページにアクセスします。

my $url = $ARGV[0] || "http://www.youtube.com/watch?v=N7NTRPKfUtw";
my $ua = LWP::UserAgent->new;

my $response = $ua->get($url);
die $response->status_line unless $response->is_success;
my $content = $response->content;

$content という変数にページのデータ(HTMLの文字列)が入るので、正規表現を使って mpeg4 へのURLを構築するためのパラメータを切り出します。その後 mpeg4 へのURLを LWP::UserAgent のオブジェクトに渡しつつ、mirror メソッドでファイルを保存しています。

if($content =~ /video_id=(.+?)&.*?&t=(.+?)&/){
    my $mp4_url = "http://www.youtube.com/get_video?video_id=$1&t=$2&fmt=18";
    warn "downloading mp4 from $mp4_url\n";
    $ua->mirror($mp4_url, "$1.mp4");
}

以下が全部のコードです。LWP::UserAgent の詳細に関しては POD というドキュメントを見てみてください→http://search.cpan.org/dist/libwww-perl/ 。あんまり大声はって言えませんが、「ちょっと悪い」ことをするために Perl が必要だ!となれば、Perl のお勉強が加速すると思っています(現に自分がそうですw)。といわけでまたねー。

#!/usr/bin/perl

use strict;
use warnings;
use LWP::UserAgent;

my $url = $ARGV[0] || "http://www.youtube.com/watch?v=N7NTRPKfUtw";
my $ua = LWP::UserAgent->new;

my $response = $ua->get($url);
die $response->status_line unless $response->is_success;
my $content = $response->content;

if($content =~ /video_id=(.+?)&.*?&t=(.+?)&/){
    my $mp4_url = "http://www.youtube.com/get_video?video_id=$1&t=$2&fmt=18";
    warn "downloading mp4 from $mp4_url\n";
    $ua->mirror($mp4_url, "$1.mp4");
}else{
    warn "Error\n";
}

「Perlベストプラクティス」一通り読んだのでまとめ前半(転載)

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

オレの個人的な読後の復習としてメモを書いておく。とりあえず7章まで。(誤解している可能性はあるので指摘は大歓迎。鵜呑みしても保証できない)

Perlベストプラクティス
Damian Conway
オライリー・ジャパン
売り上げランキング: 58286

目次は oreilly.co.jp で。

Internet Archive: Details: YAPC::Asia 2006 Tokyo “Perl Best Practices” で、YAPC::Asia 2006の講演ビデオを見る事が出来る。

元記事

helloワールドにお困りの方へ

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

perlって他の言語にくらべ、Hello World(web経由)の敷居が高いので、そこでつまずいてしまう方が結構いるのではないでしょうか?


答えから先に書きますと

#!/usr/bin/perl 

print "Content-Type :text/html\n\n";
print "Hello world";

これが一般的な正解です。


ハマってしまう箇所が3カ所あります。

最初の一行目

これは、unixの仕様でperlの仕様ではありません。これの意味は、今から実行するスクリプトは、どれを使って実行しますか?というのを解決する為のものです。


つまり、上記の設定だと、あなたの perl インタプリタ (perl.exe みたいなかんじ) は、 /usr/bin/perl にあります。もし、/usr/local/bin/perl にある場合は、そちらを書く必要があります。


なので、perlが格納されているパスと違う場所を指定してしまうと、どのプログラムで実行するかわからずに、エラーになってしまうってことですね。

Content-Typeは自分で書こうね。

これも実は、HTTP(Web)の仕様であって、perlの仕様ではありません。Webの仕組みとして、まず最初に、ヘッダーと言われる目に見えない(HTMLにも表示されない)情報を送る必要があります。


わかりますね。他の言語では、この実装を自動でやってくれたりするのですが、perlではやってくれません。放任主義なあなたのママのようですね。過保護は良くないです。Webにはヘッダーという仕組みがあるのをママは教えて上げたいのです。そういうことです。この仕組みがあることを知ったあなたは、最初の一歩を、他の初心者の方より抜きでてると言い切ってしまっていいと思います。

実行権限がいるんですよ

今度は権限の話です。これもperlの問題ではありません。 unixのシステムでは、セキュリティ機能があります。誰でも、機能を使えちゃったら困りますよね?

chmod 755 hello.cgi 

みたいなコマンドを実行します。FTPでファイルを上げたりしている方は、FTPソフトに属性を変更できる機能があると思いますので、そちらを使ってください。

最後に

あれ、perlのhello worldが難しいのはperl自身の問題じゃなかったんですね。perl の hello worldは、webのしくみ、unixのしくみを知らない間に教えてくれる、スゴイ hello world だったんですね!


perlってツンデレな言語ですね!

Encode入門(転載)

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

折角なので私も一つ。


404 Blog Not Found:perl - Encode 入門参照。


decode() then encode()

use strict;
use utf8;
use Encode;
for my $argv (@ARGV){
    open my $fh, "<", $argv or die "$argv : $!";
    while(<$fh>){
        my $utf8 = decode("eucjp", $_);
        $utf8 =~ s{ (?:小飼|こがい|コガイ|Kogai)
                    [\s\x{3000}]* # \s + FULLWIDTH SPACE
                    (?:弾|だん|ダン|Dan)
                  }{Encode Maintainer}gmsx;        
        print encode("eucjp", $utf8);
    }
}

find_encoding()

use strict;
use utf8;
use Encode;
my $eucjp = find_encoding('eucjp');
for my $argv (@ARGV){
    open my $fh, "<", $argv or die "$argv : $!";
    while(<$fh>){
        my $utf8 = $eucjp->decode($_);
        $utf8 =~ s{ (?:小飼|こがい|コガイ|Kogai)
                    [\s\x{3000}]* # \s + FULLWIDTH SPACE
                    (?:弾|だん|ダン|Dan)
                  }{Encode Maintainer}gmsx;        
        print $eucjp->encode($utf8);
    }
}

PerlIO and open()

use strict;
use utf8;
use Encode;
for my $argv (@ARGV){
    open my $fh, "<:encoding(eucjp)", $argv or die "$argv : $!";
    while(<$fh>){
        s{ (?:小飼|こがい|コガイ|Kogai)
           [\s\x{3000}]* # \s + FULLWIDTH SPACE
           (?:弾|だん|ダン|Dan)
        }{空気嫁}gmsx;        
        print encode("eucjp", $_);
    }
}

binmode()

use strict;
use utf8;
# use Encode;
binmode STDOUT, ":encoding(eucjp)";
for my $argv (@ARGV){
    open my $fh, "<:encoding(eucjp)", $argv or die "$argv : $!";
    while(<$fh>){
        s{ (?:小飼|こがい|コガイ|Kogai)
           [\s\x{3000}]* # \s + FULLWIDTH SPACE
           (?:弾|だん|ダン|Dan)
        }{404 Replacement Not Found}gmsx;        
        print;
    }
}

Dan the Perl Monger

ツリー構造でデータを持て!

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

ツリー構造!

こんな感じにいくらでも、奥にもたせて行けることができるんだよ。

my %hash = ( 
   foo => [
       'foo',
       'bar'
   ] , 
   bar => { 
      hoge => { 
          foo => 1
      }  
   } 
) ;

使う時

print $hash{foo}[0]; # foo
print $hash{bar}{hoge}{foo} # 1

こんな感じで、何でもツリー型に持たせれるんだ!すごいね!

配列二つをツリー型にしてみよう


my @foo = ( 'aaa' ,'bbb' );
my @hoge =( 'ccc','ddd');

これをツリー型の配列にしたい時どおしたらいい??

# 不正解
my @wrong = (@foo,@hoge );

# 正解
my @answer = ( \@foo,\@hoge );

不正解の例では、@foo,@hogeが一つになった配列ができてしまいます。

そうです、実際には配列そのものをツリー構造型としてもつのではなく、配列の参照をもたしています。


よくわかりませんね。それはタブン、参照の概念の説明をしてなかったからですね。

そのうち誰かが説明してくれるでしょう!


じゃあ、今日はこの辺で!

perl-mongers.org に OpenID でサインインしよう!

| 0 Comments | 1 TrackBack | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

perl-mongers.org では OpenID でログインした瞬間にアカウントを作成し、いきなり飛び入りでエントリできるようになっています。OpenID とは、OpenID を発行しているはてなや、Livedoor、Yahoo! などのアカウントを利用して他のサービスにログインできるプラットフォームです。 はてな、Livedoor、Yahoo! のアカウントを持っている人だったらめんどくさいこと無しに perl-mongers.org でエントリを書けちゃいます。

さっそく、perl-mongers.org に OpenID でサインインして記事を書いてみましょう!


1. まず、perl-mongers.org のトップページに OpenID を入力します。ここでは coderepos.org で発行された OpenID を例にとりあげます。

http://media.tumblr.com/2uIDsGkn29e8xmdlZiFjzpon_500.png


2. OpenID の確認が出るので、指示に従います。

http://media.tumblr.com/2uIDsGkn29e8y1q7QCn6ZJcu_500.png


3. Movable Type の画面に切り替わります!ログインできました!ここで「ブログを書く」をクリックすれば、すぐにエントリできちゃいます!

http://media.tumblr.com/2uIDsGkn29e8y5afPucTavjL_500.png


エントリに表示される名前を変えたい場合は、以下の手順をやってください。

a. Movable Type の画面右上に表示されている、「こんにちは~さん」をクリック

http://media.tumblr.com/2uIDsGkn29e8yxb0pcihxzki_500.png


b. 「表示する名前」欄をなおす

http://media.tumblr.com/2uIDsGkn29e9azw6ZVD0zX5z_500.png


c. 「変更を保存」をクリック

http://media.tumblr.com/2uIDsGkn29e91k5jmzBEo0b2_500.png


d. 無事変更できました

http://media.tumblr.com/2uIDsGkn29e93mznhBswFz9K_500.png


ログイン直後の画面に戻るには、画面左上に表示されているロゴをクリックします。


かんたんでしたね!

OpenID さえあれば MTOS に Author アカウントでエントリできるようにする hack!

| 1 Comment | 1 TrackBack | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

こんにちは woremacx です!

OpenID さえあれば MTOS に Author アカウントでエントリできるようにする hack をしましたのでかんたんに紹介します。


みなさん MTOS つかってますか? MTOS は、Perl言語で作られている Movable Type のオープンソース版で、GNU GPL で使える cool なプロダクトです! GNU GPL のもとで使えるのですから、お仕事にでもお遊びにでも積極的に使いたいですね! この perl-mongers.org にも早速インストールしました。

そんな、ぼくお気に入りの MTOS に、OpenID でログインするだけで Author アカウントを作成しエントリできるようにする hack をしました。アイディアは、kazeburo さんの LIMILIC そのものです。tomyhero さんのセクシーObjective-C - sxey objective-c ブログ というサイトでは、LIMILIC で共有ブログを実現しています。


実現方法について説明します。今回は、従来の username / password による認証を機能させつつ、OpenID でログインしてきたユーザに最小限の権限を付すことにしました。

OpenID 部分は、コメントの外部認証に使われている MT::Auth::OpenID をコピペして MT::Auth::MTOpenID というモジュールを作りました。

MT::Auth::MTOpenID では、

  • Net::OpenID::Consumer をつかって OpenID 周りの処理
  • blog_id のバリデーション
  • type が MT::Author::AUTHOR() の author を追加
  • あらかじめ指定してある role 名からの permission, association を追加

というようなことをやっています。

それをふまえて、コア (MT::App) の login メソッドを少し触りました。OpenID での認証時には MT::Auth のメソッドを使わずに、新規にログインがあったかのように振る舞っています。


使い方は、

  • パッチをあてる
  • mt-config.cgi に必要な設定を書く
  • コメントの認証設定で OpenID を使わないように変更する

という感じです。


mt-config.cgi の書き方は、

# OpenID で記事を書けるようにするブログの ID の Regexp
AllowOpenIDUserBlog 1

# OpenID でログインしてきたユーザに付す Role
OpenIDUserRole Author

# デフォルトのメールアドレス
OpenIDUserEmail dummy-addr@example.com

となっており、全て設定する必要があります。


以下が MT-4.15b5 からの変更点をまとめたパッチです。

ざっと説明してきた今回の hack ですが、こうやったら攻撃できるんじゃないかとか、脆弱性があるとか、そういうポイントがあれば是非ご指摘いただけたらうれしいです!よろしくお願いします!


ということで OpenID があればこのブログに書けるよ!

みんなブログ書いて Perl を盛り上げていこう!

シャチ泳ぎとシュワルツ変換

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

今日はちょっと高度なソートについて解説してみるよ。


perl の sort 関数は便利なんだけど、使い方によっては無駄にマシンパワーを使ってしまいます。


ファイルパスが入った @files をファイルテスト演算子 -M でそのファイルが変更されてからの日数で比較してソートしてみます。

my @sorted = sort { -M $a <=> -M $b } @files;

この方法で期待した通りの結果が出ると思いますが、sort 関数で比較されるときに都度 -M で変更されてからの日数を取得しているのが少し無駄です。


そこでシャチ泳ぎ(Orcish Maneuver)という方法で変更してからの日数をキャッシュしながらソートしてみます。

my %m; # キャッシュを溜めておくハッシュ
my @sorted = sort {
    ($m{$a} ||= -M $a) <=> ($m{$a} ||= -M $a)
} @files;

こうすると、一度 -M した結果は %m にあるので毎回 -M で変更された日時を取らずに済みます。

$m{$a} ||= -M $a;
$m{$a} = $m{$a} || -M $a;

この二つは同じ事です。

$m{$a} があれば $m{$a} が、無ければ -M $a が入ります。


余談ですが、このキャッシュの方法はオブジェクトの生成などでもよく見かける方法です。

$self->{ua} ||= LWP::UserAgent->new;

話をソートに戻しましょう。次はシュワルツ変換という方法です。

my @sorted_files
    = map   { $_->[0] }             # 3
      sort  { $a->[1] <=> $b->[1] } # 2
      map   { [ $_, -M ] }          # 1
      @files;

シュワルツ変換は下から順に読んでいく事が出来ます。

  1. ファイル名と変更日数の無名配列を作り、配列にして返す
  2. 変更日数をキーにソート
  3. ファイル名だけの配列を返す

シュワルツ変換は sort する前にあらかじめ計算しておき、sort 時に無駄な計算が発生しないようになります。


perl のコードで表現しなおすとこんな感じですね。

my @files_and_ages = map { [ $_, -M ] } @files;
my @sorted_files_and_ages
    = sort { $a->[1] <=> $b->[1] } @files_and_ages;
my @sorted_files = map { $_->[0] } @sorted_files_and_ages;

それぞれの段階で Data::Dumper するとわかりやすいかも。


参考: Effective Perl p61-63

少し古い本ですが、Perl の中級、上級を目指す人にはいい本ですよ。

Config::Multi で複数のコンフィグファイルをいい感じに読み込む

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

プログラムを書いていて、設定ファイルを別にしている人は多いと思うんだけど、設定ファイルが大きくなったときに中身がカオスになってしまう事ってありますね。そんなときに、「コンフィグファイルを目的別に分割したい」って思うことがあるよね。


例えばこんな感じ。

config/
 |-- myapp.yml
 |-- myapp_database.yml
 |-- myapp_local.yml
 |-- web_myapp_log.yml
 `-- web_myapp_local.yml

これを読み込んで内容をマージしてくれるモジュールが Config::Multi。つい最近出来たばっかりのモジュールです。


使い方はこんな感じです。(SYNOPSIS から引用)

use Config::Multi;
use File::Spec;
use FindBin;

my $dir = File::Spec->catfile( $FindBin::Bin , 'conf' );

# prefix and extension is optional.
my $cm = Config::Multi->new({
           dir => $dir ,
           app_name    => 'myapp' ,
           extension   => 'yml'
       });
my $config = $cm->load();
my $loaded_config_files = $cm->files;

それぞれの引数は、

  • dir には設定ファイルが格納されている path
  • app_name にアプリケーションの名前
  • extention は拡張子

です。

これで、以下のような構成が読み込めます。

conf/
 |-- myapp.yml
 |-- myapp_database.yml
 |-- myapp_log.yml
 |-- myapp_local.yml
 `-- never_load.yml

${app_name}.yml か、 ${app_name}_*.yml を読み込むので、never_load.yml は読み込まれません。


また、_local とついたファイルは、一番最後に読み込んで上書きするようになってます。

本番環境と開発環境で分けたい時に便利ですね。


また、new したときに prefix って引数を付けると任意のグループが読み込めます。

conf/
 |-- myapp.yml
 |-- myapp_database.yml
 |-- myapp_log.yml
 |-- myapp_local.yml
 |-- mobile_myapp.yml
 |-- mobile_myapp_log.yml
 |-- mobile_myapp_validator.yml
 |-- mobile_myapp_local.yml
 |-- web_myapp.yml
 |-- web_myapp_log.yml
 |-- web_myapp_validator.yml
 `-- web_myapp_local.yml

mobile と web という prefix があるのが分かりますか。
では、web という prefix を指定してみましょう。

my $cm = Config::Multi->new({
    dir       => $dir ,
    prefix    => 'web',
    app_name  => 'myapp',
    extension => 'yml'
});

これで、myapp.yml, myapp_*.yml, web_myapp.yml, web_myapp_*.yml が読み込まれて、mobile_* は読み込まれなくなりました。
携帯サイトと PC サイトで設定ファイルを一部共有したいと言った場面で役立ちますね!


また、環境変数による読み込み振り分けも出来ます。詳しくは POD を見てみてね!


おっと、もし Catalyst を使っているなら、Catalyst::Plugin::Config::Multi っていう Plugin になってるから使うといいよ!

Mooseのaround modifierで正規表現を使う

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

around modifier を使うと、aroundで指定したメソッドの前後に処理を挟むことができます。要するに、AOPのinterceptorと同じですね。


最近、正規表現で書けるようパッチを送ったので、around modifireに正規表現が書けるようになります。正規表現にマッチする全てのメソッドにaround modifierを適用できるので、aroundが柔軟に書けるようになりますね。

{

    package Dog;
    use Moose;

    sub bark_once {
        my $self = shift;
        return 'bark';
    }

    sub bark_twice {
        return 'barkbark';
    }

    around qr/bark.*/ => sub {
        'Dog::around(' . $_[0]->() . ')';
    };

}

my $dog = Dog->new;
is( $dog->bark_once,  'Dog::around(bark)', 'around modifier is called' );
is( $dog->bark_twice, 'Dog::around(barkbark)', 'around modifier is called' );

まだ、色々と制約があるから、近々、もう少しパッチおくって柔軟に書けるようにするよ!


moooooooooooooooooooose!

もらったデータの構造がわかんないときは Data::Dumper におまかせ!

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

こんにちは!

アプリの開発をしていると、いろんなモジュールを組み合わせてコードを書きますね。そんなとき、モジュールからもらったデータの構造がわからなくて困ることがあります。

perl でデータ構造に困ったら Data::Dumper におまかせします!ruby だと pp ライブラリですね。

Data::Dumper の使用例

#!/usr/bin/perl

use strict;
use Data::Dumper;

my $var = {
    LLs => [qw/perl ruby python/],
    perl => 'perl-mongers',
};

warn Dumper($var);

出力結果

$VAR1 = {
          'perl' => 'perl-mongers',
          'LLs' => [
                     'perl',
                     'ruby',
                     'python'
                   ]
        };

データが構造が複雑になってくると、インデントを少なめにしてほしかったりしますね。local $Data::Dumper::Indent = 1; を使ってインデントを少なめにできます。

インデントを少なめにした例

#!/usr/bin/perl

use strict;
use Data::Dumper;

my $var = {
    LLs => [qw/perl ruby python/],
    perl => 'perl-mongers',
};

local $Data::Dumper::Indent = 1;
warn Dumper($var);

結果

$VAR1 = {
  'perl' => 'perl-mongers',
  'LLs' => [
    'perl',
    'ruby',
    'python'
  ]
};

他にも Data::Dumper にはいろいろなオプションがあり、出力を制御できます。

perldoc Data::Dumper してオプションを探求してみると、新しい発見があるかもしれませんね。

ライブラリパスの指定方法

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

こんばんは!


ライブラリ使ってる? オレオレライブラリのパスってどうやって指定してます?


これだと、違うパスに移動すると死亡だよね。

use lib '/oreore/lib';

これだと、パスをかえても動くけど、起動時にいる場所がかわるとだめだよね。

use lib './../lib';

これだと、構成が同じなら、どこにいても動くね!

use FindBin;
use lib $FindBin::Bin . './../lib' ;

さらに、Windowsのパスでもこれだと動くね!

use FindBin;
use File::Spec;
use lib File::Spec->catfile( $FindBin::Bin , '../lib' );

さらに、これだと一行ですむね!

use FindBin::libs;

みんなはどうやってる?!

じゃね!

perlで文字連結

| 0 Comments | 0 TrackBacks | このエントリーをはてなブックマークに追加 このエントリーのはてなブックマーク件数

こんにちはこんにちは!perlで文字列どうやってますか!


こんな感じですか!

my $year = 2008;
my $month = 1;
my $day = 12;

if ( $month < 10 ) {
    $month ="0" . $month;
}
if ( $day < 10 ) {
    $day ="0" . $day;
}

print $year . '/' . $month . '/' . $day . "\n";

これでもいいかも

printf("%d/%02d/%02d\n", $year ,$month , $day );

もしくは

print sprintf("%d/%02d/%02d\n", $year ,$month , $day );

よいこのみんなは、どっちを使ってるかな!それとも、違う方法かな!

About this Archive

This page is an archive of entries from May 2008 listed from newest to oldest.

June 2008 is the next archive.

Find recent content on the main index or look in the archives to find all content.

Categories

Pages

Creative Commons License
This blog is licensed under a Creative Commons License.
Powered by Movable Type 4.21-en