adiary開発日誌

Perlの名前空間と型グロブに関する応用的な話です。高度な内容ですので、少なくともリファレンスについては理解している人向けです。型グロブも多少知らないと難しいかもしれません。

• 型グロブとは
• 名前空間の取得と操作
  • 外部モジュールと名前空間
• 名前空間の開放と変数の開放
  • 名前空間まとめ
• 応用：動的な関数のフック
• 応用：ライブラリの自動リロード
  • 具体的な方法
  • アンロードルーチン
• まとめ

※以下特に断りがない限りPerl 5.10での動作確認です。

続きを読む

adiaryに、twitter投稿のためのOAuthを実装したときのメモです。PurePerl動作。

OAuthモジュール（OAuth::Lite::Consumer）を使わずに実装したので、同じことをやりたい人には参考になるかと思います。*1

• 資料とか
• OAuthの流れ
• リクエストトークンの取得
• HMAC-SHA1署名
  • 署名するメッセージの生成
  • callbackを得る場合
• アクセス許可の取得
• アクセストークンの取得
• twitter APIへのアクセス（TLへの発言）
  • フォーム要素のURIエンコード
• ツッコミ

続きを読む

Digest::SHA ないしは Digest::SHA::PurePerl を使います。よって PurePerl でも動作します。

HMAC署名についてはwikipediaを参照。

sub hmac_sha1 {
	# my $self = shift;
	my ($key, $msg) = @_;
	my $sha1;

	if ($Digest::SHA::PurePerl::VERSION) {
		$sha1 = Digest::SHA::PurePerl->new(1);
	} else {
		eval {
			require Digest::SHA;
			$sha1 = Digest::SHA->new;
		};
		if ($@) {
			require Digest::SHA::PurePerl;
			$sha1 = Digest::SHA::PurePerl->new(1);
		}
	}

	my $bs = 64;
	if (length($key) > $bs) {
		$key = $sha1->add($key)->digest;
		$sha1->reset;
	}
	my $k_opad = $key ^ ("\x5c" x $bs);
	my $k_ipad = $key ^ ("\x36" x $bs);
	$sha1->add($k_ipad);
	$sha1->add($msg);
	my $hk_ipad = $sha1->digest;
	$sha1->reset;
	$sha1->add($k_opad, $hk_ipad);

	my $b64d = $sha1->b64digest;
	$b64d = substr($b64d.'====', 0, ((length($b64d)+3)>>2)<<2);
	return $b64d;
}

最後に「====」を付けてやるのがポイントで、これがないとOAuthで盛大にコケます。

なおこのソースコードはPDS扱いとします。

Webアプリ開発中に ImageMagick（perlmagick）が SpeedyCGI 環境でまともに動かない不具合に当たりました。

• 問題の詳細
• 問題の症状
• 問題の原因
• 問題の解決法 2014/08/18
• まとめ
• メモ

問題の詳細

• Image::Magick をロードして何かしら処理を行うルーチンを SpeedyCGI で実行する時、２回目以降のキャッシュされた状態で不具合が起こる*1。
• 問題確認環境
  • Perl 5.8.8 + SpeedyCGI 2.22
  • ImageMagick 6.3.7 および 6.5.9

この問題は FastCGI や mod_perl2 では起きません。

問題の症状

スクリプト

#!/usr/bin/speedy

use Image::Magick();

print "Content-Type: text/plain\n\n";
print "Image::Magick Version $Image::Magick::VERSION \n";
my $image = Image::Magick->new;
$image->Read( 'x.png' );

実行結果。

~$ test.pl
Image::Magick Version 6.3.7
~$ test.pl
Segmentation fault

~$ test.pl
Image::Magick Version 6.5.9
~$ test.pl
Segmentation fault

問題の原因

不明。

問題の解決法 2014/08/18

#!/usr/bin/speedy

delete $INC{'Image/Magick.pm'};
require Image::Magick;

print "Content-Type: text/plain\n\n";
print "Image::Magick Version $Image::Magick::VERSION \n";
my $image = Image::Magick->new;
$image->Read( 'x.png' );

requireで毎回確実にロードさせる細工をすることで問題は起こらなくなりました。Image::Magickモジュールがキャッシュされませんが、evalを飛び越えてSpeedyCGIごと落ちるよりはマシということで……。

