2006年8月21日

QRコード生成 CGI

先に紹介した QR コード生成モジュール を利用して QR コードを生成する CGI を作ってみました。文字列を入れて生成ボタンを押すだけです。興味がある方は

QR コード生成 CGI

よりどうぞ。ま、あまりきちんと処理をしていませんのであまり負荷をかけないようお願いします。また、 生成された画像は5分後には消去されます。この CGI のソースが欲しい方はご連絡下さい。

しかし xrea には GD::Barcode モジュールが入っているのか…おそるべし。

投稿者 kato : 09:38 | コメント (2) | トラックバック

QR コード生成モジュール

qrgen_sample.png

CPAN よりダウンロード可能な GD::Barcode モジュールを利用すれば Perl で QR コードを作成出来るので備忘録も兼ねてサンプルスクリプトを以下に紹介します。必要であれば同じものを上記リンクよりダウンロードできます(このスクリプトを実行したものが貼られている QR コードです)。利用の際はファイル名を qrgen.pl に変えてご利用下さい。QR コード生成スクリプトは私も作ろうと思っていたので、非常にありがたいです。

サンプルではセルサイズを自動で設定できるようにしました。モジュール自体で自動設定してくれるはずなのですが、何が悪いのかよく分かりませんがうまく設定してくれませんでしたので自分で実装しました。英数字だけですともっとたくさん文字数かけるのですが、処理が面倒なのでバイナリデータを想定しています。また、日本語文字コードは携帯で読むことを考えて Jcode.pm を用いて Shift-JIS に変換するようにしました。私の覚え書きのようなものですのでこのスクリプトをそのまま使って頂いても構いません(特に謝辞も要りませんし著作権も主張しません)ので利用価値があると思われる方はご自由にどうぞ。

