Perl で、Shift JIS でスクリプトを保存するには?

Perl でケータイ向けのサイトを書いているとき、シフトJIS でスクリプトを保存しないければならない場合がある (文字列テーブルなど)。このとき、

Unrecognized character \x81 at ./your.cgi line XX.

といったエラーに悩まされているなら、

my $group = 'グル&#x30fc;プ';

などのように、「―」を「ー」で表すようにするとよい (Mac の場合は、「ー」が「―」になるようで、この現象が起こる)。または、文字化けする文字の後ろに「\」を付ける。以下は、Shift JIS で文字化けする文字の一覧。文字化けを起こしやすいよく使う文字は強調しておいた。文字 - Shift-JIS - Unicode での記述方法

―　　81 5C　　　―
ソ　　83 5C　　　ソ
Ы　　84 5C　　　Ы
Ⅸ　　87 5C　　　Ⅸ
噂　　89 5C　　　噂
浬　　8A 5C　　　浬
欺　　8B 5C　　　欺
圭　　8C 5C　　　圭
構　　8D 5C　　　構
蚕　　8E 5C　　　蚕
十　　8F 5C　　　十
申　　90 5C　　　申
曾　　91 5C　　　曾
箪　　92 5C　　　箪
貼　　93 5C　　　貼
能　　94 5C　　　能
表　　95 5C　　　表
暴　　96 5C　　　暴
予　　97 5C　　　予
禄　　98 5C　　　禄
兔　　99 5C　　　兔
喀　　9A 5C　　　喀
媾　　9B 5C　　　媾
彌　　9C 5C　　　彌
拿　　9D 5C　　　拿
杤　　9E 5C　　　杤
歃　　9F 5C　　　歃
濬　　E0 5C　　　濬
畚　　E1 5C　　　畚
秉　　E2 5C　　　秉
綵　　E3 5C　　　綵
臀　　E4 5C　　　臀
藹　　E5 5C　　　藹
觸　　E6 5C　　　觸
軆　　E7 5C　　　軆
鐔　　E8 5C　　　鐔
饅　　E9 5C　　　饅
鷭　　EA 5C　　　鷭
偆　　ED 5C　　　偆
砡　　EE 5C　　　砡

Perl でケータイ向けのサイトを書いているとき、シフトJIS でスクリプトを保存しないければならない場合がある (文字列テーブルなど)。このとき、

Unrecognized character \x81 at ./your.cgi line XX.

といったエラーに悩まされているなら、

my $group = 'グル&#x30fc;プ';

などのように、「―」を「ー」で表すようにするとよい (Mac の場合は、「ー」が「―」になるようで、この現象が起こる)。または、文字化けする文字の後ろに「\」を付ける。以下は、Shift JIS で文字化けする文字の一覧。文字化けを起こしやすいよく使う文字は強調しておいた。文字 - Shift-JIS - Unicode での記述方法

―　　81 5C　　　―
ソ　　83 5C　　　ソ
Ы　　84 5C　　　Ы
Ⅸ　　87 5C　　　Ⅸ
噂　　89 5C　　　噂
浬　　8A 5C　　　浬
欺　　8B 5C　　　欺
圭　　8C 5C　　　圭
構　　8D 5C　　　構
蚕　　8E 5C　　　蚕
十　　8F 5C　　　十
申　　90 5C　　　申
曾　　91 5C　　　曾
箪　　92 5C　　　箪
貼　　93 5C　　　貼
能　　94 5C　　　能
表　　95 5C　　　表
暴　　96 5C　　　暴
予　　97 5C　　　予
禄　　98 5C　　　禄
兔　　99 5C　　　兔
喀　　9A 5C　　　喀
媾　　9B 5C　　　媾
彌　　9C 5C　　　彌
拿　　9D 5C　　　拿
杤　　9E 5C　　　杤
歃　　9F 5C　　　歃
濬　　E0 5C　　　濬
畚　　E1 5C　　　畚
秉　　E2 5C　　　秉
綵　　E3 5C　　　綵
臀　　E4 5C　　　臀
藹　　E5 5C　　　藹
觸　　E6 5C　　　觸
軆　　E7 5C　　　軆
鐔　　E8 5C　　　鐔
饅　　E9 5C　　　饅
鷭　　EA 5C　　　鷭
偆　　ED 5C　　　偆
砡　　EE 5C　　　砡

» 「Perl で、Shift JIS でスクリプトを保存するには?」の続きを読む

Posted on 2005-12-11 by yas |

Perl で、Google Maps からルートを検索する方法

