Perl

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;
続きを読む

Perl で、文字コードの自動判定をする

たとえば、LWP::UserAgent で取得した RSS (= XML ファイル) の文字コードの自動判定 (エンコーディングの自動判定) を行うには、以下のようにする。

#!/usr/bin/perl use Encode::Guess; use LWP::UserAgent; use HTTP::Request; my $url = 'https://perltips.twinkle.cc/index.rdf'; my $proxy = new LWP::UserAgent; my $req = new HTTP::Request(GET=>$url); my $res = $proxy->request($req); my $xml = $res->content; my $enc = guess_encoding($xml, qw/euc-jp shiftjis 7bit-jis utf8/); ref($enc) or die "Can't guess: $enc"; # 自動判定に失敗したときのエラー処理 $xml = decode($enc->name, $xml); # utf8 で保存 ...
続きを読む

Perl で、住所から緯度経度を取得する方法

Geo::Google モジュールを利用する (米国)。住所を渡せばコーディング的にはほとんど 1行で緯度経度を返してくれる。Google Maps にアクセスしにいって緯度経度を取ってきていてるので、地図データベースは Google Maps のものである。以前紹介した PHP のときのように SOAP も何もいらない (Geo::Google は、内部で LWP::Simple を利用している)。PHP の Geocoder 版は、Geocoder のデータベースに SOAP 経由でアクセスする。少し使ってみた結果、Geocoder のデータベースは少しズレが生じるようである (米国の場合)


use utf8;
use Encode;
use Geo::Google;
use XML::Parser;
#!/usr/bin/perl use utf8; use Encode; use Geo::Google; use XML::Parser; my $lng, $lat; my $address1 = 'your address part 1 here'; my $address2 = 'your address part 2 here'; my ($degree) = getDegrees("$address1 $address2"); if($degree) {
$lng = $degree->longitude;
$lat = $degree->latitude;
} else {
$lng = ''; $lat = '';
} sub getDegrees { # 住所から緯度経度を検索
return $GEO->location( address => Encode::encode_utf8(shift));
                                                    # shift = address / リファレンスを返す
}
続きを読む

Perl で、アップロードしたファイルを処理する

Perl の場合は、CGI として動作させる場合は、必ず


print qq|Content-type: text/html\n\n|;

という行が必要な以外は、PHP とほとんど同じである。 アップロードには、いつも使っているおなじみの CGI モジュールを使う。


use CGI;

そうすると、以下のようにアクセスできる。


our $CGI = new CGI;
...
my $xml = $CGI->param('file');

$xml はファイルポインタが入っている。通常は open(IN, "..."); などするときの IN にあたるものである。以下は、コード。アップロードする側の HTML ファイルは PHP でアップロードファイルを処理するで紹介したのと同じ。

#!/usr/bin/perl use strict; use CGI; our $CGI = new CGI; print qq|Content-type: text/html\n\n|; init(); sub init() {
# XMLパーサー作成 ('UTF-8')
my $xml_parser = new XML::Parser(    ProtocolEncoding => 'UTF-8',
                                    Handlers=>{    Start=>\&startElement,
                                                End  =>\&endElement,
                                                Char =>\&dataHandler    });
# ファイルのオープンはいらない。input タグで指定した name 属性がそのままファイルハンドルになる
my $xml = $CGI->param('file');

# XMLパース処理
$xml_parser->parse($xml) or    die "XML error: $xml_parser";

# ファイルクローズ
close($xml);
} 1;
続きを読む

Perl で、HTML 文書中にあるリンクを置換する

以下は、HTML 文書中にあるリンクを任意の文字列に置換するスクリプトであるが、他のタグでもいろいろと応用が利くと思われる。

