当サイトで生成している RSS(野良feed):


M.C.P.C.:カテゴリー Perl バックナンバー

2012.01.26
はてな自動投げ銭スクリプトをはてなブログbetaに対応させた はてなブックマーク - はてな自動投げ銭スクリプトをはてなブログbetaに対応させた
2011.12.12
ゆうパックの配達チェック用のPerlモジュール作っていなかったOTL はてなブックマーク - ゆうパックの配達チェック用のPerlモジュール作っていなかったOTL
2011.12.06
Mojolicious 2.20以上のMojolicious::LiteのWebSocketとAnyEvent::Twitter::Streamを共存させるにはuse Mojolicious::Lite;を先に書く はてなブックマーク - Mojolicious 2.20以上のMojolicious::LiteのWebSocketとAnyEvent::Twitter::Streamを共存させるにはuse Mojolicious::Lite;を先に書く
2011.11.27
AnyEvent::Twitter::Streamで自動再接続処理(whileループを使わない版) はてなブックマーク - AnyEvent::Twitter::Streamで自動再接続処理(whileループを使わない版)
2011.11.26
Mojolicious 2のWebSocketではon_finish(sub{});がないので、on(frame=>sub{});で対応してみた はてなブックマーク - Mojolicious 2のWebSocketではon_finish(sub{});がないので、on(frame=>sub{});で対応してみた
2011.11.13
Mojolicious::Liteでカレントディレクトリを取得する はてなブックマーク - Mojolicious::Liteでカレントディレクトリを取得する
2011.11.09
PerlからJavaScriptに日付を渡すのにMojo::Dateを使う はてなブックマーク - PerlからJavaScriptに日付を渡すのにMojo::Dateを使う
2011.11.05
PerlでTwitter Streaming APIの出力をブラウザ上でニコニコ動画風に表示するスクリプト(再接続未実装) はてなブックマーク - PerlでTwitter Streaming APIの出力をブラウザ上でニコニコ動画風に表示するスクリプト(再接続未実装)
2011.10.31
Mojolicious 2でまたWebSocket周りのメソッド変わっていたわー はてなブックマーク - Mojolicious 2でまたWebSocket周りのメソッド変わっていたわー
2011.10.07
Twitter Streaming APIのSSL接続強制後にでたAnyEvent::Twitter::Stream 0.22ならANYEVENT_TWITTER_STREAM_SSL=1は必要ない はてなブックマーク - Twitter Streaming APIのSSL接続強制後にでたAnyEvent::Twitter::Stream 0.22ならANYEVENT_TWITTER_STREAM_SSL=1は必要ない

< 最後 « これより前10ä»¶ | 全件

2012.01.26

はてな自動投げ銭スクリプトをはてなブログbetaに対応させた

昨日書いた、

HTML::AccountAutoDiscoveryがはてなブログbetaに対応していない件

で、HTML::AccountAutoDiscoveryを使わなければよくね? 的なアプローチではてなブックマークWebHook用投げ銭スクリプトがこちらとなります。

Filename: throw.cgi

#!/usr/bin/perl
 
# throw.cgi ブックマークしたら投げ銭します。
# 説明:http://blog.dtpwiki.jp/dtp/2009/06/web-hook-645b.html
# 2009-06-07 ver 0.0.1 ファーストポスト
# 2009-10-03 ver 0.0.2 最新のMechでも動くように
# 2012-01-26 ver 0.0.3 はてなブログ対応
 
 
use strict;
use warnings;
use CGI;
use Config::Pit;
use Encode;
use HTML::AccountAutoDiscovery;
use utf8;
use WWW::Mechanize;
 
# 初期設定
my $url_sendpoint = 'https://www.hatena.ne.jp/sendpoint';
my $send_point = 10; # 送信するポイント(はてな手数料別)
my $login;
my $config = pit_get('hatena.ne.jp');
die "not preset account data in Pit." if !%$config;
my $my_id    = $config->{id      } or die 'id not found.';
my $password = $config->{password} or die 'password not found.';
my $auth_key = $config->{auth_key} or die 'auth_key not found.';
 