米国に限られるが、Perl には Geo::Google というモジュールがある。このモジュールを利用すると Google Maps からルートを検索できる。以下は、サンフランシスコダウンタウンのユニオンスクウェアにあるヒルトンからPIER 39までのルート検索の結果を XML で出力する例。使用するモジュール

use Encode;
use Geo::Google;

#!/usr/bin/perl

use Encode;
use Geo::Google;

# 変数の初期化
our $GEO = new Geo::Google;
our $XML_HEADER = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
our $output     = '';    # xml 出力
our ($dist);

$dist->{from} = qq|333 Ofarrell St, San Francisco, CA|; # From の住所 (米国のみ)
$dist->{to  } = qq|39 PIER 39, San Francisco, CA|;      # To   の住所 (米国のみ)

$output = getPath($dist);
$output =    $XML_HEADER
        .    "<markers>\n"
        .    $output
        .    "</markers>\n";

print "Content-type: text/xml\n\n";    # XML を送るときは絶対にこれが必要!!! MUST!!!
print $output;

exit;

sub getPath {

    my ($dist) = shift;
    my $output;

    my $path = $GEO->path(getDegrees($dist->{from}), getDegrees($dist->{to}));
    my @segments = $path->segments();

    foreach my $s (@segments) {

        my $description = $s->text();
        $description =~ s/</&amp;lt;/g;
        $description =~ s/>/&amp;gt;/g;

        $output .= "\t<route\n"
                .  "\t\tdescription=\"" . $description . "\"\n"
                .  "\t/>\n";

        my @points = $s->points;
        foreach my $p (@points) {
            $output .= "\t<path lng=\"" . $p->longitude . "\" lat=\"" . $p->latitude . "\" />\n";
        }
    }
    return $output;
}

sub getDegrees {    #  住所から緯度経度を検索

    return $GEO->location( address => Encode::encode_utf8(shift));
                                                        # shift = address / リファレンスを返す
}

1;

Content-type: text/xml

<?xml version="1.0" encoding="UTF-8"?>
<markers>
    <route
        description="Head <b>east</b> from <b>Ofarrell St</b>"
    />
    <route
        description="Turn <b>left</b> at <b>Grant Ave</b>"
        />
    <path lng="-122.40966" lat="37.78621" />
    <path lng="-122.40932" lat="37.78628" />
    <path lng="-122.40894" lat="37.78632" />
    <path lng="-122.40803" lat="37.78644" />
    <path lng="-122.40639" lat="37.78663" />
    <path lng="-122.40529" lat="37.78676" />
    <path lng="-122.40485" lat="37.78683" />
    <path lng="-122.40485" lat="37.78683" />
    <route
        description="Turn <b>left</b> at <b>Sutter St</b>"
    />
    <path lng="-122.40504" lat="37.78774" />
    <path lng="-122.40513" lat="37.78819" />
    <path lng="-122.40524" lat="37.78870" />
    <path lng="-122.40530" lat="37.78913" />
    <path lng="-122.40533" lat="37.78931" />
    <path lng="-122.40539" lat="37.78964" />
    <path lng="-122.40539" lat="37.78964" />
</markers>

米国に限られるが、Perl には Geo::Google というモジュールがある。このモジュールを利用すると Google Maps からルートを検索できる。以下は、サンフランシスコダウンタウンのユニオンスクウェアにあるヒルトンからPIER 39までのルート検索の結果を XML で出力する例。使用するモジュール

use Encode;
use Geo::Google;

#!/usr/bin/perl

use Encode;
use Geo::Google;

# 変数の初期化
our $GEO = new Geo::Google;
our $XML_HEADER = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
our $output     = '';    # xml 出力
our ($dist);

$dist->{from} = qq|333 Ofarrell St, San Francisco, CA|; # From の住所 (米国のみ)
$dist->{to  } = qq|39 PIER 39, San Francisco, CA|;      # To   の住所 (米国のみ)

$output = getPath($dist);
$output =    $XML_HEADER
        .    "<markers>\n"
        .    $output
        .    "</markers>\n";

print "Content-type: text/xml\n\n";    # XML を送るときは絶対にこれが必要!!! MUST!!!
print $output;

exit;

sub getPath {

    my ($dist) = shift;
    my $output;

    my $path = $GEO->path(getDegrees($dist->{from}), getDegrees($dist->{to}));
    my @segments = $path->segments();

    foreach my $s (@segments) {

        my $description = $s->text();
        $description =~ s/</&amp;lt;/g;
        $description =~ s/>/&amp;gt;/g;

        $output .= "\t<route\n"
                .  "\t\tdescription=\"" . $description . "\"\n"
                .  "\t/>\n";

        my @points = $s->points;
        foreach my $p (@points) {
            $output .= "\t<path lng=\"" . $p->longitude . "\" lat=\"" . $p->latitude . "\" />\n";
        }
    }
    return $output;
}