#!/usr/bin/perl use GD::Barcode::QRcode; use Jcode; use strict; use vars qw( @Cells $min_size $str $version $ECC ); binmode(STDOUT); ############################################################################# # 以下ユーザーによる設定 # # $min_size : 作成する画像の最低サイズ (ピクセル, 負で最小サイズ) # $version : QR コードのサイズ(level 1-40, 0: 自動設定) # $ECC : エラー訂正レベル # L(7%), M(15%), Q(25%), H(30%) # $str : 埋め込む文字列 # $min_size = 100; $version = 0; $ECC = 'M'; $str = <<"END"; ここに文字列を入力します。改行も OK 下の END は消さないように !! END # 以上設定終了 ############################################################################# # 文字列の日本語を Shift-JIS に変換 $str = Jcode::convert( \$str, 'sjis' ); # QR コードのレベルを自動設定 if( $version < 1 || $version > 40 ){ $version = &SetVersion( $ECC, $str ); exit if( $version < 0 ); # 文字数制限オーバー } # QR コードのサイズ設定 my $ModuleSize = 1; if( $Cells[$version-1] < $min_size ){ $ModuleSize = int( $min_size / $Cells[$version-1] ) + 1; } # QR コードの作成 my $QR = new GD::Barcode::QRcode( $str, { Ecc => $ECC, ModuleSize => $ModuleSize, Version => $version } ); print $QR->plot->png; # 初期データ BEGIN{ # 各レベル毎のセル数 @Cells = qw( 21 25 29 33 37 41 45 49 53 57 61 65 69 73 77 81 85 89 93 97 101 105 109 113 117 121 125 129 133 137 141 145 149 153 157 161 165 169 173 177 ); } sub SetVersion{ my ( $ECC, $STR ) = @_; # 各レベル毎の最大データ容量(バイナリデータの場合) my @MaxByte = ( { 'L' => 17, 'M' => 14, 'Q' => 11, 'H' => 7 }, { 'L' => 32, 'M' => 26, 'Q' => 20, 'H' => 14 }, { 'L' => 53, 'M' => 42, 'Q' => 32, 'H' => 24 }, { 'L' => 78, 'M' => 62, 'Q' => 46, 'H' => 34 }, { 'L' => 106, 'M' => 84, 'Q' => 60, 'H' => 44 }, { 'L' => 134, 'M' => 106, 'Q' => 74, 'H' => 58 }, { 'L' => 154, 'M' => 122, 'Q' => 86, 'H' => 64 }, { 'L' => 192, 'M' => 152, 'Q' => 108, 'H' => 84 }, { 'L' => 230, 'M' => 180, 'Q' => 130, 'H' => 98 }, { 'L' => 271, 'M' => 213, 'Q' => 151, 'H' => 119 }, { 'L' => 321, 'M' => 251, 'Q' => 177, 'H' => 137 }, { 'L' => 367, 'M' => 287, 'Q' => 203, 'H' => 155 }, { 'L' => 425, 'M' => 331, 'Q' => 241, 'H' => 177 }, { 'L' => 458, 'M' => 362, 'Q' => 258, 'H' => 194 }, { 'L' => 520, 'M' => 412, 'Q' => 292, 'H' => 220 }, { 'L' => 586, 'M' => 450, 'Q' => 322, 'H' => 250 }, { 'L' => 644, 'M' => 504, 'Q' => 364, 'H' => 280 }, { 'L' => 718, 'M' => 560, 'Q' => 394, 'H' => 310 }, { 'L' => 792, 'M' => 624, 'Q' => 442, 'H' => 338 }, { 'L' => 858, 'M' => 666, 'Q' => 482, 'H' => 382 }, { 'L' => 929, 'M' => 711, 'Q' => 509, 'H' => 403 }, { 'L' => 1003, 'M' => 779, 'Q' => 565, 'H' => 439 }, { 'L' => 1091, 'M' => 857, 'Q' => 611, 'H' => 461 }, { 'L' => 1171, 'M' => 911, 'Q' => 661, 'H' => 511 }, { 'L' => 1273, 'M' => 997, 'Q' => 715, 'H' => 535 }, { 'L' => 1367, 'M' => 1059, 'Q' => 751, 'H' => 593 }, { 'L' => 1465, 'M' => 1125, 'Q' => 805, 'H' => 625 }, { 'L' => 1528, 'M' => 1190, 'Q' => 868, 'H' => 658 }, { 'L' => 1628, 'M' => 1264, 'Q' => 908, 'H' => 698 }, { 'L' => 1732, 'M' => 1370, 'Q' => 982, 'H' => 742 }, { 'L' => 1840, 'M' => 1452, 'Q' => 1030, 'H' => 790 }, { 'L' => 1952, 'M' => 1538, 'Q' => 1112, 'H' => 842 }, { 'L' => 2068, 'M' => 1628, 'Q' => 1168, 'H' => 898 }, { 'L' => 2188, 'M' => 1722, 'Q' => 1228, 'H' => 958 }, { 'L' => 2303, 'M' => 1809, 'Q' => 1283, 'H' => 983 }, { 'L' => 2431, 'M' => 1911, 'Q' => 1351, 'H' => 1051 }, { 'L' => 2563, 'M' => 1989, 'Q' => 1423, 'H' => 1093 }, { 'L' => 2699, 'M' => 2099, 'Q' => 1499, 'H' => 1139 }, { 'L' => 2809, 'M' => 2213, 'Q' => 1579, 'H' => 1219 }, { 'L' => 2953, 'M' => 2331, 'Q' => 1663, 'H' => 1273 } ); my $len = length( $STR ); for( my $i = 0 ; $i < 40 ; $i++ ){ if( $len < $MaxByte[$i]->{$ECC} ){ return $i+1; } } return -1; }

投稿者 kato : 05:36 | コメント (2) | トラックバック

2006年4月20日

ExifInfo.pl に関する覚え書き

