# $Id: Oekaki.pm v 0.0.0$ # Last updated: "Wed, 17 Apr 2002 00:31:23 JST-9" package Oekaki; use strict; use vars qw($VERSION); $VERSION = '0.00'; sub version { $VERSION; } require 5.004; =head1 NOTE めも GETでデータを送りつけてくるアプレットは今の所存在しないのでPOSTのみ対応 ●PaintBBSアプレット成功したら：コメントを書かせるCGIなどへのURIを送りつける example -> qq{Content-type: text/plain\r\n\r\n./oekaki.cgi?mode=commentview&commentNo=$g_registNo\r\n}; 失敗したら： errorという文字列を送りつける example -> qq{Content-type: text/plain\r\n\r\nerror\n}; ●PicBBSアプレット成功したら： content-typeにapplication/octet-streamを指定し、ACKという文字列を送りつける example -> qq{Content-type: application/octet-stream\n\nACK\n\n}; 失敗したら：テキストで適当な文字列を送り返す example -> qq{Content-type: text/plain\r\n\r\nerror:ファイル異常保存]サーバー側で正常に保存できなかった様ですわ。もう一度時間をおいて投稿してみてくださいね。はむぅ\n}; ●pooアプレット成功したら：テキストでokとか適当に送りつける example -> qq{Content-type: text/plain\n\nok}; 失敗したら： pooはエラー処理して無いみたいなので、なにか文字列を送り返すと全て成功したとみなされるかといって、なにも送り返さないと確か永久ループになったような・・・ =cut # 定数 use constant APPLET_PAINT => 'PaintBBS'; use constant APPLET_POO => 'poo'; use constant APPLET_PIC => 'PicBBS'; # コンストラクタ sub new { my $e = shift; return if ref $e; my $s = bless {}, $e; $s->initialize(\@_); $s; } # 使用する変数の初期化 sub initialize { my $s = shift; my %a = @{$_[0]}; $s->{'img'} = { 'type' => undef, 'size' => undef, 'width' => undef, 'height' => undef, 'data' => undef, 'img_type' => undef, 'applet_type' => undef, }; # 各アプレットへ送りつける処理結果 $s->{'notice'} = { 'ok_paint' => qq{Content-type: text/plain\r\n\r\n}, 'ok_poo' => qq{Content-type: text/plain\n\n}, 'ok_pic' => qq{Content-type: application/octet-stream\n\nACK\n}, 'ng_paint' => qq{Content-type: text/plain\r\n\r\nerror\n}, 'ng_poo' => undef, 'ng_pic' => qq{Content-type: text/plain\r\n\r\n[error]正常に保存されなかった様です。もう一度時間をおいて投稿してみてください。\n}, }; # モジュール内部で使用するフラグ $s->{'flag'} = { 'error' => undef, }; my ($k1,$k2); # key1 key2 while ( $k1 = each %a ) { $s->{$k1} = $a{$k1}, next unless ref $a{$k1} eq 'HASH'; $s->{$k1}->{$k2} = $a{$k1}->{$k2} while $k2 = each %{$a{$k1}}; } $s; } # $_[0]->{img} へのアクセサ sub img { return each %{$_[0]->{'img'}} unless exists $_[1]; return $_[0]->{'img'}->{$_[1]} unless exists $_[2]; my $s = shift; my %a = @_; my $k; # self argv key $s->{'img'}->{$k} = $a{$k} while( $k = each %a ); $s; } # めんどくさいからまとめて処理 #sub transaction_all #{ # POSTされたデータを取り出す # アプレット種別判別 # データ分解 # $_[0]->{from}->{content} にPOSTされたデータを入れる # $_[0]->get_content(); # $_[0]->{img}->{applet_type} に使用されたアプレットを判別していれる # $_[0]->distinction_applet(); # データを分解 # $_[0]->decomposition_content(); # #} # POSTされたデータを読み込む sub get_content { $ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/; return unless $ENV{'REQUEST_METHOD'} eq 'POST'; my $dat; binmode STDIN; read STDIN, $dat, $ENV{'CONTENT_LENGTH'}; \$dat; } # データを分解 # 引数：アプレットから送られてきたデータの入ってるスカラーのリファレンス # 返り値： # 画像データのリファレンス,ファイルサイズ, *PaintBBS・poo・PicBBSから送られた正しいデータならば必ず値が返る # (サムネイル１のリファレンス,ファイルサイズ,) *存在すればPaintBBSのみ値が返る # (サムネイル２のリファレンス,ファイルサイズ) *存在すればPaintBBSのみ値が返る # 失敗したら多分undef sub decomposition_content { my $type = $_[0]->img('applet_type'); return $_[0]->_decomposition_content_paintbbs($_[1]) if $type eq APPLET_PAINT; return $_[0]->_decomposition_content_poo($_[1]) if $type eq APPLET_POO; return $_[0]->_decomposition_content_picbbs($_[1]) if $type eq APPLET_PIC; return; } # paint bbs のデータを分解 # 引数：アプレットから送られてきたデータの入ってるスカラーのリファレンス # 返り値：リストで、 # 画像データのリファレンス,ファイルサイズ, # サムネイル１のリファレンス,ファイルサイズ, # サムネイル２のリファレンス,ファイルサイズ sub _decomposition_content_paintbbs { # P(1Byteの識別文字) return unless substr(${$_[1]}, 0 , 1) eq 'P'; # ヘッダーの確認 my $p = 1; # pointer 1バイト進める my ($ex_header_length, $ex_header, $img_data, $img_length, $thumbnail_1_data, $thumbnail_1_length, $thumbnail_2_data, $thumbnail_2_length); # 拡張ヘッダー長(必ず8文字8Byte) $ex_header_length = int substr( ${$_[1]}, $p, 8 ); # 拡張ヘッダー長、8バイト進める $p += 8; # 拡張ヘッダー $ex_header = substr( ${$_[1]}, $p, $ex_header_length ); # 拡張ヘッダー分、進める $p += $ex_header_length; # 画像サイズ長(必ず8文字8Byte) $img_length = int substr( ${$_[1]}, $p, 8 ); # 画像サイズ長、8バイト進める $p += 8; # \r\n(CR LF。互換性の為入れています。ここから下はバイナリ含むの意味) $p += 2; # \r\nの2バイト進める # 画像データ(PNGかJPEG) $img_data = substr( ${$_[1]}, $p, $img_length ); # 画像データ分を進める $p += $img_length; # サムネイル１長(必ず8文字8Byte) $thumbnail_1_length = int substr( ${$_[1]}, $p, 8 ); if($thumbnail_1_length > 0) { # サムネイルが存在している場合0(バイト)以上になる # サムネイル１長分進める $p += 8; # サムネイル１データ(PNGかJPEGかPaintChatAnimationデータ) $thumbnail_1_data = substr( ${$_[1]}, $p, $thumbnail_1_length ); $p += $thumbnail_1_length; # サムネイルデータ分進める # サムネイル２長(必ず8文字8Byte) $thumbnail_2_length = int substr( ${$_[1]}, $p, 8 ); if($thumbnail_2_length > 0) { # サムネイルの後ろに２つ目のサムネイルが存在している場合0(バイト)以上になる # サムネイル２長分進める $p += 8; # サムネイル２データ(PNGかJPEGかPaintChatAnimationデータ) $thumbnail_2_data = substr( ${$_[1]}, $p, $thumbnail_2_length ); $p += $thumbnail_2_length; } } return (\$img_data, $img_length, \$thumbnail_1_data, $thumbnail_1_length, \$thumbnail_2_data, $thumbnail_2_length); } # poo のデータを分解 # 引数：アプレットから送られてきたデータの入ってるスカラーのリファレンス # 返り値：リストで、 # 画像データのリファレンス,ファイルサイズ sub _decomposition_content_poo { #junji.gif\x0D\x0D\x0A return unless ${$_[1]} =~ /(?:^\x6A\x75\x6E\x6A\x69\x2E\x67\x69\x66)/; # ヘッダーの確認文字列でjunji.gif # ヘッダー長 my $header_length = index ${$_[1]}, "\x0A"; # 画像データ my $img_data = substr( ${$_[1]}, $header_length ); # 画像サイズ my $img_length = $ENV{'CONTENT_LENGTH'} - $header_length; return (\$img_data, $img_length); } # pic bbs のデータを分解 # 引数：アプレットから送られてきたデータの入ってるスカラーのリファレンス # 返り値：リストで、 # 画像データのリファレンス,ファイルサイズ sub _decomposition_content_picbbs { #jpg 25009 return unless ${$_[1]} =~ /(?:^\x70\x6E\x67)||(?:^\x6A\x70\x67)/; # ヘッダーの確認文字列でpngかjpg # ファイル拡張子(3文字3byte pngかjpg) my $p = 3; # ファイル長(8文字8byte 足りない分は空白で埋まる) my $img_length = int substr( ${$_[1]}, $p, 8); # ファイル長分進める $p += 8; # 画像データ my $img_data = substr( ${$_[1]}, $p, $img_length); # 画像データ分進める $p += $img_length; return (\$img_data, $img_length); } # リファレンスで画像を受け取って画像の識別 (PCHかPNGかJPEGかを調べる) sub distinction_img_type { return unless $_[1]; $_[0]->img('type'=>'PCH'), return('PCH') if ${$_[1]} =~ /^\x1F\x8B\x08/; $_[0]->img('type'=>'PNG'), return('PNG') if ${$_[1]} =~ /^\x89\x50\x4E\x47/;#/^\x49\x48\x44\x52/; $_[0]->img('type'=>'JPEG'), return('JPEG') if ${$_[1]} =~ /^\xFF\xC0/; return; } # PNGの画像データをリファレンスで受け取ってサイズとか調べる IHDR sub analysis_img_png { return unless $_[1] && $_[0]->img('type') eq 'PNG'; my $index = index ${$_[1]}, "\x89\x50\x4E\x47"; return unless $index; # PNGでなければ終了 $_[0]->img( 'width' => (hex unpack 'H*', substr ${$_[1]}, $index+4, 4) ); $_[0]->img( 'height' => (hex unpack 'H*', substr ${$_[1]}, $index+8, 4) ); $_[0]; } # JPEGの画像データをリファレンスで受け取ってサイズとか調べる FFC0 sub analysis_img_jpeg { return unless $_[1] && $_[0]->img('type') eq 'JPEG'; my $index = index ${$_[1]}, "\xFF\xC0"; return unless $index; $_[0]->img( 'width' => (hex unpack 'H*', substr ${$_[1]}, $index+7, 2) ); $_[0]->img( 'height' => (hex unpack 'H*', substr ${$_[1]}, $index+5, 2) ); $_[0]; } # アプレットの識別 sub distinction_applet { return unless $_[1]; # PaintBBSアプレット $_[0]->img('applet_type'=>APPLET_PAINT), return APPLET_PAINT if 'P' eq substr( ${$_[1]}, 0, 1 ); # PicBBSアプレット $_[0]->img('applet_type'=>APPLET_PIC), return APPLET_PIC if ${$_[1]} =~ /(?:^\x70\x6E\x67)||(?:^\x6A\x70\x67)/; # pooアプレット $_[0]->img('applet_type'=>APPLET_POO), return APPLET_POO if ("\x6A\x75\x6E\x6A\x69\x2E\x67\x69\x66" eq substr( ${$_[1]}, 0, (index ${$_[1]}, "\r") )) || ${$_[1]} =~ /(?:^\x0D\x0A\x0D\x0A)||(?:^\x00\x00)/; # 6A756E6A692E676966 = junji.gif return; } # アプレットに処理結果を送る # 引数：アプレットタイプ(APPLET_PAINT/APPLET_POO/APPLET_PIC) # 返り値： sub notice_transaction_result { return unless $_[0]->img('applet_type'); # アプレットがわからなければやるだけ無駄なので終了 my $a = $_[0]->img('applet_type') || $_[1]; unless ( $_[0]->flag('error') ) { # エラーが発生していない print($_[0]->{'notice'}->{'ok_paint'}), return $_[0] if $a eq APPLET_PAINT; print($_[0]->{'notice'}->{'ok_poo'}), return $_[0] if $a eq APPLET_POO; print($_[0]->{'notice'}->{'ok_pic'}), return $_[0] if $a eq APPLET_PIC; }else{ # エラーが発生した print($_[0]->{'notice'}->{'ng_paint'}), return $_[0] if $a eq APPLET_PAINT; print($_[0]->{'notice'}->{'ng_poo'}), return $_[0] if $a eq APPLET_POO; print($_[0]->{'notice'}->{'ng_pic'}), return $_[0] if $a eq APPLET_PIC; } return; } sub DESTROY {} sub END {} 1; __END__