sub getDegrees {    #  住所から緯度経度を検索

    return $GEO->location( address => Encode::encode_utf8(shift));
                                                        # shift = address / リファレンスを返す
}

1;

Content-type: text/xml

<?xml version="1.0" encoding="UTF-8"?>
<markers>
    <route
        description="Head <b>east</b> from <b>Ofarrell St</b>"
    />
    <route
        description="Turn <b>left</b> at <b>Grant Ave</b>"
        />
    <path lng="-122.40966" lat="37.78621" />
    <path lng="-122.40932" lat="37.78628" />
    <path lng="-122.40894" lat="37.78632" />
    <path lng="-122.40803" lat="37.78644" />
    <path lng="-122.40639" lat="37.78663" />
    <path lng="-122.40529" lat="37.78676" />
    <path lng="-122.40485" lat="37.78683" />
    <path lng="-122.40485" lat="37.78683" />
    <route
        description="Turn <b>left</b> at <b>Sutter St</b>"
    />
    <path lng="-122.40504" lat="37.78774" />
    <path lng="-122.40513" lat="37.78819" />
    <path lng="-122.40524" lat="37.78870" />
    <path lng="-122.40530" lat="37.78913" />
    <path lng="-122.40533" lat="37.78931" />
    <path lng="-122.40539" lat="37.78964" />
    <path lng="-122.40539" lat="37.78964" />
</markers>

» 「Perl で、Google Maps からルートを検索する方法」の続きを読む

Posted on 2005-12-08 by yas |

インターネット

Perl で、ハッシュ値 (ハッシュダイジェスト) を扱う:<br />コンテンツの内容が変更されたかどうかをチェックする方法

たとえば、あるウェブサイトのコンテンツ (ウェブページ) が変更されたかどうかをチェックする処理を考えてみる。Perl で、文字列比較を行う場合には if($a eq $b) {...} などとすればいいだろう。ただしこれは $a と $b が比較的「小さな」文字列であった場合である。それでは HTML などのデータで、以前アクセスしたときと今回アクセスしたときで内容が変更されているかどうかを効率的にチェックするにはどうしたらいいのだろう。1つの解法としては、ハッシュ関数を使うことが考えられる。Perl の変数で「ハッシュ」というものが出てくるが、こちらは「ハッシュ関数」である。ハッシュ関数としては、以前は MD5 というものが多く使われていたが、コンピュータの処理速度の向上によって相対的にセキュリティが低下したので、より安全な SHA1 を利用する。使用するクラス

use Digest::SHA1;

use Digest::SHA1 qw(sha1_hex);  # sha1_hex 関数をインポートしておく

my $content = "ここに HTML などのコンテンツが入る";
my $digest = sha1_hex($content); # コンテンツのハッシュ値 (16進数)
print $digest;

SHA1 は、もともとあるデータから 160ビット (20 バイト) の固定長の一意のデータを生成する。このデータを「ハッシュ値」と言っているが、ハッシュ値は元のデータが 1文字でも違えば、値自体もまったく違うものとなることが約束されている。また、ハッシュ値から元のデータは復元できないようになっている (これを一方向関数という)。Digest::SHA1 モジュールには単に my $data = sha1($content); とすればハッシュ値をバイナリで出力してくれるが、視覚的に見たい場合、文字列として処理する場合 (たとえばファイル名にこのハッシュ値を使うこともできる) は sha1_hex を使う。sha1_hex を使った場合はハッシュ値が 16進数の文字列として出力されるため、固定長 40バイトのデータとなる。この方法は特にPerl だけにできるということではなく、言語を問わず、ハッシュ関数が用意されている Java や PHP にも使える。

参考リンク

Digest::SHA1 - SHA-1アルゴリズムへのPerlインターフェース

たとえば、あるウェブサイトのコンテンツ (ウェブページ) が変更されたかどうかをチェックする処理を考えてみる。Perl で、文字列比較を行う場合には if($a eq $b) {...} などとすればいいだろう。ただしこれは $a と $b が比較的「小さな」文字列であった場合である。それでは HTML などのデータで、以前アクセスしたときと今回アクセスしたときで内容が変更されているかどうかを効率的にチェックするにはどうしたらいいのだろう。1つの解法としては、ハッシュ関数を使うことが考えられる。Perl の変数で「ハッシュ」というものが出てくるが、こちらは「ハッシュ関数」である。ハッシュ関数としては、以前は MD5 というものが多く使われていたが、コンピュータの処理速度の向上によって相対的にセキュリティが低下したので、より安全な SHA1 を利用する。使用するクラス

