自分が持っているドメインのサブドメインにQRコードに変換する機能を付ける

Tweet

PCのウェブブラウザでみていたページで、「このページのURLをケータイに送りたい」とか、PCで難しい漢字を打っておいて、「この文字をケータイで使いたい」とかいったときにQRコードを使うと便利です。

ネットサーフィン（死語）中ちょうどいいエッチイラスト画像があったらすかさずケータイの待ち受けにするとか（個人利用の範囲内で）、よくするんですが、こういう話を女性にすると、よっぽどオタク趣味に理解のある人でもなぜか引かれるわけですが、これなんでなんでしょうね。するけど。

んで、そういう意味も含めて、自分の持っているドメインの中にこういう文字列をQRコードに変換するやつを設置すると。なんで自分の持っているドメイン内かっていうと、ほかの人が作ったやつだと、記録されているかもしれないじゃないですか。あと、今時だとGoogleのサービスでQRコード生成するやつがあるんですけれども、Googleは確実に記録しているぞきっと。趣味ばれるぞきっと。

というわけで、Perlを使って http://qr.dtpwiki.jp/ を便利なQRコード変換サイトとして設定する例です。無駄に大掛かりなんでほとんど参考にならないかもね。

1.サブドメインを作り、自分が管理しているサーバに向ける

僕はValue-Domainを使っています。クレジットカードさえあれば今すぐにドメインを取得できるから便利です。今回でいえば、qr.dtpwiki.jpを自サーバのIPに割り当てます。

▲Value-Domain設定

2.Apacheの/etc/httpd/conf/httpd.confに追加記述する

サーバにはCentOS5など使っていますからそれっぽく書きます。

<VirtualHost 192.168.6.16>
    ServerAdmin webmaster@dtpwiki.jp
    DocumentRoot /home/www/qr.dtpwiki.jp/html
    ServerName qr.dtpwiki.jp
    ErrorLog /home/www/qr.dtpwiki.jp/logs/error_log
    CustomLog /home/www/qr.dtpwiki.jp/logs/access_log combined
    <Directory "/home/www/qr.dtpwiki.jp/html">
      AllowOverride All
    </Directory>
</VirtualHost>

IPとかディレクトリは読み替えてね。

3.スクリプトを設置

Filename: /home/www/qr.dtpwiki.jp/html/qr.cgi

#!/usr/bin/perl
 
use strict;
use warnings;
use CGI::Carp qw(fatalsToBrowser);
use Encode;
use GD::Barcode::QRcode;
fixup();
 
my $url
  = encode( 'cp932',
            decode( 'utf8',
                    substr( $ENV{'PATH_INFO'},
                            1
                    )
            )
    );
 
my $barcode
  =  GD::Barcode::QRcode->new(
       $url,
       { 
         Ecc        => 'M',
         ModuleSize => 4,
       }
     );
 
{
  binmode STDOUT => ':raw';
  print "Content-Type: image/gif\n\n";
  print $barcode->plot->gif;
}
 