my $q = CGI->new;
my $mech = WWW::Mechanize->new;
$mech->agent_alias('Windows IE 6');
 
{ # メインルーチン
  # 認証
  if ( $q->param('key') ne $auth_key ) {
      die "Authentication failed";
  }
  # メソッド確認
  if ( $q->param('status') eq 'add' ) {
    # エントリーの情報
    my $req = $q->Vars();
    nagesen( $req );
  }
  # はてなブックマークWeb Hook用リザルト
  print $q->header('text/plain');
  print 'ok';
}
exit;
 
sub nagesen {
  my $req = shift;
  my $url = $req->{url};
  my @account = HTML::AccountAutoDiscovery->find( $url );
  unless( @account ) { @account = find_hatenablog( $url ); }
   
  sub find_hatenablog {
    my $url = shift;
    use LWP::Simple;
    my @r;
    my $c = get( $url );
    $c =~ s/.+(<html.+?>).+/$1/so;
    if ( $c =~ m{data-admin-domain="http://blog.hatena.ne.jp"} ) {
      if ( $c =~ m{data-author="(.+)"} ) {
        push @r,{account => $1, service => 'http://blog.hatena.ne.jp' };
      }
    }
    return  @r;
  }
  
  foreach my $item ( @account ) {
    my $send_id = $item->{account}; # account name
    send_hatenapoint( $req, $send_id );
    last; # HTMLに複数のIDを埋め込んでいた場合最初の人の分
          # だけ対応(同じ人がID埋め込みまくるとポイント
          # 送信しまくるのを防ぐ)
  }
  return;
}
 
sub login_hatenapoint {
# はてなにログインします
  $mech->get( $url_sendpoint );
  # ログインを促す画面に遷移済
  $mech->follow_link( text => mech_encode('ログイン') );
  # ログイン画面に遷移済
  $mech->set_visible( $my_id, $password );
  $mech->submit();
  # ログイン済み画面に遷移済
  $mech->follow_link( text => mech_encode('こちら') );
  # 投げ銭画面に遷移済
  $login = 1;
  return;
}
 
sub send_hatenapoint {
# はてなポイント送信をします
  my $req     = shift;
  my $send_id = shift;
  unless ( $login ) {
    login_hatenapoint();
  }
  # ログイン済みの状態
  $mech->get( $url_sendpoint );
  # はてなポイント送信のページに遷移済
  # ポイント送信メッセージ組み立て
  my $send_message = decode('utf8', $req->{title})
    ."($req->{url}) をブックマークしました。投げ銭いたします。"
    .'投げ銭スクリプト:http://svn.coderepos.org/share/lang/'
    .'perl/misc/hatenabookmark_webhook_nagesen/';
  # ポイント送信用パラメータ入力
  $mech->set_visible(
    $password, $send_id, $send_point,
    undef, # 匿名にしたい場合は1
    mech_encode( $send_message )
  );
  $mech->submit();
  # confirm画面に遷移済
  return unless $mech->title() eq mech_encode(
    'はてな ポイント付きメッセージ送信確認'); # 送信確認ページ?
  $mech->click_button( value => mech_encode('送信する') );
  #open my $fh, '>', 'log.html';
  #print $fh $mech->content();
  #close $fh;
  return;
}
 
sub mech_encode {
# WWW::Mechanize 1.21_01以降の挙動に対応
  my $str = shift;
  if ( ( $WWW::Mechanize::VERSION ) < 1.21 ) {
    $str = encode( 'utf8', $str );
  }
  return $str;
}
 
__END__

2009年10月に一度改定していて、WWW::Mechanizeのバージョンによる差異を吸収していたんだけれども、

M.C.P.C.: はてな自動投げ銭スクリプトを最新WWW::Mechanizeに対応させたが、Mechの動作が変わる境目のバージョンがわからない