use Digest::SHA1;

use Digest::SHA1 qw(sha1_hex);  # sha1_hex 関数をインポートしておく

my $content = "ここに HTML などのコンテンツが入る";
my $digest = sha1_hex($content); # コンテンツのハッシュ値 (16進数)
print $digest;

SHA1 は、もともとあるデータから 160ビット (20 バイト) の固定長の一意のデータを生成する。このデータを「ハッシュ値」と言っているが、ハッシュ値は元のデータが 1文字でも違えば、値自体もまったく違うものとなることが約束されている。また、ハッシュ値から元のデータは復元できないようになっている (これを一方向関数という)。Digest::SHA1 モジュールには単に my $data = sha1($content); とすればハッシュ値をバイナリで出力してくれるが、視覚的に見たい場合、文字列として処理する場合 (たとえばファイル名にこのハッシュ値を使うこともできる) は sha1_hex を使う。sha1_hex を使った場合はハッシュ値が 16進数の文字列として出力されるため、固定長 40バイトのデータとなる。この方法は特にPerl だけにできるということではなく、言語を問わず、ハッシュ関数が用意されている Java や PHP にも使える。

参考リンク

Digest::SHA1 - SHA-1アルゴリズムへのPerlインターフェース

» 「Perl で、ハッシュ値 (ハッシュダイジェスト) を扱う:<br />コンテンツの内容が変更されたかどうかをチェックする方法」の続きを読む

Posted on 2005-12-07 by yas |

Perl で、メールサーバに送られてきたメールを処理する

Procmail を利用すればサーバに送られてきたメールが標準入力から Perl スクリプトに渡すことができる。ここでは Procmail の詳細は割愛するが、以下は標準入力に入っているメールを処理する関数。使用するクラス

use MIME::Parser;
use MIME::Base64;
use Mail::Address;

use MIME::Parser;
use MIME::Base64;
use Mail::Address;
use Unicode::Japanese;

my ($mail) = &parse;
print "From: " . $mail->{sender} . "\n";
print "To: " . $mail->{recipient} . "\n";
print "Subject: " . $mail->{subject} . "\n";

sub parse {

    my ($mail);

    # Parser Setting
    my $parser = new MIME::Parser;
    $parser->output_to_core(1);    # Keeps body analyzed internally
    $parser->tmp_recycling (1);    # Recycles the temporary stuff

    my $entity = $parser->parse(\*STDIN) or die "Parse Error in __FILE__\n";

    # Headers
    $mail->{sender   } =  $entity->head->get('from'   );
    $mail->{subject  } =  $entity->head->get('subject');
    $mail->{recipient} =  $entity->head->get('to'     );
    $mail->{recipient} =~ s/\n//g;

    # From
    @addrs = Mail::Address->parse($mail->{sender});
    foreach $addr (@addrs) {
        $mail->{sender} = $addr->address if $addr->address; # USE CAUTION, for the multiple address
    }

    # Subject
    my $subject = $mail->{subject};
    $lws      = '(?:(?:\x0D\x0A|\x0D|\x0A)?[ \t])+';
    $ew_regex = '=\?ISO-2022-JP\?B\?([A-Za-z0-9+/]+=*)\?=';
    $subject  =~ s/\n//g;
    $subject  =~ s/($ew_regex)$lws(?=$ew_regex)/$1/gio;
    $subject  =~ s/$lws/ /go;
    $subject  =~ s/$ew_regex/decode_base64($1)/egio;
    $subject  = Unicode::Japanese->new($subject, 'auto')->sjis_imode;
    $mail->{subject} = $subject;

    # Get MIME
    ($mail->{body}, $mail->{filename}, $mail->{mimetype}, $mail->{object}) = &getEntities($entity);
    $mail->{body   } =  Unicode::Japanese->new($mail->{body}, 'auto')->sjis_imode;
    $mail->{body   } =~ s/[ 　\n\r]+$//g;    # Delete the white spaces in the end of the line
    $mail->{subject} =~ s/[ 　\n\r]+$//g;    # Delete the white spaces in the end of the line

    return $mail;
}

