PerlでTwitterのキーワード検索&リツイート(oAuth編)

先日、twitter API の仕様が変更になって、基本認証が使えなくなった。

そのため、以下の記事のスクリプトが動かなくなった。

そこで、oAuthに対応したものをご紹介。

目的

Twitterの検索メモに登録されたキーワードのリストを取得して、タイムラインを検索し、マッチしたものを公式リツイートする。

  • 自分自身の投稿はリツイートしない。
  • RTや@が含まれる投稿はリツイートしない。
  • すでにリツイートした投稿はリツイートしない。
  • ログに保存されたIDより古い投稿はリツイートしない。

アプリケーション登録申請

oAuth認証を行うには以下の情報が必要なので、アプリケーション登録申請を行う。

  • Consumer key
  • Consumer secret
  • Access Token
  • Access Token Secret

登録申請の手順は以下のサイトが分かりやすかった。

実用! PerlでコマンドラインからTwitter投稿(OAuth対応) – perl-mongers.org

ソース

以下のような感じ。
13行目〜17行目を書き換えること。

あとは、Cron等に登録して使用する。

#!/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 $user    = ''; # Twitter のユーザー名
my $key     = ''; # Consumer key
my $secret  = ''; # Consumer secret
my $token   = ''; # Access Token
my $tsecret = ''; # Access Token Secret

my $lang         = 'ja';
my $api          = 'http://search.twitter.com/search.atom';

# do not need to edit
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(
    traits => [qw/API::REST OAuth WrapError/],
    consumer_key    => $key,
    consumer_secret => $secret
);

$twt->access_token       ($token);
$twt->access_token_secret($tsecret);

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; # 重複投稿しないためのフラグ
            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;
}

参考

Webサーバーの稼働状況を定期的にチェックする

先日データーセンターでネットワークトラブルがあって、そのトラブルそのものはうちの問題ではなかったので、おまかせにしていたら数時間で復旧したのだが、トラブルに弊社が気づくのが遅れてしまい、お客様に余計な心配をかけてしまった。

そんなわけで、外部のサーバーからWebサーバーの稼働状況を監視するPerlスクリプトを作成して、Cronでぶんまわすことにした。

仕組み

仕組みはとても簡単で、ざっと以下のような感じ。

  1. コマンドライン引数に渡されたURLに対してwgetを実行する。
  2. 実行した結果を評価して、エラーがあればメールを送信する。

という感じ。

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には公式リツイートという仕組みが導入された。

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でbit.lyのapiを使ってurlを短縮

GoogleがURLの短縮を始めたとのことで、もしかしたら窮地に陥っているかもしれませんが、個人的にはURLの短縮なんてGoogleさんがやらんでも!って感じでbit.lyさんを応援したい今日この頃。

というわけで、perlを使ったbit.ly APIによるURL短縮。
別のシステムに組み込んだものを、この記事用に書き換えたので、もし動かなかったらごめんなさい!

#!/usr/bin/perl -wT

use strict;
use warnings;
use JSON::XS;
use LWP::Simple;
use URI::Escape;

my $baseurl = shift @ARGV; # 短縮したいURL

my $bituser = ''; # bit.lyのユーザー名
my $bitkey = ''; # bit.lyのapiキー
my $apiurl = 'http://api.bit.ly/shorten?version=2.0.1&login=%s&apiKey=%s&longUrl=%s';
my $bitly = sprintf($apiurl,$bituser, $bitkey, $baseurl);

my $res = decode_json(get(uri_escape($bitly)));
my $shortURL = $res->{results}->{$baseurl}->{shortUrl};

print $shortURL;
exit;

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));
}

使い方

  1. 任意の文章が記述されたテキストファイルを用意する。ここでは、test.txtというファイル名で「日本語文を形態素に分割します」という文章が保存されている。
  2. 上記のソースを任意のファイル名で保存して実行権限をつける。今回はtext2kana.plというファイル名にした。
  3. YahooアプリケーションIDを取得して10行目に記入する。
  4. 必要な各種Perlモジュールをインストールする。
  5. 以下のようなコマンドを実行。パスは環境に合わせて変更すること。

実行例