本日の息抜きに ExifInfo.pl を少し眺めていました。ライブラリとしてより安全に利用できるように use strict; をつけて実行を出来るように頑張っていたのですが、local 変数に関して思い違いをしていたり、まだ Perl の知識が少ない頃に作り始めたスクリプト故に少し変えただけでは use strict; に対応出来なさそうでした。

やはり一度スクラッチから書き直す必要があるかなぁ。メーカーノートプラグインでレンズ情報をもうちょっと上手に扱いたいし、表示言語の切り替えをもう少しスマートにやりたいという思いもあるし。

投稿者 kato : 21:46 | コメント (0) | トラックバック

2006年4月10日

ラリー・ウォール氏インタビュー

Perlの生みの親ラリー・ウォール氏が語る、Perlの生い立ちと今後 (CNET Japan)

なんとインタビュアーはプログラミング Perl の翻訳者である近藤さんです。それほどつっこんだ内容ではないのですが、興味深い記事ですので Perl ファンは読む価値ありです。しかし彼はまだアコードに乗っているのか…

投稿者 kato : 22:38 | コメント (0) | トラックバック

2006年4月 7日

触発されて作った。今は後悔(公開)している…

Exif情報を別のJPEG画像へコピー「EXIF完コピ」v0.97 (窓の杜) の記事を見てこれなら Perl で10分もあれば作れるだろうと思いこんで生き抜きがてら作ってしまった。そしたら凝り出してしまって思いの外時間がかかってしまった(…とはいえ1時間強くらいか)。

せっかく記事にしたので欲しいという方はexif_copy.pl からどうぞ(ただし、exif_copy_pl になっていますので、exif_copy.pl とリネームしてお使い下さい)。

参考 URL:
EXIF完コピ (一次配布先)

--
以下、意味もなく?ソースを公開しておきます。ダウンロードはする必要は感じないがソースは見たいという方はどうぞ。基本的に JPEG の FFE1 マーカー部分を抽出してコピーしているだけです。構想もなく作ったので効率が悪かったりするのはご愛敬