sub getEntities {

    my $entity = shift;
    my $body, $filename, $mimetype, $object;

    # BODY
    my @parts = $entity->parts;
    if (@parts) {                   # multipart...

        my $i;
        foreach $i (0 .. $#parts) { # dump each part...

            &getEntities($parts[$i]);
        }
    } else {                        # single part...

        # Get MIME type, and display accordingly...
        my ($type, $subtype) = split('/', $entity->head->mime_type);
        my $bodyhandle = $entity->bodyhandle;

        if ($type =~ /^(text|message)$/) {      # text

            $body .= $bodyhandle->as_string;

        } else {                                # binary

            $filename= $entity->head->recommended_filename;
            $mimetype = $entity->head->mime_type;
            $object = $bodyhandle->as_string;
            binmode($object);
            # if we want to store it as BASE64, you can continue the processs here
        }
    }

    return ($body, $filename, $mimetype, $object);
}

1;

Procmail を利用すればサーバに送られてきたメールが標準入力から Perl スクリプトに渡すことができる。ここでは Procmail の詳細は割愛するが、以下は標準入力に入っているメールを処理する関数。使用するクラス

use MIME::Parser;
use MIME::Base64;
use Mail::Address;

use MIME::Parser;
use MIME::Base64;
use Mail::Address;
use Unicode::Japanese;

my ($mail) = &parse;
print "From: " . $mail->{sender} . "\n";
print "To: " . $mail->{recipient} . "\n";
print "Subject: " . $mail->{subject} . "\n";

sub parse {

    my ($mail);

    # Parser Setting
    my $parser = new MIME::Parser;
    $parser->output_to_core(1);    # Keeps body analyzed internally
    $parser->tmp_recycling (1);    # Recycles the temporary stuff

    my $entity = $parser->parse(\*STDIN) or die "Parse Error in __FILE__\n";

    # Headers
    $mail->{sender   } =  $entity->head->get('from'   );
    $mail->{subject  } =  $entity->head->get('subject');
    $mail->{recipient} =  $entity->head->get('to'     );
    $mail->{recipient} =~ s/\n//g;

    # From
    @addrs = Mail::Address->parse($mail->{sender});
    foreach $addr (@addrs) {
        $mail->{sender} = $addr->address if $addr->address; # USE CAUTION, for the multiple address
    }

    # Subject
    my $subject = $mail->{subject};
    $lws      = '(?:(?:\x0D\x0A|\x0D|\x0A)?[ \t])+';
    $ew_regex = '=\?ISO-2022-JP\?B\?([A-Za-z0-9+/]+=*)\?=';
    $subject  =~ s/\n//g;
    $subject  =~ s/($ew_regex)$lws(?=$ew_regex)/$1/gio;
    $subject  =~ s/$lws/ /go;
    $subject  =~ s/$ew_regex/decode_base64($1)/egio;
    $subject  = Unicode::Japanese->new($subject, 'auto')->sjis_imode;
    $mail->{subject} = $subject;

    # Get MIME
    ($mail->{body}, $mail->{filename}, $mail->{mimetype}, $mail->{object}) = &getEntities($entity);
    $mail->{body   } =  Unicode::Japanese->new($mail->{body}, 'auto')->sjis_imode;
    $mail->{body   } =~ s/[ 　\n\r]+$//g;    # Delete the white spaces in the end of the line
    $mail->{subject} =~ s/[ 　\n\r]+$//g;    # Delete the white spaces in the end of the line

    return $mail;
}

sub getEntities {

    my $entity = shift;
    my $body, $filename, $mimetype, $object;

    # BODY
    my @parts = $entity->parts;
    if (@parts) {                   # multipart...

        my $i;
        foreach $i (0 .. $#parts) { # dump each part...

            &getEntities($parts[$i]);
        }
    } else {                        # single part...

        # Get MIME type, and display accordingly...
        my ($type, $subtype) = split('/', $entity->head->mime_type);
        my $bodyhandle = $entity->bodyhandle;

        if ($type =~ /^(text|message)$/) {      # text

            $body .= $bodyhandle->as_string;

        } else {                                # binary

            $filename= $entity->head->recommended_filename;
            $mimetype = $entity->head->mime_type;
            $object = $bodyhandle->as_string;
            binmode($object);
            # if we want to store it as BASE64, you can continue the processs here
        }
    }

    return ($body, $filename, $mimetype, $object);
}

1;

» 「Perl で、メールサーバに送られてきたメールを処理する」の続きを読む

Posted on 2005-12-06 by yas |

Perl で、Shift JIS でスクリプトを保存するには?

Perl で、Google Maps からルートを検索する方法

Perl で、ハッシュ値 (ハッシュダイジェスト) を扱う:<br />コンテンツの内容が変更されたかどうかをチェックする方法

Perl で、メールサーバに送られてきたメールを処理する

本日の上位：

総合の上位：

最近の参照：