#!/usr/bin/perl use strict ; use warnings ; use GD ; use GD::Barcode::QRcode ; use CGI ; use Imager ; use Jcode ; # Perlにhtmlspecialchars()って無いのかな？ sub htmlspecialchars () { my ($str) = @_; $str =~ s/\&/\&\;/g; $str =~ s/\"/\"\;/g; #$str =~ s/\'/'/g;←デフォルトはコメントアウト $str =~ s/\/\>\;/g; return $str ; } # CGIパラメータを読み込む my $cgi = new CGI ; my $data = $cgi->param('data') ; $data = "http://tsaitoh.net/" if ( $data eq "" ) ; my $str = Jcode->new( $cgi->param('str') )->euc ; $str = "魑魅魍魎" if ( $str eq "" ) ; # HTMLフォームの出力 print "Content-Type: text/html; charset=EUC-JP\n\n" ; print < テキストQRコード生成

テキストQRコード生成

HEAD print < 生成文字:
使用漢字: 画数の多い漢字を使ってね。(その他の例：薔薇) FORM # 指定文字列をQRコード文字に利用するために、1文字毎に配列格納(EUC限定) my @kstr = () ; for( my $i = 0 ; $i < length( $str ) ; $i++ ) { my $c = substr( $str , $i , 1 ) ; if ( $c =~ /[\x80-\xff]/ ) { $c = substr( $str , $i++ , 2 ) ; } push( @kstr , $c ) ; } # QRコードの生成 my $qr = GD::Barcode::QRcode->new( $data , { Ecc=>'M' , Version=>3 , ModuleSize=>1 } )->plot() ; # gif画像として一旦出力 my $filename = "qr-$$.gif" ; my $fh ; open( $fh , ">$filename" ) ; print $fh ($qr->gif) ; close $fh ; # テキストの生成 my $img = Imager->new ; $img->read( file=>$filename ) or die $img->errstr ; # gifの1画素毎にループを回して、テキストを生成 my $qrtext = "" ; my $kidx = 0 ; for( my $j = 0 ; $j < $img->getheight() ; $j++ ) { for( my $i = 0 ; $i < $img->getheight() ; $i++ ) { my ($r,$g,$b,$a) = $img->getpixel( 'x'=>$i , 'y'=>$j )->rgba() ; if ( ($r+$g+$b)/3 < 128 ) { my $c = $kstr[ $kidx ] ; $kidx = 0 if ( ++$kidx >= @kstr ) ; $qrtext .= "$c" ; #$qrtext .= "■" ; } else { $qrtext .= "　" ; #$qrtext .= "□" ; } } $qrtext .= "\n" ; } # 単純なテキストだと、スキャンしてくれないので、フォントを小さく太く。 print "

".&htmlspecialchars($data)."

" ; print "

".$qrtext."

" ; # 生成画像を消す。 unlink $filename ; print < FOOT