#!/usr/bin/perl use LWP::UserAgent; use HTTP::Status; use HTTP::Response; our $URL = 'https://perltips.twinkle.cc/'; # アクセスする URL my $proxy = new LWP::UserAgent; $proxy->agent('your own created browser name here'); $proxy->timeout(60); my $response = $proxy->request(HTTP::Request->new('GET' => $URL)); my $content = $response->content; my %tags = (
'img'  => 'src',
'a'    => 'href',
'link' => 'href',
'td'   => 'background',
'form' => 'action'
); my $data = $content; skip_others: while($data =~ s/<([^>]*)>// && $i++ < 10000) { # 無限ループに陥るのを防ぐ <pre>my $in_brackets = $1; foreach $key (keys %tags) { if($in_brackets =~ /^\s*$key\s+/i) { if($in_brackets =~ /\s+$tags{$key}\s*=\s*["']([^"']*)["']/i || $in_brackets =~ /\s+$tags{$key}\s*=\s*([^\s]+)/i ) { my $link = $1; $link =~ s/[\n\r]//g; $link =~ s/\./\\./g; $link =~ s/\?/\\?/g; $content =~ s/\s*=\s*["']*$link["']*/=<<<ここに置換文字列を書く>>>/ if $link !~ m/mailto:/i && $link !~ m/javascript/i; next skip_others; } } } } 1;
続きを読む

Perl で、ライブラリのパスを指定する方法

いくつか方法がある。

方法1: use lib 'ライブラリのあるパス'; use Foo::Bar; ... 方法2: unshift @INC, 'ライブラリのあるパス'; use Foo::Bar; ... とかして、強制的に @INC に入れる。 方法3: スクリプト中で強制的にインクルードするライブラリへのパスを含めちゃう (スクリプトの先頭、おなじみ #!/usr/bin/perl の部分に -I オプションを付ける) #!/usr/bin/perl -I/home/yourdir/lib … 方法4: perl -e shell -MCPAN じゃなくてアーカイブのやつをインストールするには、
ライブラリの tar.gz を解凍して # perl Makefile.PL PREFIX=/home/yourname/yourdir/lib # make install とかする。PREFIX= でインストール先を指定できる。 Perl のライブラリには必ず Makefile.PL というファイルが入っているから
PREFIX オプションを指定してダメだった場合、このファイルの中身をチェックする必要がある。
続きを読む

Perl で、#!/usr/bin/perl -w とは?

起動時のオプション -w スイッチは、警告を出すようにする。なので、スクリプト開発フェーズではスクリプトの先頭に以下のように書くこと。

#!/usr/bin/perl -w # Your own logic from here
続きを読む

Perl で、セッション管理をしたい。 (Apache::Session)

Apache::Session を使う。 パフォーマンスを少し測ってみたら CGI::Session よりも若干速いようである。

このモジュールは eval {...}; とセットで使うとよい。 - Perl で、例外処理をするような感じのもの。if($@) {...} のセットで使う。eval にはセミコロン(;) を忘れないこと。

例では、%session を $session としてハッシュで返している。
このモジールを使う利点は、ID の長さを自由に変えられることである。CGI::Session の場合は、ID の長さを変えたければ、自分で書かなければならない。一方で短所は、セッションの有効期限を設定できないこと。そのため、MySQL 中のsessions テーブルに timestamp フィールドを独自に追加して、自身の CGI の中か cron で適宜 reap する必要がある。また、セッションオブジェクト中の個別のデータにも有効期限を設けることはできない (CGI::Session はできる)。それでもこのモジュールが良いのは、パフォーマンスが CGI::Session よりも若干良いのと、ID の長さを変えられるからである。


use DBI;
use Apache::Session;

このモジュールは永続ストレージ (要はセッション情報をずっと溜めておけるデータベース) の種類によっていろいろな種類がある。


Apache::Session::MySQL
Apache::Session::Postgres
Apache::Session::File
Apache::Session::Oracle
Apache::Session::Sybase
Apache::Session::DB_File
Apache::Session::Flex 	実行時にすべてのパラメータを指定する

以下の例では Apache::Session::Flex を使っている。

use DBI; use Apache::Session::Flex; $session = _getSession; print $session->{_sessin_id} sub _getSession {
my $db;
my ($database, $username, $password);
# 以上の変数には値を入れること。

$db = DBI->connect("DBI:mysql:$databasename",
                             $username,
                             $password
                             ) || die 'Cannot connect db';
eval {
tie %session, 'Apache::Session::Flex', $sid, {

    Store      => 'MySQL',
    Lock       => 'MySQL',
    Generate   => 'MD5',
    IDLength   => 32,
    Serialize  => 'Storable',
    Handle     => $db,
    LockHandle => $db,
};
}; # セミコロンを忘れないこと if($@) { # $@: error message of eval
return undef;
} # セッション ID の取得に成功。ここに処理を書く。
return \%session;
}
続きを読む
Perl を購読