sub fixup {
  return if GD::Barcode::QRcode->VERSION > 0.01;
  package GD::Barcode::QRcode;
  no warnings 'redefine';
  
  *init = sub {
    my($oSelf, $sTxt, $rhPrm) =@_;
 
#CalcCd
    $oSelf->{text} = $sTxt;
    $oSelf->{Ecc} = $rhPrm->{Ecc} || ' ';
    $oSelf->{Ecc} =~ tr/LMHQ/M/c;    #Not /LMQH/ => M
    $oSelf->{Version} = $rhPrm->{Version};
    $oSelf->{ModuleSize} = $rhPrm->{ModuleSize};
    $oSelf->{ModuleSize} = int($oSelf->{ModuleSize});
 
    my $iDatCnt = 0;
    my @aDatVal;
    my @aDatBit;
    my $raPlusWords;
    my $iWordsPos;
    $aDatBit[$iDatCnt]=4;
    # Determin Data Type(8Bit, AlphaNumeric, Numeric .. not supported Kanji-Mode)
    if ($oSelf->{text} =~ /\D/) {
        if ($oSelf->{text} =~ /[^0-9A-Z \$\*\%\+\-\.\/\:]/) {
         # --- 8bit byte mode
            ($iDatCnt, $raPlusWords) =
                $oSelf->_cnv8bit($iDatCnt, \@aDatVal, \@aDatBit,);
        }
        else {
         # ---- alphanumeric mode
            ($iDatCnt, $raPlusWords) =
                $oSelf->_cnvAlphaNumeric($iDatCnt, \@aDatVal, \@aDatBit);
        }
    }
    else {
     # ---- numeric mode
        ($iDatCnt, $raPlusWords) =
            $oSelf->_cnvNumeric($iDatCnt, \@aDatVal, \@aDatBit);
    }
    my $iTotalBits = 0;
    for(my $i=0;$i<$iDatCnt;++$i){
        $iTotalBits += $aDatBit[$i];
    }
 
    # Calc version(=Size)
    my ($iMaxDatBits, $iCdNumPlus, $iMaxCodeWords, $iRemainBits);
    ($iMaxDatBits, $iCdNumPlus, $iMaxCodeWords, $iRemainBits) = 
        $oSelf->_calcVersion($iTotalBits, $raPlusWords);
    $iTotalBits += $iCdNumPlus;
 
    $aDatBit[$oSelf->{WordsPos}] += $iCdNumPlus;
    $oSelf->{MaxModules}  = 17 + ($oSelf->{Version} * 4);
    my $iBitCnt = ($iMaxCodeWords * 8) + $iRemainBits;
    my $iMaxDatWords=($iMaxDatBits / 8);
 
    # ---- read version ECC data file.
    my ($sMatX, $sMatY, $sMasks, $sFmtInfX2, $sFmtInfY2, $sRsEccCodeWord, $sRso);
    my $sRec = do ('GD/Barcode/QRcode/qrv' . 
                    sprintf('%02d', $oSelf->{Version}) . $oSelf->{Ecc} . '.dat');
 
    ($sMatX, $sMatY, $sMasks, $sFmtInfX2, $sFmtInfY2, $sRsEccCodeWord, $sRso) = 
        unpack(("a$iBitCnt" x 3) . ('a15' x 2) . 'a1a128', pack('H*', $sRec));
 
    my $iRsEccWords = ord($sRsEccCodeWord);
    my @aMatrixX    = unpack("C*", $sMatX);
    my @aMatrixY    = unpack("C*", $sMatY);
    my @aMask       = unpack("C*", $sMasks);
    my @aRsBlockOrder  = unpack("C*", $sRso);
    my @aFmtInfX2      = unpack("C*", $sFmtInfX2);
    my @aFmtInfY2      = unpack("C*", $sFmtInfY2);
 
    $sRec = do ('GD/Barcode/QRcode/rsc' . sprintf('%02d', $iRsEccWords) . '.dat');
    my @aRsCalTbl = unpack("a$iRsEccWords" x 256, pack('H*', $sRec));
 
    # ----  set teminator 
    if ($iTotalBits <= ($iMaxDatBits-4)){
        $aDatVal[$iDatCnt] = 0;
        $aDatBit[$iDatCnt] = 4;
    } 
    elsif ($iTotalBits < $iMaxDatBits){
        $aDatVal[$iDatCnt] = 0;
        $aDatBit[$iDatCnt] = $iMaxDatBits-$iTotalBits;
    }
    elsif ($iTotalBits > $iMaxDatBits){
        die "Overflow error. version $oSelf->{Version}\n" . 
            "total bits: $iTotalBits  max bits: $iMaxDatBits\n";
    }
    # 8ビット単位に分割
    my $iCodeWords=0;
    my @aCodeWords;
    $aCodeWords[0]=0;
    my $iRestBits = 8;
    for(my $i=0;$i <= $iDatCnt; ++$i) {
        my $sBuff    = $aDatVal[$i];
        my $iBuffBit = $aDatBit[$i];
 
        my $iFlg=1;
        while ($iFlg) {
            if ($iRestBits > $iBuffBit) {
                $aCodeWords[$iCodeWords]=(($aCodeWords[$iCodeWords] << $iBuffBit) | $sBuff);
                $iRestBits -= $iBuffBit;
                $iFlg=0;
            }
            else {
                $iBuffBit -= $iRestBits;
                $aCodeWords[$iCodeWords]=(($aCodeWords[$iCodeWords] << $iRestBits) | ($sBuff >> $iBuffBit));
                if ($iBuffBit==0) {
                    $iFlg=0;
                }
                else {
                    $sBuff= ($sBuff & ((1 << $iBuffBit) -1 ));
                    $iFlg=1;   
                } 
                $iCodeWords++;
                if ($iCodeWords<$iMaxDatWords-1){
                    $aCodeWords[$iCodeWords]=0;
                }
                $iRestBits = 8;
            }
        }
    }
    if ($iRestBits != 8) {
        $aCodeWords[$iCodeWords] <<= $iRestBits;
    }
    else {
        --$iCodeWords;
    }
    # Padding data
    if ($iCodeWords < $iMaxDatWords - 1 ){
        my $iFlg=1;
        while ($iCodeWords < ($iMaxDatWords-1)){
            $aCodeWords[++$iCodeWords] = ($iFlg==1)? 0xEC : 0x11;
            $iFlg *= -1;
        }
    }
 
    # ----  RS-ECC prepare
    my $iRsBlock=0;
    my @aRsTmp=();
    my $j=0;
    # Divide RS-Blocks
    for(my $i = 0; $i < $iMaxDatWords; ++$i) {
        $aRsTmp[$iRsBlock] .= chr($aCodeWords[$i]);
        if (++$j >= $aRsBlockOrder[$iRsBlock]-$iRsEccWords){
            $j=0;
            ++$iRsBlock;
        }
    }
    # RS-ECC main
    for($iRsBlock=0; $iRsBlock <= scalar(@aRsBlockOrder); $iRsBlock++) {
        my $sRsCodeWords = $aRsBlockOrder[$iRsBlock];
        $sRsCodeWords ||= 0;
        $sRsCodeWords =~ s/\n//g;
        my $sRsTmp = ($aRsTmp[$iRsBlock] || ''). (chr(0) x $iRsEccWords);
 
        for($j = ($sRsCodeWords - $iRsEccWords); $j>0; $j--) {
            my $iFirst = ord(substr($sRsTmp, 0, 1));
            if ($iFirst != 0){
                $sRsTmp = substr($sRsTmp, 1) ^ $aRsCalTbl[$iFirst];
            }
            else {
                $sRsTmp = substr($sRsTmp, 1);
            }
        }
        push(@aCodeWords, unpack("C*", $sRsTmp));
    }
    # ---- put data
    # ---- flash matrix
    my @aCont;
    $oSelf->{Cont} = \@aCont;
    for(my $i=0;$i<$oSelf->{MaxModules};$i++) {
        $aCont[$i] = [ (0) x $oSelf->{MaxModules}];
    }
    for(my $i=0; $i<$iMaxCodeWords; $i++) {
        my $iCodeWord = $aCodeWords[$i];
        for(my $j = 7; $j >= 0; $j--) {
            my $iCodeWordBitNum = ($i * 8)+$j;
            $aCont[$aMatrixX[$iCodeWordBitNum] ][ $aMatrixY[$iCodeWordBitNum]]
                = ((255*($iCodeWord & 1)) ^ $aMask[$iCodeWordBitNum]); 
            $iCodeWord >>= 1;
        }
    }
    for(my $iMatrixRemain = $iRemainBits; $iMatrixRemain; $iMatrixRemain--) {
        my $iRemainBitTmp = $iMatrixRemain + ($iMaxCodeWords * 8);
        $aCont[$aMatrixX[$iRemainBitTmp]][$aMatrixY[$iRemainBitTmp]]  
            = (255 ^ $aMask[$iRemainBitTmp] );
    }
 
    # ---- mask select
    my $sHorMst='';
    my $sVerMst='';
    for(my $i=0; $i < $oSelf->{MaxModules}; ++$i) {
        for($j=0 ; $j < $oSelf->{MaxModules}; ++$j){
            $sHorMst .= chr($aCont[$j][$i]);
            $sVerMst .= chr($aCont[$i][$j]);
       }
    }
    my $iMask = $oSelf->_calcMask($sHorMst, $sVerMst);
    $oSelf->{MaskCont} = (1 << $iMask);
 
    # ---- format information
    my %hFmtInf =(
        'M' => [
          '101010000010010', '101000100100101', '101111001111100', '101101101001011',
          '100010111111001', '100000011001110', '100111110010111', '100101010100000',],
        'L' => [
          '111011111000100', '111001011110011', '111110110101010', '111100010011101',
          '110011000101111', '110001100011000', '110110001000001', '110100101110110',],
        'H' =>[
          '001011010001001', '001001110111110', '001110011100111', '001100111010000',
          '000011101100010', '000001001010101', '000110100001100', '000100000111011',],
        'Q' => [
          '011010101011111', '011000001101000', '011111100110001', '011101000000110',
          '010010010110100', '010000110000011', '010111011011010', '010101111101101',],
    );
    my @aFmtInfX1=( 0, 1, 2, 3, 4, 5, 7, 8, 8, 8, 8, 8, 8, 8, 8);
    my @aFmtInfY1=( 8, 8, 8, 8, 8, 8, 8, 8, 7, 5, 4, 3, 2, 1, 0);
    my @aContWk = split //, $hFmtInf{$oSelf->{Ecc}}->[$iMask];
    for(my $i = 0; $i < 15; ++$i) {
        $aCont[$aFmtInfX1[$i]][$aFmtInfY1[$i]] = $aContWk[$i] * 255;
        $aCont[$aFmtInfX2[$i]][$aFmtInfY2[$i]] = $aContWk[$i] * 255;
    }
    return '';
};
 return 1;
}