#!/usr/bin/perl -w use strict; use Getopt::Std; # Getopt::Std で利用する変数をグローバル化 # Perl 5.6.0 より前の場合はコメントアウトすること # our( $opt_f, $opt_F, $opt_s, $opt_e, $opt_E, $opt_O, $opt_n, $opt_c, $opt_i, $opt_h, $opt_r ); getopts( 'f:F:s:e:E:Onci:hr' ); my $IN_file = 'exif.jpg'; # $opt_f my $OUT_file = 'no_exif.jpg'; # $opt_F my $SAVE_file = 'with_exif.jpg'; # $opt_s my $IN_ExifData = ''; # $opt_e my $OUT_ExifData = ''; # $opt_E my $OverWrite = 0; # $opt_O my $ExtractOnly = 0; # $opt_n my $ExifCheck = 0; # $opt_c my $RemoveExtract = 1; # $opt_r my $InsertExif = 'exif.exif'; # $opt_i my $Exif_in = ''; my $ExifLength_in = ''; my $Exif_out = ''; my $ExifLength_out = ''; my $s1_in = 0; my $s2_in = 0; my $s1_out = 0; my $s2_out = 0; # 引数チェック &usage unless( defined( $opt_f ) || defined( $opt_i ) ); &usage unless( defined( $opt_F ) ); unless( defined( $opt_s ) ){ $OverWrite = 1; } ( defined( $opt_f ) ) and ( $IN_file = $opt_f ); ( defined( $opt_F ) ) and ( $OUT_file = $opt_F ); ( defined( $opt_s ) ) and ( $SAVE_file = $opt_s ); ( defined( $opt_e ) ) and ( $IN_ExifData = $opt_e ); ( defined( $opt_E ) ) and ( $OUT_ExifData = $opt_E ); ( defined( $opt_O ) ) and ( $OverWrite = 1 ); ( defined( $opt_n ) ) and ( $ExtractOnly = 1 ); ( defined( $opt_c ) ) and ( $ExifCheck = 1 ); ( defined( $opt_i ) ) and ( $InsertExif = $opt_i ); ( defined( $opt_r ) ) and ( $RemoveExtract = 0 ); ( defined( $opt_h ) ) and ( &usage ); ( $IN_ExifData eq '' ) and ( $IN_ExifData = $IN_file . '_exif' ); ( $OUT_ExifData eq '' ) and ( $OUT_ExifData = $OUT_file . '_exif' ); # すでに抽出した Exif データの読み込み if( -e $InsertExif ){ open( EXIF, $InsertExif ) || die "cannot open $InsertExif\n"; seek( EXIF, 0, 2 ); my $byte = tell EXIF; seek( EXIF, 0, 0 ); read( EXIF, $Exif_in, $byte ); if( $ExifCheck ){ my $buf = unpack( "A4", substr( $Exif_in, 0, 4 ) ); unless( $buf =~ /exif/i ){ $Exif_in = ''; } } $ExifLength_in = length( $Exif_in ); # コピー元データのチェック }else{ open( IN, $IN_file ) || die "cannot open $IN_file\n"; binmode( IN ); ( $ExifLength_in, $Exif_in, $s1_in, $s2_in ) = &InquireExifData( \*IN, $ExifCheck, $IN_ExifData ); exit if( $ExifLength_in < 0 ); close( IN ); } exit if ( $ExtractOnly ); # コピー先データのチェック open( OUT, $OUT_file ) || die "cannot open $IN_file\n"; binmode( OUT ); ( $ExifLength_out, $Exif_out, $s1_out, $s2_out ) = &InquireExifData( \*OUT, $ExifCheck, $OUT_ExifData ); exit if( $ExifLength_out < 0 ); seek( OUT, 0, 0 ); my $TempFile = $OUT_file . '______' . time; open( TMP, "> $TempFile" ) || die "cannot create $TempFile\n"; # Exif データを抽出出来た場合 if( $ExifLength_in > 0 ){ my $buf = ''; if( $s1_out > 0 && $s2_out > 0 ){ read( OUT, $buf, $s1_out ); print TMP $buf; print TMP $Exif_in; seek( OUT, $s2_out, 0 ); print TMP $_ while( read( OUT, $_, 16384 ) ); }else{ print TMP pack( "CC", 0xFF, 0xD8 ); print TMP $Exif_in; seek( OUT, 2, 0 ); print tell OUT, "\n"; print TMP $_ while( read( OUT, $_, 16384 ) ); } } close( OUT ); close( TMP ); # 一時ファイルから名前を変更する if( $OverWrite ){ rename( $TempFile, $OUT_file ); }else{ rename( $TempFile, $SAVE_file ); } # 抽出した Exif データの削除 if( $RemoveExtract ){ if( -e $IN_ExifData ){ unlink( $IN_ExifData ); } if( -e $OUT_ExifData ){ unlink( $OUT_ExifData ); } } exit; # # Exif データのチェック # # ( $ExifLength, $Exif ) = &InquireExifData( \*FILE, $ExifCheck, $ExifOut ); # # $ExifLength : Exif データサイズ # $Exif : Exif データ # \*FILE : ファイルハンドルの型グロブ # $ExifCheck : 1 の時、FFE1 マーカーが Exif データかどうかをチェックする # $ExifOut : 抽出ファイル名 # sub InquireExifData{ my ( $FILE, $ExifCheck, $ExifOut ) = @_; my $buf = ''; my $b1 = ''; my $b2 = ''; my $Exif = ''; my $ExifLength = 0; my $FF = pack( "C", 0xFF ); my $s1 = 0; my $s2 = 0; # Exif データの抽出 seek( $FILE, 0, 0 ); read( $FILE, $buf, 2 ); ( $b1, $b2 ) = unpack( "CC", $buf ); # JPEG ファイルかどうかのチェック if( $b1 == 0xFF && $b2 == 0xD8 ){ while( read( $FILE, $buf, 1 ) ){ if( ( $buf eq $FF ) && read( $FILE, $buf, 3 ) ){ my $type = unpack( "C" , substr( $buf, 0, 1 ) ); my $size = unpack( "n*", substr( $buf, 1, 2 ) ); # 画像データ部または JPEG 終了のチェック ( $type == 0xD9 || $type == 0xDA ) and ( last ); # Exif データ ( FFE1 が複数ある場合は最初だけ読む ) if( $type == 0xE1 ){ $s1 = ( tell $FILE ) - 4; read( $FILE, $Exif, $size-2 ); $s2 = tell $FILE; $ExifLength = $size; if( $ExifCheck ){ $buf = unpack( "A4", substr( $Exif, 0, 4 ) ); unless( $buf =~ /exif/i ){ $Exif = ''; $ExifLength = 0; $s1 = 0; $s2 = 0; } } }elsif( $type == 0x01 || $type == 0xFF || ( $type >= 0xD0 && $type < 0xD9 ) ){ seek( $FILE, -2, 1 ); }else{ read( $FILE, $buf, $size-2 ); } } } }else{ print "$IN_file is not JPEG formatted file\n"; $ExifLength = -1; } # FFE1 マーカーの付与 if( $ExifLength > 0 ){ $Exif = pack( "CC", 0xFF, 0xE1 ) . pack( "n*", $ExifLength ) . $Exif; if( $ExifOut ne '' ){ print "HOGE:: $ExifLength\n"; open( EXIF, "> $ExifOut" ) || warn "$ExifOut isn't able to be opened or written\n"; print EXIF $Exif; close( EXIF ); } } return( $ExifLength, $Exif, $s1, $s2 ); } sub usage{ print <<"END"; exif_copy.pl - Exif 情報を別の JPEG 画像にコピーする 一番簡単な使い方: exif_copy -f <コピー元ファイル> -F <コピー先ファイル> コマンドライン引数の説明 -f <コピー元ファイル名> Exif 情報のある JPEG 画像ファイル名。 -F <コピー先ファイル名> Exif 情報を付加する JPEG 画像ファイル名。 -s <出力ファイル名> Exif 情報を付加した画像を別名で保存をする。 -i すでに抽出された Exif データをコピーします。この オプションが指定された場合、-f オプションは無視されます。 -e <コピー元 Exif ファイル名> コピー元ファイルから抽出した Exif データのファイル名。 省略時にはオリジナルファイルに '_exif' というファイル名 で保存されます。 -e <コピー元 Exif ファイル名> コピー先ファイルから抽出した Exif データのファイル名。 省略時にはオリジナルファイルに '_exif' というファイル名 で保存されます。 -O コピー先ファイルを上書き保存します(デフォルト)。 -n Exif データを抽出して終了します。 -c Exif データを抽出する際、簡易的なチェックを行います。 -h このヘルプを表示します。 -r 抽出した Exif データファイルを終了時に削除をせずに 残します。 制限 ・1つの画像ファイルに Exif 情報が2つ以上ある場合、最初のものが コピーされます。 免責事項 このスクリプトはあまりチェックをしていませんので、利用した際に うまく Exif データをコピーできない(そしてコピー先ファイルを 破損する)可能性がありますが、そのことに関して作者は責任を負いません。 自己責任でお願いします。 著作権 このスクリプトは cachu により作成され ました。もし、改変・再配布をしたいというのであればご自由にどうぞ。 今後の(バージョンアップの)予定 特に予定していません。なんとなく「EXIF完コピ」というフリーソフト http://www.vector.co.jp/soft/winnt/art/se395888.html に触発されて作ってみただけです。なので、もしバージョンアップする のであればスクラッチから作るでしょう ^^; 2006/04/07 cachu END exit; }

