シリコンバレー在住エンジニアの、Perl、PHP、AJAX、Drupal、Java の小枝集です。( 7,842,664 since 2005.02.20 )
Perl で、Google Maps からルートを検索する方法
米国に限られるが、Perl には Geo::Google というモジュールがある。このモジュールを利用すると Google Maps からルートを検索できる。以下は、サンフランシスコダウンタウンのユニオンスクウェアにあるヒルトンからPIER 39までのルート検索の結果を XML で出力する例。
使用するモジュール
米国に限られるが、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/</&lt;/g;
$description =~ s/>/&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>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/</&lt;/g;
$description =~ s/>/&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 で、ハッシュ値 (ハッシュダイジェスト) を扱う:<br />コンテンツの内容が変更されたかどうかをチェックする方法
たとえば、あるウェブサイトのコンテンツ (ウェブページ) が変更されたかどうかをチェックする処理を考えてみる。Perl で、文字列比較を行う場合には if($a eq $b) {...} などとすればいいだろう。ただしこれは $a と $b が比較的「小さな」文字列であった場合である。それでは HTML などのデータで、以前アクセスしたときと今回アクセスしたときで内容が変更されているかどうかを効率的にチェックするにはどうしたらいいのだろう。1つの解法としては、ハッシュ関数を使うことが考えられる。Perl の変数で「ハッシュ」というものが出てくるが、こちらは「ハッシュ関数」である。ハッシュ関数としては、以前は MD5 というものが多く使われていたが、コンピュータの処理速度の向上によって相対的にセキュリティが低下したので、より安全な SHA1 を利用する。
使用するクラス
SHA1 は、もともとあるデータから 160ビット (20 バイト) の固定長の一意のデータを生成する。このデータを「ハッシュ値」と言っているが、ハッシュ値は元のデータが 1文字でも違えば、値自体もまったく違うものとなることが約束されている。また、ハッシュ値から元のデータは復元できないようになっている (これを一方向関数という)。Digest::SHA1 モジュールには単に my $data = sha1($content); とすればハッシュ値をバイナリで出力してくれるが、視覚的に見たい場合、文字列として処理する場合 (たとえばファイル名にこのハッシュ値を使うこともできる) は sha1_hex を使う。sha1_hex を使った場合はハッシュ値が 16進数の文字列として出力されるため、固定長 40バイトのデータとなる。
この方法は特にPerl だけにできるということではなく、言語を問わず、ハッシュ関数が用意されている Java や PHP にも使える。
たとえば、あるウェブサイトのコンテンツ (ウェブページ) が変更されたかどうかをチェックする処理を考えてみる。Perl で、文字列比較を行う場合には if($a eq $b) {...} などとすればいいだろう。ただしこれは $a と $b が比較的「小さな」文字列であった場合である。それでは HTML などのデータで、以前アクセスしたときと今回アクセスしたときで内容が変更されているかどうかを効率的にチェックするにはどうしたらいいのだろう。1つの解法としては、ハッシュ関数を使うことが考えられる。Perl の変数で「ハッシュ」というものが出てくるが、こちらは「ハッシュ関数」である。ハッシュ関数としては、以前は MD5 というものが多く使われていたが、コンピュータの処理速度の向上によって相対的にセキュリティが低下したので、より安全な SHA1 を利用する。
使用するクラス
SHA1 は、もともとあるデータから 160ビット (20 バイト) の固定長の一意のデータを生成する。このデータを「ハッシュ値」と言っているが、ハッシュ値は元のデータが 1文字でも違えば、値自体もまったく違うものとなることが約束されている。また、ハッシュ値から元のデータは復元できないようになっている (これを一方向関数という)。Digest::SHA1 モジュールには単に my $data = sha1($content); とすればハッシュ値をバイナリで出力してくれるが、視覚的に見たい場合、文字列として処理する場合 (たとえばファイル名にこのハッシュ値を使うこともできる) は sha1_hex を使う。sha1_hex を使った場合はハッシュ値が 16進数の文字列として出力されるため、固定長 40バイトのデータとなる。
この方法は特にPerl だけにできるということではなく、言語を問わず、ハッシュ関数が用意されている Java や PHP にも使える。
use Digest::SHA1;
use Digest::SHA1 qw(sha1_hex); # sha1_hex 関数をインポートしておく
my $content = "ここに HTML などのコンテンツが入る";
my $digest = sha1_hex($content); # コンテンツのハッシュ値 (16進数)
print $digest;use Digest::SHA1;
use Digest::SHA1 qw(sha1_hex); # sha1_hex 関数をインポートしておく
my $content = "ここに HTML などのコンテンツが入る";
my $digest = sha1_hex($content); # コンテンツのハッシュ値 (16進数)
print $digest;
Perl で、メールサーバに送られてきたメールを処理する
Procmail を利用すればサーバに送られてきたメールが標準入力から Perl スクリプトに渡すことができる。ここでは Procmail の詳細は割愛するが、以下は標準入力に入っているメールを処理する関数。
使用するクラス
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;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 で、RSS で配信されたエントリーの日付を処理する
HTTP::Date クラスを使うと RSS で配信されたエントリーの日付 (dc:date) を変換してくれる。この場合、RSS のソースによって米国から日本のニュースにアクセスした場合などは、時差 (タイムゾーン) を考慮する必要があるため注意する。
使用するクラス
use HTTP::Date;
#!/usr/bin/perl
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Date;
# 初期化
my $html;
my $timezone = 'JST';
my $url = 'https://www.yoursite.com/index.rdf';
my $rss = new XML::RSS;
my $proxy = new LWP::UserAgent; # UseAgent の作成
my $req = new HTTP::Request(GET=>$url);
my $res = $proxy->request($req); # $url にアクセスする
my $xml = $res->content; # コンテンツ (この場合は RSS/XML) を取得
# RSS を解析
eval {
$rss->parse($xml);
};
if($@) {
# $rss->parse が失敗したとき
}
# @{$rss->{items}} に、RSS のすべてのエントリー (item) が入る
foreach my $item ( @{$rss->{items}} ) {
my $date = HTTP::Date::str2time($item->{dc}->{date}, $timezone);
$html .= qq|<a href=$item->{link}>$item->{title}</a><br>\n|; # タイトルをリンクつきで出力
$html .= qq|$description<br>| if $item->{description}; # 概要 (description) を出力
$html .= qq|[<a href=$item->{link}>続きを読む</a>]<hr size=1>\n|;
}
print $html;
1;
参考リンク
HTTP::Date クラスを使うと RSS で配信されたエントリーの日付 (dc:date) を変換してくれる。この場合、RSS のソースによって米国から日本のニュースにアクセスした場合などは、時差 (タイムゾーン) を考慮する必要があるため注意する。
使用するクラス
use HTTP::Date;
#!/usr/bin/perl
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Date;
# 初期化
my $html;
my $timezone = 'JST';
my $url = 'https://www.yoursite.com/index.rdf';
my $rss = new XML::RSS;
my $proxy = new LWP::UserAgent; # UseAgent の作成
my $req = new HTTP::Request(GET=>$url);
my $res = $proxy->request($req); # $url にアクセスする
my $xml = $res->content; # コンテンツ (この場合は RSS/XML) を取得
# RSS を解析
eval {
$rss->parse($xml);
};
if($@) {
# $rss->parse が失敗したとき
}
# @{$rss->{items}} に、RSS のすべてのエントリー (item) が入る
foreach my $item ( @{$rss->{items}} ) {
my $date = HTTP::Date::str2time($item->{dc}->{date}, $timezone);
$html .= qq|<a href=$item->{link}>$item->{title}</a><br>\n|; # タイトルをリンクつきで出力
$html .= qq|$description<br>| if $item->{description}; # 概要 (description) を出力
$html .= qq|[<a href=$item->{link}>続きを読む</a>]<hr size=1>\n|;
}
print $html;
1;
参考リンク