まとめ

gcc 4.4でも起きたので関係ないようです。4年経っても解決されてないとは思わなかった（汗）

メモ

256色png（8bitカラーパレット）で保存する方法。

$image->Read( 'x.png' );
$image->Resize(width=>133, height=>100);
$image->Quantize(colorspace=>'RGB',colors=>256);
$image->Set(depth => 8); 
$image->Write( 'y.png' );

よくネットショップ等で買い物をすると

郵便番号は半角で入力してください。

とか言われてウザくないですか？　こういうのを解消するためのルーチンです。

• 条件
• 日本語に混ざる全角英数等を半角にする
• 半角カタカナを全角カタカナにする
  • Encode::JP::H2Z
• その他

条件

• Perl 5.8以降
• 利用可能文字列はutf-8のみ（そうでない場合はutf8に変換して渡してください）
• WTFPL（PDS扱いでも可）。

ソースは必ずutf-8で保存してください。

日本語に混ざる全角英数等を半角にする

use utf8;
use Encode ();
sub utf8_zen2han {
	my $str = shift;
	my $flag = utf8::is_utf8($str);
	Encode::_utf8_on($str);

	$str =~ tr/　！”＃＄％＆’（）＊＋，－．／０-９：；＜＝＞？＠Ａ-Ｚ［￥］＾＿｀ａ-ｚ｛｜｝/ -}/;

	if (!$flag) { Encode::_utf8_off($str); }
	return $str;
}

実行例。

（変換前）ａｂｃｄｅｆｇさささ１１０－２２４４あいう＃＃＄”
（変換後）abcdefgさささ110-2244あいう##$"

半角カタカナを全角カタカナにする

use utf8;
use Encode ();

my %hankana_map = (
'ｶﾞ'=>'ガ','ｷﾞ'=>'ギ','ｸﾞ'=>'グ','ｹﾞ'=>'ゲ','ｺﾞ'=>'ゴ',
'ｻﾞ'=>'ザ','ｼﾞ'=>'ジ','ｽﾞ'=>'ズ','ｾﾞ'=>'ゼ','ｿﾞ'=>'ゾ',
'ﾀﾞ'=>'ダ','ﾁﾞ'=>'ヂ','ﾂﾞ'=>'ヅ','ﾃﾞ'=>'デ','ﾄﾞ'=>'ド',
'ﾊﾞ'=>'バ','ﾋﾞ'=>'ビ','ﾌﾞ'=>'ブ','ﾍﾞ'=>'ベ','ﾎﾞ'=>'ボ',
'ﾊﾟ'=>'パ','ﾋﾟ'=>'ピ','ﾌﾟ'=>'プ','ﾍﾟ'=>'ペ','ﾎﾟ'=>'ポ',
'ｳﾞ'=>'ヴ');

sub utf8_hankana2zen {
	my $str = shift;

	my $flag = utf8::is_utf8($$str);
	Encode::_utf8_on($$str);

	$str =~ s/(ｶﾞ|ｷﾞ|ｸﾞ|ｹﾞ|ｺﾞ|ｻﾞ|ｼﾞ|ｽﾞ|ｾﾞ|ｿﾞ|ﾀﾞ|ﾁﾞ|ﾂﾞ|ﾃﾞ|ﾄﾞ|ﾊﾞ|ﾋﾞ|ﾌﾞ|ﾍﾞ|ﾎﾞ|ﾊﾟ|ﾋﾟ|ﾌﾟ|ﾍﾟ|ﾎﾟ|ｳﾞ)/$hankana_map{$1}/g;
	$str =~ tr/｡-ﾟ/。「」、・ヲァィゥェォャュョッーアイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホマミムメモヤユヨラリルレロワン゛゜/;

	if (!$flag) { Encode::_utf8_off($str); }
	return $str;
}

Encode::JP::H2Z

今更使いませんが、EUC-JPの場合は標準モジュールでもできます。逆変換は Encode::JP::H2Z::z2h()。

use Encode ();
use Encode::JP::H2Z ();

sub eucjp_hankana2zen {
	my $str = shift;
	Encode::JP::H2Z::h2z(\$str);
	return $str;
}

その他

バグ等あったらコメントください。