$ cat test.txt | ./text2kana.pl
にほんご/ぶん/を/けいたいそ/に/ぶんかつ/し/ます/。/

Yahoo日本語形態素解析では、単純に分かち書きをすることも可能なので、ブログのタグクラウドを自動的に生成したりなど、いろいろと使い途があるかもしれない。

ところで

先日ご紹介した弊社サービスに関するプレスリリースが、いくつかのメディアに掲載されました。

twitterのつぶやきを取得して音声出力(MacOS限定)

以下で公開していたソースに「つぶやき」の中に「¥”」という文字を含めることで任意のコマンドが実行できるというセキュリティホールがありました。現在既に修正していますが、万が一すでに試した方は、以下のソースをもとに修正願います。
  • 15行目のダブルクォーテションをシングルクォーテションに変更しました。
  • 49行目の正規表現を修正しました。

ご迷惑をおかけしてすいません。

はじめに!!

以下はMacOSX限定です。
さらに、初めのうちはかなり笑えますが、それ以上のものは得られません。役にも立ちません。

一回目はかなり笑えます。そこだけは保証します。

このスクリプトは?

タイムラインから「つぶやき」を取得して音声で読み上げます。
音声は女性の声ですが、かなり棒読みです。

ところどころ改善の余地はありそうなのですが、それは皆さんにお任せします。

動作環境

  • MacOSX 10.5以上(開発は10.6で行いましたが10.5でも動作するはずです。)
  • Perlおよび以下のPerlモジュール
    • Net::Twitter::Lite
    • XML::DOM
    • LWP::Simple
  • Yahoo日本語形態素解析APIを使用していますので、アプリケーションIDの取得も必要です。
  • SayKana

インストール方法

1)まずはじめに、SayKanaをダウンロードしてインストールしてください。
インストール後は、ドキュメントに従って音声が出力されることをご確認願います。

2)以下のPerlモジュールをインストールしてください。

  • Net::Twiter::Lite
  • XML::DOM
  • LWP::Simple(これはプリインストールかもしれません。)

私の環境では、CPANシェルで問題なくインストールできました。

3)以下のソースをデスクトップ等に設置して、パーミッションを755にしてください。

3)twitterアカウントのアカウント名およびパスワードを12行目および13行目に入力してください。

4)YahooアプリケーションIDを取得して15行目に記述してください。

ソース

#!/usr/bin/perl -wT

undef %ENV;

use strict;
use Encode;
use LWP::Simple;
use Net::Twitter::Lite;
use XML::DOM;

my $twt_user = '';
my $twt_pass = '';
my $yahoo_id = '';
my $api_url = 'http://jlp.yahooapis.jp/MAService/V1/parse?appid=%s&sentence=%s&results=ma';
my $saykana = "/usr/local/bin/saykana '%s'";

my $twt = Net::Twitter::Lite->new(
 username => $twt_user,
 password => $twt_pass
);

my $r = $twt->friends_timeline();

my $n = 0;
foreach (@$r) {
 my $txt = encode_utf8($_->{'text'});
 my $url = sprintf($api_url, $yahoo_id, &enc($txt));
 my $xml = get($url);
 my $kana = &xml2kana($xml);
 print $kana."\n";
 system(sprintf($saykana, $kana));
}

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;
 $text =~ s/'//g;
 if ($text =~ /^[0-9]+$/) {
 $text = "<NUMK VAL=".$text.">";
 } elsif ($text =~ /^\s+$/){
 $text = ',';
 }
 $text =~ s/\//\\\//g;
 push @kana, $text;
 }
 return encode_utf8(join("/", @kana)).",,,";
}

その他

  1. 空白はコンマに変換して一瞬だけスリープが入るようにしています。
  2. つぶやきとつぶやきの間にはコンマを3つ挿入して長めのスリープが入るようにしています。
  3. シングルクォーテションはsaykanaコマンドにおいてアクセントを意味する記号であることとセキュリティ上の配慮により削除しています。

本来は「。」であるが妥当なのですが、テキストエディタで本スクリプトを編集した際にsaykanaコマンドでエラーが出るため、半角の記号で代用しました。(UTF-8-MACによる問題と思われますが、くわしく検証していません。)