その分はCodeReposにコミットするの忘れていたので今回はちゃんとコミットしたよ。

http://svn.coderepos.org/share/lang/perl/misc/hatenabookmark_webhook_nagesen/

2012.01.26 午後 11:28 [Perl] | 固定リンク | コメント (0) | トラックバック (0) | このエントリーをはてなブックマークへ追加 livedoor Clipでこのサイトを登録している人数livedoor Clipでこの記事をクリップ!

2011.12.12

ゆうパックの配達チェック用のPerlモジュール作っていなかったOTL

とある密林に出店している中古屋さんから中古DVDを購入したのですが、パッケージと別のDVD板が入っているという事案が発生。中古屋さんに密林メールで連絡とったら、着払いで送り返してねということになりました。

んで、近くのサークルKに行ったれば、いつの間にか宅配業者の取り扱いが日本郵便になっていました。

んで、僕は、送り状伝票に記載されている番号を入れると配達状況を取得できるPerlモジュール、WebService::KuronekoYamatoと、WebService::SagawaKyubinというPerlモジュールをCPANで公開しているのですけれども、日本郵便は、(仕事では使ったことがないので)ノーマークでした……

というわけで、日本郵便用の荷物確認できるPerlモジュールを作るわけですけれども、名前をどうするかという問題が発生。

ヤマト運輸の荷物確認用Perlモジュールを、WebService::KuronekoYamatoとしてしまった以上、日本郵便のゆうパックは、WebService::YouPackとするしかないような希ガス。

そもそも、ゆうパックのローマ字表記って、“YouPack”なのですね! 知らんかったよ。

はたして、WebService::YouPackはちゃんとできるのでしょうか。予想としては、CPAN配布用ビルドの仕方をすっかり忘れてしまっているんじゃないかなあ。

2011.12.12 午後 09:51 [Perl] | 固定リンク | コメント (0) | トラックバック (0) | このエントリーをはてなブックマークへ追加 livedoor Clipでこのサイトを登録している人数livedoor Clipでこの記事をクリップ!

2011.12.06

Mojolicious 2.20以上のMojolicious::LiteのWebSocketとAnyEvent::Twitter::Streamを共存させるにはuse Mojolicious::Lite;を先に書く

先日から、Mojolicious 2.20にしたら、AnyEvent::Twitter::Streamが使われているとWebSocketが動かない問題に悩まされ、とりあえず本稼働が優先だったのでMojolicious 2.19で開発をしていた案件がとりあえず終わり、原因究明ということで、とりあえずMojoliciousをアップデートしたら、2.36まで進んでいた。進みすぎ!

そんで、いくらバージョンの進みが早すぎるからといっても、ドキュメントに書いてあるサンプルスクリプトが動かなくなるようなことはあるめえ、ということで、

http://search.cpan.org/~sri/Mojolicious-2.36/lib/Mojolicious/Guides/Cookbook.pod

を見て、WebSocketの場所に書いてあるプログラム

use Mojolicious::Lite;
 
# Template with browser-side code
get '/' => 'index';
 
# WebSocket echo service
websocket '/echo' => sub {
  my $self = shift;
  
  # Connected
  $self->app->log->debug('WebSocket connected.');
  
  # Incoming message
  $self->on(message => sub {
    my ($self, $message) = @_;
    $self->send_message("echo: $message");
  });
  
  # Disconnected
  $self->on(finish => sub {
    my $self = shift;
    $self->app->log->debug('WebSocket disconnected.');
  });
};
 
app->start;
__DATA__
 
@@ index.html.ep
<!DOCTYPE html>
<html>
  <head><title>Echo</title></head>
  <body>
    <script>
      var ws = new WebSocket('<%= url_for('echo')->to_abs %>');
      
      // Incoming messages
      ws.onmessage = function(event) {
        document.body.innerHTML += event.data + '<br/>';
      };
      
      // Outgoing messages
      window.setInterval(function() {
        ws.send('Hello Mojo!');
      }, 1000);
    </script>
  </body>
