細かいことは後日、アナウンスさせて頂きますが、WordCamp Tokyo 2011でWordPressのプラグイン開発についてのセッションをさせていただくことになりました。
Category Archives: Perl
Webサーバーの稼働状況を定期的にチェックする
先日データーセンターでネットワークトラブルがあって、そのトラブルそのものはうちの問題ではなかったので、おまかせにしていたら数時間で復旧したのだが、トラブルに弊社が気づくのが遅れてしまい、お客様に余計な心配をかけてしまった。
そんなわけで、外部のサーバーからWebサーバーの稼働状況を監視するPerlスクリプトを作成して、Cronでぶんまわすことにした。
仕組み
仕組みはとても簡単で、ざっと以下のような感じ。
- コマンドライン引数に渡されたURLに対してwgetを実行する。
- 実行した結果を評価して、エラーがあればメールを送信する。
という感じ。
wgetコマンドを実行する際に実際にファイルをダウンロードしちゃうと面倒なので、以下のようなオプションをつけた。
my $com = "/usr/bin/wget -q -o /dev/null --spider '".$url."'";
ちなみに、pingだとネットワークトラブルしか検出できないが、wgetならネットワークが生きていてapacheが死んでるなんていうシチュエーションも拾ってくれる。
使い方
以下のように、このPerlスクリプトにURLを引数で渡して、Cronに登録する。
*/10 * * * * /path/to/lifecheck.pl http://www.example.com/
ちなみに、Cronに自前スクリプトを登録する際は環境変数によって挙動が変わったりするので、以下のように環境変数をundefしちゃうと都合が良いと個人的に思うのだが。みんなはどうしているんだろう?
undef %ENV;
ソース
以下のソースをコピペして、lifecheck.plというファイル名で任意のパスに保存する。
#!/usr/bin/perl -wT
undef %ENV;
use strict;
use warnings;
use Encode;
use utf8;
use Mail::Sendmail;
my $from = 'admin@example.com';
my $to = 'you@example.com';
my $reg = q{^https?://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+$};
my $in = shift @ARGV;
my $url = '';
if ($in =~ /($reg)/) {
$url = $1;
}
if (!$url) {
die('url?');
}
$url =~ s/'/'\''/g;
my $com = "/usr/bin/wget -q -o /dev/null --spider '".$url."'";
system($com);
if ($?) {
&mailto(
$from,
$to,
'['.$url.'] Alert',
"Can not connect Web Server.\nPlease check below.\n".$url
);
}
sub mailto
{
my ($from, $to, $subject, $body) = @_;
$subject = encode('MIME-Header-ISO_2022_JP', $subject);
$body = encode('iso-2022-jp', $body);
my %mail;
$mail{'Content-Type'} = 'text/plain; charset="iso-2022-jp"';
$mail{'From'} = $from;
$mail{'To'} = $to;
$mail{'Subject'} = $subject;
$mail{'message'} = $body."\n";
sendmail %mail;
}
Perlでキーワード検索&公式リツイートを行うbot
ご注意!
ここでご紹介しているスクリプトは、Twitter API の仕様変更により現在は動作しません!(2010/09/06)
以前に書いた記事「キーワード検索したつぶやきをRTするTwitter用bot」で、特定のキーワードにマッチする記事をRTするスクリプトを紹介したが、その後、みなさん御存知の通りTwitterには公式リツイートという仕組みが導入された。
というわけで、以前の記事のスクリプトを以下のように修正することで、公式なリツイートに対応できる。
#!/opt/local/bin/perl -wT
#binmode(STDOUT, ":utf8");
use strict;
use Encode;
use Net::Twitter;
use URI::Escape;
use LWP::Simple;
use XML::DOM;
# Config
my $twitter_user = ''; # twitterユーザー名
my $twitter_pass = ''; # twitterパスワード
my $lang = 'ja';
my $api = 'http://search.twitter.com/search.atom';
# do not need to edit
my $twt_clientname = 'twitbot';
my $twt_clientver = '0.1';
my $twt_clienturl = 'http://www.theta.ne.jp/';
my $max_length = 140;
my $home;
if (-d $ENV{'HOME'} && $ENV{'HOME'} =~ /^(\/.+)$/) {
$home = $1;
}
my $log = $home.'/.twitbot.txt'; # 最新のIDを保存して次回以降はこのID以下は無視
if (!-e $log) {
open (OUT, ">", $log);
close(OUT);
}
my $max_id = 0;
open (IN, "<", $log);
my $n = <IN>;
if ($n) {
chomp $n;
$max_id = $n;
}
close(IN);
# connect to twitter
my $twt = Net::Twitter->new(
username => $twitter_user,
password => $twitter_pass,
clientname => $twt_clientname,
clienturl => $twt_clienturl,
useragent => $twt_clientname,
source => $twt_clientname,
clientver => $twt_clientver,
);
my $sch = $twt->saved_searches();
my %posted;
my $since = $max_id;
foreach (@$sch) {
my $k = uri_escape_utf8($_->{query});
my $url = $api.'?show_user=true&q='.$k.'&lang='.$lang;
my $atom = get($url);
my $parser = new XML::DOM::Parser;
my $doc = $parser->parse ($atom);
my $nodes = $doc->getElementsByTagName ("entry");
for (my $i=0; $i<$nodes->getLength; $i++) {
my $node = $nodes->item($i);
my $txt = getvalue($node, 'title');
my $id = getvalue($node, 'id');
if ($id =~ /([0-9]+)$/) {
$id = $1;
} else {
die ('can not get id');
}
if ($max_id < $id) {
$max_id = $id;
}
# 以下に該当するものはRTしない
# 自分の投稿
# RT(スペース)が含まれる投稿
# @が含まれる投稿
# すでにRTした投稿
# ログに保存されたIDより古い投稿
if ($txt !~ /^$twitter_user/ && $txt !~ /RT\s/ && $txt !~ /\@/ && !$posted{$id} && $since < $id) {
$posted{$id} = 1; # 重複投稿しないためのフラグ
# my $post = 'RT @'.$txt;
# $post = decode_utf8($post);
# if (length($post) > $max_length) {
# $post = substr($post, 0, 137)."...";
# }
# print $post."\n";
# print "----\n";
eval {$twt->retweet($id)};
if ($@) {
warn "update failed because: ".$@."\n";
}
}
}
}
open (OUT, ">", $log);
print OUT $max_id;
close(OUT);
exit;
sub getvalue {
my $node = shift @_;
my $tag = shift @_;
my $n = $node->getElementsByTagName($tag)->item(0);
return $n->getFirstChild->getNodeValue;
}
perlのMail::Sendmailによるメール送信
perlでメールを送信する場合、多くの場合ではsendmailコマンドにパイプでデータを渡してメールを送信するが、この方法はセキュリティ上好ましくない。
そこで、Mail::Sendmailを使用した方法を以下のとおりご紹介。
ちなみに、Mail::Sendmailwo使用すれば、SMTPサーバー経由でのメール送信も簡単に実装できるが、今回ご紹介するソースは従来の方法の代替策としての方法。
#!/usr/bin/perl -wT
use strict;
use warnings;
use Encode;
use utf8;
use Mail::Sendmail;
# フォームデータの処理や入力チェックなど
&mailto($from, $to, 'Hello', 'World!'); # メール送信
sub mailto{
my ($from, $to, $subject, $body) = @_;
$subject = encode('MIME-Header-ISO_2022_JP', $subject);
$body = encode('iso-2022-jp', $body);
my %mail;
$mail{'Content-Type'} = 'text/plain; charset="iso-2022-jp"';
$mail{'From'} = $from;
$mail{'To'} = $to;
$mail{'Subject'} = $subject;
$mail{'message'} = $body."\n";
sendmail %mail;
}
twitterでフォローのお礼&フォロー返し
ご注意!
ここでご紹介しているスクリプトは、Twitter API の仕様変更により現在は動作しません!(2010/09/06)
twitter apiでフォローされたらそのメールをsmtpサーバーでキックして、フォロー返し&お礼を送信するbotを作成した。
当初は、cronでやっていたのだが、フォロワー一覧を取得するためのAPIがとても不安定だったのと、複数アカウントに対応するのに負荷を軽減したかったので、メールでキックする方法に変更した。
ちなみに、昨日の時点ではGoogle app engineを使おうと思ったのだが、あっさり気が変わった。
smtpサーバーの設定
今回はpostfixを使用した。
/etc/postfix/main.cfなどで正規表現を使ったエイリアスを設定するのがポイント。
詳細は省きます。
ソース(Perl)
標準入力から渡されたメールをパースして、ユーザー名、フォロワーなどを取得して、フォロー返し&お礼を送信する。
今回はフォローメール以外は何もしていないが、標準入力で渡されたメールをsendmailにパイプで渡せば転送できるような気がする。(スパムフィルターには引っかかるかも。)
複数アカウントに対応していますので、user01という記述がある当たりを修正してください。
あと、スパマーをフォローしないようにタイムゾーンでチェックしていますが、これでは不十分だと思いますので、今後工夫が必要ではないかと思います。
#!/usr/bin/perl -wT
binmode(STDOUT, ":utf8");
use strict;
use warnings;
use Encode;
use Net::Twitter;
use MIME::Parser;
# Config
my %user;
$user{'user01'} = 'pass';
$user{'user02'} = 'pass';
$user{'user03'} = 'pass';
my $tmp = '/tmp';
my $msg = '@%s フォローありがとうございます!よろしくお願いいたします。';
my $twt_clientname = 'thanksbot';
my $twt_clientver = '0.1';
my $twt_clienturl = 'http://www.theta.ne.jp/';
# end config
my @mail = <STDIN>;
my $parser = new MIME::Parser;
$parser->output_dir($tmp);
my $entity = $parser->parse_data(join("", @mail));
my $header = $entity->head;
# get the $uid
my $uid = $header->get("X-Twitterrecipientscreenname");
chomp $uid;
# get the mail type
my $type = $header->get('X-TwitterEmailType');
chomp $type;
if ($type ne 'is_following') {
exit;
}
# get the sender
my $sender = $header->get('X-Twittersenderscreenname');
chomp $sender;
my $twt = Net::Twitter->new(
username => $uid,
password => $user{$uid},
clientname => $twt_clientname,
clienturl => $twt_clienturl,
useragent => $twt_clientname,
source => $twt_clientname,
clientver => $twt_clientver,
);
my $stat = $twt->show_user($sender);
my %st = %$stat;
if ($st{'time_zone'} eq 'Tokyo' || $st{'time_zone'} eq 'Osaka') {
my $exts = $twt->friendship_exists($uid, $sender);
if (!$exts) {
my $post = sprintf($msg, $sender);
$post = decode_utf8($post);
if ($twt->create_friend($sender)) {
$twt->update($post);
}
}
}
exit;
もう少しエラー処理とかした方がいいんでしょうけどね。ご愛嬌です。
テキストをひらがなに変換する(Perl)
以前の記事でtwitterのタイムラインを取得して音声出力するという記事を書いただが、音声出力させるまでの過程の中で、ひらがなに変換する必要があり、Yahoo日本語形態素解析を利用して変換していた。
よくかんがえたら、このYahoo日本語形態素解析は他にも使うことがあるかもしれないということで、標準入力(STDIN)からうけとったテキストをひらがなに変換するだけのPerlスクリプトを、覚え書きがわりにつくった。
#!/usr/bin/perl -wT
undef %ENV;
use strict;
use Encode;
use LWP::Simple;
use XML::DOM;
my $yahoo_id = '';
my $api_url = 'http://jlp.yahooapis.jp/MAService/V1/parse?appid=%s&sentence=%s&results=ma';
my $txt = <STDIN>;
my $url = sprintf($api_url, $yahoo_id, &enc($txt));
my $xml = get($url);
my $kana = &xml2kana($xml);
print $kana."\n";
sub enc($) {
my $str = shift;
$str =~ s/([^\w ])/'%'.unpack('H2', $1)/eg;
$str =~ tr/ /+/;
return $str;
}
sub xml2kana($) {
my $xml = shift @_;
my $parser = new XML::DOM::Parser;
my $doc = $parser->parse ($xml);
my $list = $doc->getElementsByTagName('reading');
my @kana;
for (my $i=0; $i<$list->getLength; $i++) {
my $text = $list->item($i)->getFirstChild->getNodeValue;
push @kana, $text;
}
return encode_utf8(join("/", @kana));
}
使い方
- 任意の文章が記述されたテキストファイルを用意する。ここでは、test.txtというファイル名で「日本語文を形態素に分割します」という文章が保存されている。
- 上記のソースを任意のファイル名で保存して実行権限をつける。今回はtext2kana.plというファイル名にした。
- YahooアプリケーションIDを取得して10行目に記入する。
- 必要な各種Perlモジュールをインストールする。
- 以下のようなコマンドを実行。パスは環境に合わせて変更すること。
実行例
$ cat test.txt | ./text2kana.pl にほんご/ぶん/を/けいたいそ/に/ぶんかつ/し/ます/。/
Yahoo日本語形態素解析では、単純に分かち書きをすることも可能なので、ブログのタグクラウドを自動的に生成したりなど、いろいろと使い途があるかもしれない。
ところで
PDFをSWFに変換するPerlスクリプト
PDFをページ毎に別々のFlashムービー(SWF)に
ある仕事でPDFをページ毎に別々のFlashムービー(SWF)に変換する必要があって以下のようなスクリプトを作りました。
AjaxとFlashの連携技になるため、最終的にはできあがったswfファイルの情報を格納したXMLを出力したり、まだまだ実装が必要な機能はありますが、とりあえずswfへの変換はできているようなので今日はここまで。
日本語のフォントはPDF側に埋め込むことで解決
日本語のフォントもどうにか処理しようとxpdf-japaneseなんかもインストールしてテストしたのですが、なぜかうまくいかなかったのと無料のPDF作成ツールでもフォントの埋め込みが可能な製品が多いことが分かったので、全てのフォントがPDFに埋め込まれていないとエラーが出るようにしました。
こんなものを誰が使うの?と思いますが、せっかく紹介するので一応動作条件を。
動作環境
- XPDF
- SWFTools
- Perl
変換可能なPDFは全てのフォントが埋め込まれていて、暗号化やパスワード制限がかかっていないものです。
#!/usr/bin/perl -wT
undef %ENV;
use strict;
my $pdfinfo = '/usr/bin/pdfinfo';
my $pdffonts = '/usr/bin/pdffonts';
my $pdf2swf = '/usr/bin/pdf2swf';
my $in = shift @ARGV;
my $file;
if ($in =~ /^(.+)$/ && -f $in) {
$file = $1;
} else {
die('file does not exists');
}
my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime();
my $time = sprintf("%04d/%02d/%02d $hour:$min:$sec", $year + 1900, $mon +1, $mday);
print "***\n";
print $time." ".$file."\n";
print "***\n";
# fontが全て埋め込まれているかをチェック
{
my $result = `$pdffonts $file`;
if($?){
die('not PDF');
}
my @res = split(/\n/, $result);
foreach (@res) {
if ($_ =~ /^.+(no)\s+(yes|no)\s+(yes|no)\s+[0-9]+\s+[0-9]$/) {
die('not embeded fonts');
}
}
}
# ページ数を取得
my $page; # ページ数
{
my $result = `$pdfinfo $file`;
if($?){
die('not PDF');
}
my @res = split(/\n/, $result);
foreach (@res) {
if ($_ =~ /^Pages:\s+([0-9]+)$/) {
$page = $1;
} elsif ($_ =~ /^Encrypted:\s+yes/) {
die('encrypted PDF');
}
}
}
# swfを作成
for (my $i=0; $i<$page; $i++) {
my $p = $i + 1;
`$pdf2swf -z -p $p -o $p.swf $file`;
if ($?) {
die('Error!!');
}
}
ちなみに、PDFを単純にひとつのSWFに変換するだけならSWFToolsだけで十分です。
まとめて置換
某地方自治体のサイトのリニューアル作業中に運悪く?関係する別の自治体のサイトもリニューアルされた。
リニューアルついでに、リンク先の変更もしようということになったのだが、なんせ5,000ページもあるコンテンツをいちいち手作業でリンク先の変更をするのは大変ということで、ビフォーアフターのタブ区切りテキストを作ってまとめて変換することにした。
さいわい、こちらの方はCMSを使っているのでデータベースのデータをダンプしてそのファイルにたいしてスクリプトを走らすことになった。
というわけで、以下のスクリプトを作った。
やっつけで作ったのだが、こういうのはまたいつか需要があるかもしれないということで。
#!/usr/bin/perl
#
# タブ区切りテキストをベースに置換を行う
#
# 第一引数は変換用のタブ区切りテキスト
# (1列目が変更前、2列目が変更後)
# 第二引数は、変更を適用するテキストファイル
# (SQLなど)
#
$convert = shift @ARGV;
$sql = shift @ARGV;
open(IN, $convert);
my %url;
while(<IN>){
($from, $to) = split(/\t/, $_);
$from =~ s/^\s*(.+)\s*$/\1/;
$to =~ s/^\s*(.+)\s*$/\1/;
if(!$from || !$to){
next;
}
$url{$from} = $to;
}
close(IN);
open(DUMP, $sql);
while(<DUMP>){
$line = $_;
foreach $from(keys %url){
$line =~ s/$from/$url{$from}/g;
}
print $line;
}
close(DUMP);
exit;