(追記)
よく考えたらUTF-8-MACは関係ないかも、いずれにしろJeditで「。」を入力した場合とvimで「。」を入力した場合で何かが違うみたい。(両方ともUTF-8なんですけど。)

ソースをご覧になるとわかりますが、別にtwitterじゃなくても別のものをしゃべらすのも、それほど難しくないので、適当にお楽しみください。

ライセンス

SayKanaおよびYahoo APIのライセンスは厳守していただけますようお願いいたします。

気に入ってくれた方は、ブログ等で紹介してくだされば、十分うれしい限りです。

Subversionでコミットした結果をtwitterに投稿する。

毎度懲りずに、マニアックなスクリプトを公開します。

最近、何かと話題になっているミニブログサービスのtwitterですが、私自身最近使い始めたところ、いろいろなオープンソースプロジェクトやメーカーが、サポートや開発の進捗状況などのアナウンスに利用していることがわかりました。

たとえば、WordPressもイベントの案内や新バージョンのリリースの発表に活用しています。

そこで、プロジェクトの情報共有等に役立つかと思いSubversionでコミットした結果をtwitterに投稿するためのスクリプトを作成しましたので公開します。

ソースをご覧いただくとわかるのですが、割と簡単なスクリプトなので、にるなり焼くなりして皆さんのお役に立てば幸いです。

投稿される内容について

本スクリプトはSubversionでコミットした際に、そのリビジョン番号およびコミットメッセージを以下のような感じでtwitterに投稿します。

[20] hogehogeを修正した

140文字を超えるメッセージの場合は137文字でカットして末尾に…を追加します。

重要な情報の漏洩等については、くれぐれもお気をつけ下さい。

ダウンロード

ダウンロードはこのリンクをクリックしてください。

インストール方法

以下で説明する方法はsubversionリポジトリにhookスクリプト(post-commit)が無い場合を想定しています。
すでにpost-commitが存在する場合は、post-commitから本スクリプトをコールするように修正してください。

1)まずはじめに、PerlのCPANモジュールの”Net::Twitter::Lite”をインストールしてください。

2)本スクリプトの21行目および22行目にtwitterのアカウント名およびパスワードを入力してください。

3)Subversionリポジトリ内にあるhooksという名前のディレクトリ内に本スクリプトを設置してパーミッションを755にしてください。(同じディレクトリ内には*.tmplという名前のファイルがいくつか存在しているはずです。)

4)Subversionリポジトリ内にあるhooksという名前のディレクトリ内にあるpost-commit.tmplをpost-commitというファイル名でコピーしてパーミッションを755にしてください。

5)post-commitに以下のソースをペースとしてください。

#!/bin/sh

REPOS="$1"
REV="$2"

/path/to/svn2twitter.pl "$REPOS" "$REV"

6)post-commitの/path/toの部分をご自身の環境にあわせて修正してください。

7)以上で設置は完了です。試しにクライアントから何かをコミットしてみてください。

免責事項

本スクリプトを使用したことによるいかなる損害にも補償いたしかねますのであらかじめご了承願います。

ライセンス

MITライセンスとします。
使用した結果のご感想やご意見をコメントくださるととてもうれしいです。

寄付について

このスクリプトは無料でご利用いただいても大歓迎ですが、寄付は大歓迎です。

PDFをSWFに変換するPerlスクリプト

PDFをページ毎に別々のFlashムービー(SWF)に

ある仕事でPDFをページ毎に別々のFlashムービー(SWF)に変換する必要があって以下のようなスクリプトを作りました。

AjaxとFlashの連携技になるため、最終的にはできあがったswfファイルの情報を格納したXMLを出力したり、まだまだ実装が必要な機能はありますが、とりあえずswfへの変換はできているようなので今日はここまで。

日本語のフォントはPDF側に埋め込むことで解決

日本語のフォントもどうにか処理しようとxpdf-japaneseなんかもインストールしてテストしたのですが、なぜかうまくいかなかったのと無料のPDF作成ツールでもフォントの埋め込みが可能な製品が多いことが分かったので、全てのフォントがPDFに埋め込まれていないとエラーが出るようにしました。

こんなものを誰が使うの?と思いますが、せっかく紹介するので一応動作条件を。

動作環境

変換可能な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だけで十分です。