ポイントはGD::Barcode::QRcodeのバグをオンデマンドのパッチで直しているところですが、直すべきサブルーチンがでかすぎるのでこんなことに。

参考：
GD::Barcode::QRcodeのバグ?の件について - libnitsuji.so [d.hatena.ne.jp]

4. .htaccessを書きます

Filename: /home/www/qr.dtpwiki.jp/html/.htaccess

Options +ExecCGI
AddType application/x-httpd-cgi .cgi
DirectoryIndex qr.cgi
RewriteEngine on
RewriteRule ^qr.cgi - [L]
RewriteRule ^(.*)$ qr.cgi/$1

これで、http://qr.dtpwiki.jp/ほげ で、表示できるようになります（PATH_INFOってやつでしょうか）。

---

んで、実際に　http://qr.dtpwiki.jp/ほげ　とすれば、表示されたQRコードをケータイで撮影すると「ほげ」と表示されると思いますし、http://qr.dtpwiki.jp/http://blog.dtpwiki.jp/ とかするとこのブログがケータイで見られるんだと思います。

んで、上記設定を見るとわかりますが、ログに残ります。自分で設置するときはそこらへんも考えましょう。

---

そんでエッチなイラストは、普段もって歩かない方のdocomo端末にいれるわけですが、それをi-modeでダウンロードするために、普段もって歩く方のdocomo端末からFOMAカードを移してダウンロードして待ち受けに設定するのですけれども、ダウンロード済みコンテンツはFOMAカードにひも付けされているので、FOMAカードを元に戻すと待ち受けが表示されなくなるという。SDカードに移して戻すとひも付けが切れるみたいですね。なんだかなあ。

2009.07.13 23:36 投稿　大野 義貴 [Perl] | 固定リンク |