投稿者 kato : 20:46 | コメント (0) | トラックバック

2005年9月19日

ExifInfo.pl 開発覚え書き

Adobe 社が提唱する統一 RAW フォーマット(DNG) がリコーの GR DIGITAL に採用されるので、ようやく?調べたところその仕様が PDF でダウンロードできるようです(残念ながら英語のみですが)。ということで、早速ダウンロードしました。

ざっと見てみたところ TIFF 形式の拡張のようです。なので、現在の ExifInfo.pl でもデータ自体は読めました。ただ DNG で定義されているタグに関するデータベースがありませんので、その部分を追加する必要がありそうです。暇を見つけてやるとしよう。

翻訳作業が難航しそうだなぁ。やっぱり PhotoShop Elements を買うべきかなぁ。誰か買ってくれないかなぁ…

参考 URL:
Digital Negative (DNG)

投稿者 kato : 22:57 | コメント (5) | トラックバック

2005年9月 6日

ExifInfo.pl

本来の目的とは若干違ってきているのですが、ExifInfo.pl で RAW データも読めるようにする作業を細々と行っています(忙しいのでほとんど何もしていませんが…)。現在のバージョンでも TIFF 形式で書かれている RAW データは読むことが出来ます。具体的には

■ OLYMPUS (.orf)
■ KONICA-MINOLTA (.mrw)
■ NIKON (.nef)
■ CANON (.cr2)
■ PENTAX (.pef)

