#!/usr/bin/perl # # 勝手に ALPSLAB clips! for chalow # # Changelog: # * 2006/03/01 - version 0.03 - # エラー処理の追加と、alps_map_tb() のバグ修正 # # * 2006/02/28 First release - version 0.02 - # support alps_map_tb(); # # * 2006/02/26 test version - version 0.01 - # support alps_map(); # # Usage: # * 地図を掲載 # {{alps_map('愛知県名古屋市千種区東山通5-65','D')}} # # こんな感じ。引数の1番目が住所、2番目はサイズ。詳細は # # http://www.alpslab.jp/clip_howto.html#2 # # * ALPSLAB clips! へ Trackbackを打つ場合 # {{alps_map_tb('愛知県名古屋市千種区東山通5-65','D','タイトル','http://www.example.com/chalow/2006-02-28.html#2006-02-28-2')}} # # プラグインから、呼び出している側のタイトルと固定リンクを取得する方法がよくわからなかった # ので、手動で設定する必要があります(--; # # NOTE: # * alps_map_tb() を使うと、chalow を実行した時に Trackback を打ちます。 # かなり強引なイケテない実装になってます…… # $ping_data に ping を打ったことを記録し、chalow を実行する度に ping を何度も打つことがな # いようにはしてあります。 # # 参考: # - ALPSLAB 配布の mt-alps.pl # - http://bulknews.net/lib/archives/trackback # # 利用規約等について: # ALPSLAB clip! 利用ガイドライン # http://www.alpslab.jp/clip_eula.html # に準じます。 # my $ping_data = '/home/hoge/tb/ping_data'; # 書き込み可能なディレクトリを指定 my $alps_chalow_version = '0.03'; sub alps_map { use CGI; use Jcode; my ($address, $option) = @_; if ($address =~ /[^0-9\-\/\.\,]/) { my $str = CGI::escapeHTML($address); my $adr = Jcode->new($str)->euc; $adr = urlencode($adr); # XXX: option チェックをもうちょっとした方がいいかも my $opt = CGI::escapeHTML($option); return qq($str); } else { my $str = $address; my $opt = CGI::escapeHTML($option); return qq($str); } } sub alps_map_tb { use Jcode; use LWP::UserAgent; use CGI qw/-oldstyle_urls/; #use POSIX qw (strftime); #my $date = strftime("%Y-%m-%d %H:%M:%S", localtime()); my ($address, $option, $title, $url) = @_; my $check_file ="$ping_data/" . urlencode($url); my $tag = alps_map($address, $option); return $tag if -e $check_file; my $ua = LWP::UserAgent->new; $ua->agent("alps-chalow/$alps_chalow_version"); my $tb_url = "http://base.alpslab.jp/bin/tb"; my %param = ('charset'=>'EUC-JP'); $param{'blog_name'} = Jcode->new($changelog_name)->euc; $param{'title'} = Jcode->new($title)->euc; $param{'url'} = Jcode->new($url)->euc; $param{'excerpt'} = $changelog_description; #$param{'date'} = Jcode->new($date)->euc; if($address =~ /[^0-9\-\/\.\,]/){ $param{'address'} = Jcode->new($address)->euc; } else { my ($lat,$lon) = split(/\,/,$address); $tb_url .= "/".&to_msec($lat)."/".&to_msec($lon); } my $query = new CGI(\%param); my $h = HTTP::Headers->new(Content_Type => 'application/x-www-form-urlencoded'); my $req = HTTP::Request->new("POST",$tb_url,$h,$query->query_string); my $res = $ua->request($req); return " HTTP error: " . $res->status_line unless $res->is_success; my($e, $msg) = $res->content =~ m!(\d+).*!s; if ($e) { return qq(

Sorry, your trackback was failed
Error-No : $e

); } else { system("touch", "$check_file"); return $tag; } } sub to_msec{ my $r = 0; my @tmp = split(/\//,shift); for(my $i=0;$i<@tmp;$i++){ $r += $tmp[$i]/(60.0**$i); } int($r*3600000.0); }