</html>

を実行してみると、これは動いた。

これの先頭に、

use AnyEvent::Twitter::Stream;

を入れるだけで、WebSocket接続が勝手にcloseされてしまう。

続きを読む... "Mojolicious 2.20以上のMojolicious::LiteのWebSocketとAnyEvent::Twitter::Streamを共存させるにはuse Mojolicious::Lite;を先に書く"

2011.12.06 午後 10:45 [Perl] | 固定リンク | コメント (0) | トラックバック (0) | このエントリーをはてなブックマークへ追加 livedoor Clipでこのサイトを登録している人数livedoor Clipでこの記事をクリップ!

2011.11.27

AnyEvent::Twitter::Streamで自動再接続処理(whileループを使わない版)

AnyEvent::Twitter::Streamの再接続の件をずうっと考えていたのですが、当初参考にしていた、

hidekiy blog: [perl] AnyEvent::Twitter::Streamで自動再接続処理 [blog.hidekiy.com]

のとおりにすると、通常のAnyEventでの組み方の時はよさそうなのですが、Mojoliciousと同時に使用するなど、イベントループを共有する場合は、while(1){} のせいで、Mojoliciousのイベントループ開始までプログラムが進行できず、かといって、AnyEvent::Twitter::Streamの再接続の処理をMojoliciousに担当させるというのは難しそうなので、ここは、「Twitterのウォッチャー」と、「〔Twitteのウォッチャー〕のウォッチャー」の二つのウォッチャーを作り、お互いにウォッチャーの再生成をさせることで、結果的にAnyEvent::Twitter::Streamの再接続が実現できるようにしてみました。

続きを読む... "AnyEvent::Twitter::Streamで自動再接続処理(whileループを使わない版)"

2011.11.27 午後 06:25 [Perl] | 固定リンク | コメント (0) | トラックバック (0) | このエントリーをはてなブックマークへ追加 livedoor Clipでこのサイトを登録している人数livedoor Clipでこの記事をクリップ!

2011.11.26

Mojolicious 2のWebSocketではon_finish(sub{});がないので、on(frame=>sub{});で対応してみた

今動かしているMojolicious::LiteでWebSocketでクライアントに表示するやつなんですけれども、Mojoliciousのバージョン1/2の両用で動くようにしていたのですが、本番のMojolicious 2の環境では、WebSocketクローズのイベントが取得できない状態になっていました。よって、こんな感じにしてみました。

  # WebSocketコネクション切断時処理(共通)
  my $on_finish = sub {
    # ログに切断記録
    app->log->debug('Client disconnected');
    # $clientsからWebSocketクライアントを削除
    delete $clients->{$id};
  };
  
  # WebSocketイベント設定
  if ( $Mojolicious::VERSION < qv("v2.0") ) {
    # Mojolicious 1.xの時の処理
    $self->on_message();
    $self->on_finish( $on_finish );
  }
  else {
    # Mojolicious 2.xの時の処理
    $self->on(
      message => sub {},
    );
    $self->on(
      frame => sub {
        my ($ws, $frame) = @_;
        if ( $frame->[1] == 8 ) { # opcode=8: close
          $on_finish->();
        }
      },
    );
  }

これを見ると、どうも frame-opcode = 9(ping)、frame-opcode=10(pong)も$ws->on(frame=>sub{}); の中で対応しなくちゃいけないのかなーとか思っていますが、調べ中……

ここを参考にした:
WebSocket(hybi-07)でechoサーバを作ってみた - いろいろな何か [d.hatena.ne.jp]

2011.11.26 午後 03:21 [Perl] | 固定リンク | コメント (0) | トラックバック (0) | このエントリーをはてなブックマークへ追加 livedoor Clipでこのサイトを登録している人数livedoor Clipでこの記事をクリップ!

2011.11.13

Mojolicious::Liteでカレントディレクトリを取得する

CGI::Application時代、CGIやmod_perl環境でスクリプトが稼働しているディレクトリを取得するのに、以下のようにしていました。