については現在公開されている ExifInfo.pl で読むことが可能です(括弧内は拡張子)。ただし、 α-sweet D の RAW には対応していません。

次回更新の ExifInfo.pl では新たに

■ FUJIFILM (.raf)
■ KONICA-MINOLTA α-sweet D

のデータを読めるようになります。また今後のことも考えて、RAW データを読む部分もメーカーノート同様プラグイン化することを検討しています。

まったく関係がないのですが、本日海外の方から ExifInfo.pl に関するメールを頂いた。ExifInfo.pl の説明のページは日本語すら放置状態なのですが、英語も書いた方がいいんだろうなぁ…と感じました。そんな余裕…あるのかしら。

投稿者 kato : 21:30 | コメント (0) | トラックバック

2005年8月17日

日本語文字コード変換に関する覚え書き

Perl 5.8 からは Encode モジュールに jcode の成果が取り込まれているのでそれを利用すればよいと言えばよいのですが、まだ 5.6.x 以前の環境も多いので jcode.pl か Jcode.pm を使うことになる。CGI を配布する身としては Jcode.pm の方がよいのですがサーバーにない場合もあるのでどちらでも使えることを考慮したい。そこで

#!/usr/bin/perl my $Having_Jcode = eval 'use Jcode; 1' ? 1 : 0; require 'jcode.pl' unless ( $Having_Jcode ); # Jcode モジュールがない場合 jcode.pl を読み込む # 文字コード変換の設定 my $JcodeConvert = \&jcode::convert; my $JcodeGetcode = \&jcode::getcode; if( $Having_Jcode ){ $JcodeConvert = \&Jcode::convert; $JcodeGetcode = \&Jcode::getcode; } # 実際に変換する my $word_before = 'ほげ'; my $word_after = &$JcodeConvert( \$word_before, 'euc' );

のようにリファレンスを使ってあげればある方を使ってくれるようになる。まぁ、これは Jcode.pm と jcode.pl に引数の互換性があるから使える技ですね。

ところで、あまり短いものを変換しようとすると文字コードの推測がうまくいかない場合があるので、可能な限り変換前の文字コードもきちんとしてあげた方がよいと最近感じてきています。

Jcode.pm をローカルにおけばいいやん!という意見がありそうですが、そうすると配布物が多くなったり導入の敷居が高くなったりなので却下します :-p

投稿者 kato : 10:53 | コメント (0) | トラックバック

 1  |  2  | All pages