use File::Spec;
use FindBin::Real;
 
my $script_dir = FindBin::Real::Bin();
my $db_path = File::Spec->catdir ( $script_dir, 'past.db' );
my $pastlog = File::Spec->catdir ( $script_dir, 'pastlog')

それで、Mojolicious::Liteの場合は、このように書けます。

use Mojolicious::Lite;
my $db_path = app->home->rel_file('past.db');
my $pastlog = app->home->rel_dir('pastlog')

Mojolicious::Liteにスクリプト実行のカレントディレクトリ取得は既に組み込まれているのですね。

2011.11.13 午後 11:00 [Perl] | 固定リンク | コメント (0) | トラックバック (0) | このエントリーをはてなブックマークへ追加 livedoor Clipでこのサイトを登録している人数livedoor Clipでこの記事をクリップ!

2011.11.09

PerlからJavaScriptに日付を渡すのにMojo::Dateを使う

Perl 5.8・Mojolicious 1.97/Perl 5.10・Mojolicious 2.19のクロス環境で開発しているのですが、Mojoliciousに日付を扱うモジュールMojo::Dateがあるので、ブラウザのJavaScriptで取り扱わせる日付をPerl側で用意するときに使えるよ、というお話。

use strict;
use warnings;
use YAML;
 
use Date::Parse;
use DateTime;
use DateTime::Format::Mail;
use Mojo::Date;
 
my $date_twitter = 'Tue Jan 05 13:16:29 +0000 2010'; # ctimeの形式
 
my $date;
 
$date->{DateTime} =
  DateTime::Format::Mail->format_datetime(
    DateTime->from_epoch(
      epoch => str2time( $date_twitter )
    )
  );
 
$date->{'Mojo::Date'} =
  Mojo::Date->new( str2time( $date_twitter ) )
            ->to_string;
 
print Dump $date;
exit;
 
__END__
$ perl test.pl
---
DateTime: 'Tue, 05 Jan 2010 13:16:29 -0000'
Mojo::Date: 'Tue, 05 Jan 2010 13:16:29 GMT'

出てきた書式は違いますが、どっちでもJavaScript側では同じ時刻としてちゃんと処理されます(Internet ExplorerでもOK)。

DateTimeモジュールというとてもでかいモジュールを使わなくてもいいのは利点かなあと思います。

2011.11.09 午前 04:55 [Perl] | 固定リンク | コメント (0) | トラックバック (0) | このエントリーをはてなブックマークへ追加 livedoor Clipでこのサイトを登録している人数livedoor Clipでこの記事をクリップ!

2011.11.05

PerlでTwitter Streaming APIの出力をブラウザ上でニコニコ動画風に表示するスクリプト(再接続未実装)

Twitter Streaming API接続を使い、ニコニコ動画風にブラウザ上で字幕を流すMojoliciousウェブアプリケーションの最新版です。

なにかイベントあった時にサクッとAmazon EC2を立ち上げて、ソースをコピー&ペーストしてすぐ設置できるぐらいのカジュアルさを目指しました。

■動作確認環境

  • CentOS 5.6 / Perl 5.8.8 / Mojolicious 1.97
  • Amazon Linux AMI / Perl 5.10.1 /Mojolicious 2.19(2.20~2.24は不可)

~~~

起動するには、事前に取得しておいたconsumer keyをconsumer_keys.yamlに、access tokenを~/.pit/defalt.yamlに設定しておき、

perl twitter-jimaku.pl daemon -listen http://*:3000

とサーバで実行したあと、ウェブブラウザ(Firefox7、Google Chrome 15)で

http://www.example.com:3000

に接続すると画面に字幕が流れる、というものになります。

~~~

現状わかっている不具合として、

「Twitter Streaming APIの接続が切れた時の再接続ができない」

というものがあります。いろいろ調べて、AnyEventのイベントループだけで廻っている場合は策があるのですが、Mojoliciousのイベントループとの複合技になると途端に制御が難しくなってしまいます。だれか、解決策をご存じの方にご指南をいただきたく、現状のソースを公開します。

続きを読む... "PerlでTwitter Streaming APIの出力をブラウザ上でニコニコ動画風に表示するスクリプト(再接続未実装)"

2011.11.05 午後 05:09 [Perl] | 固定リンク | コメント (0) | トラックバック (0) | このエントリーをはてなブックマークへ追加 livedoor Clipでこのサイトを登録している人数livedoor Clipでこの記事をクリップ!

2011.10.31

Mojolicious 2でまたWebSocket周りのメソッド変わっていたわー

Amazon EC2のTokyoサーバで(←ゼーガペインみたいな言い方だな)、Amazon Linux AMIでサーバを立ててみて、Mojolicious 2を試しに入れてみましたが、メソッドをころころ変えることで有名らしいMojoliciousなので、Mojolicious 1.xxだと動いていたプログラムがあんのじょう動かなくなっていました。

で、何が変わったのかなーとか思って調べてみたのですが、

http://search.cpan.org/~sri/Mojolicious-2.19/lib/Mojo/Transaction/WebSocket.pm

  $ws->on(message => sub {
    my ($ws, $message) = @_;
  });

がMojolicious 2.0で書き変わっているusageなわけで、以前は、

  $ws->on_message (
    sub {
      my ($ws, $message) = @_;
  });

としていたところなので、以前の書き方とは互換性がないので、エラーになります。

つうわけで、今普通にMojolicious 2を入れると、Webに豊富にあるMojolicious 1.x用のWebSocketサンプルが全滅です。怖い!

Mojoliciousは、CGI.pmの代わりになるんだ! とか言っているのだけれども、追いかけていくのは大変そうだなあとか思いました。

2011.10.31 午後 11:02 [Perl] | 固定リンク | コメント (0) | トラックバック (0) | このエントリーをはてなブックマークへ追加 livedoor Clipでこのサイトを登録している人数livedoor Clipでこの記事をクリップ!

2011.10.07

Twitter Streaming APIのSSL接続強制後にでたAnyEvent::Twitter::Stream 0.22ならANYEVENT_TWITTER_STREAM_SSL=1は必要ない

タイトルのとおり、ソース見ると一目瞭然な話で、

http://cpansearch.perl.org/src/MIYAGAWA/AnyEvent-Twitter-Stream-0.21/lib/AnyEvent/Twitter/Stream.pm

our $STREAMING_SERVER  = 'stream.twitter.com';
our $USERSTREAM_SERVER = 'userstream.twitter.com';
our $PROTOCOL          = $ENV{'ANYEVENT_TWITTER_STREAM_SSL'} ? 'https' : 'http';
our $US_PROTOCOL       = 'https'; # for testing

となっていたのが、

http://cpansearch.perl.org/src/MIYAGAWA/AnyEvent-Twitter-Stream-0.22/lib/AnyEvent/Twitter/Stream.pm

our $STREAMING_SERVER  = 'stream.twitter.com';
our $USERSTREAM_SERVER = 'userstream.twitter.com';
our $PROTOCOL          = 'https';
our $US_PROTOCOL       = 'https'; # for testing

となっており、環境変数に関係なく常にhttpsつまりSSL接続されるということがわかります。

つうわけで、

M.C.P.C.: 昨日あたり(2011-9-30)から急にTwitter Streaming APIが不調になったがSSLでつなぐようにすればOK

のエントリは不要となりました。

それはともかく、今困っているのは、Amazon EC2でAnyEvent::Twitter::Streamがうまく動かないこと。なかなか情報が見つからない……

2011.10.07 午後 11:20 [Perl] | 固定リンク | コメント (0) | トラックバック (0) | このエントリーをはてなブックマークへ追加 livedoor Clipでこのサイトを登録している人数livedoor Clipでこの記事をクリップ!

< 最後 « これより前10ä»¶ | 全件