2007-12-18

Twitterに書いたURLをはてブとdel.icio.usに同期するconfig.yaml

Plagger

こういう場合はPP::Subscription::Config使うしかないのかな、できればfeedから取りたかったのだけど。あとtinyurlでリンク壊れたときのフォローとかできていない。APIからきちんと全文取得して、tinyurl.com/hogeqwertyuioみたいな感じになってる場合はURLとして解釈する範囲を伸ばす処理をしたほうがいいと思う。

plugins:
  - module: Subscription::Config
    config:
      feed:
        - url: http://twitter.com/fuba
          meta:
            follow_xpath: //span[contains(@class, 'entry-content')]/a
  
  - module: CustomFeed::Simple

  - module: Filter::TruePermalink
  - module: Filter::Rule
    rule:
      module: Expression
      expression: $args->{entry}->link !~ /twitter\.com/
  
  - module: Publish::Delicious
  - module: Publish::HatenaBookmark

2007-12-17

Plaggerから受けてるメールがどれもこれも変

3日ぶりにとら新着読もうとしたらあ行しか出てこなくてあー。$entry->bodyに入ってるHTMLが一定バイト数でぶった切られて、それが本来の長さの分ループして残りが埋められてる感じで壊れている。こないだPPP::GMailが対応したとのことでアップデートしてたMIME::Liteを3.01に戻したら直ったので、diffだけでは完全には新しいMIME::Liteに対応できてないのかな。適当に検索しても誰も何も言ってないっぽいので自分が何か忘れてる可能性がでかい、正直よくわからない。とはいえとら通販新着が欠けると生活が成り立たないので、とりあえず古いMIME::Liteで行くか。

2007-11-21

glitch20071121.pl

usage

% perl glitch20071121.pl [filetype] [frequency param] [repeat] < [src] > [dist]

% perl glitch20071121.pl image 1000000 10 < sakkaku.jpg > sakkaku_glitch.jpg
% perl glitch20071121.pl text 13 2 < netrunner.txt > netrunner_glitch.txt

jpeg image

japanese text

from http://mala.nowa.jp/entry/41ca6cdb15

インターネットはとても楽しい。インターネットを使っているのかをタダで聴くことができた。もっとである修正のかをを見ことができた。もっと機DVDを見プロテクトをはずす事ができた。P2Pでラジオを中継している人もいた。発売前の漫画を読むことができた。もっとのかを見たりかには世界中である。ができたして無知ができに翻訳して字幕を付けているたもして。もっとであるゲーム機のかを遊ぶことができた。そういったことが、ネットランナーが多くのかにはずているた。世の中にはなかなか便利だのになかなか広まらない。」そんな沢山ある。もっとことができずとも「インターネットは便利だ。」そんな空気にはなかなかつつある。。「インターネット、これは革命的だ！」そんな思っている。世の中はなかなか変わらないもの」。梅田もちおの本にはなかなかができとかそんなことしか書いてなくている無知も教えているくれなかった。もっと具体的だワレズ下さい。どこですか。もっとはなかなか変わらが世界一安い国になった。もっとはなかなか巡らされたり。、無知を遅延している。もっと室であるた。もっとような雑誌の良いインターネッターばかりで、挙げ句にはケータイであるとか言い出す脳みそが退化した。たちもいる。もっとスカイプってのでタダで電話ができらしいぜ」そんなことが年前から知ってるわ。ピコピコ携帯小説読んでる暇があったらネトランを見世の中はなかなか変わらない。Winnyがあれだけ社会問題にはている参加ノードはなかなか変わら万ノードはある。もっとができ万だったらどうなってた。もっと。もっとは無知国民の個人情報をDVD撮り動画ができたて酷いことにはてただろう。。もっとは言う。少し自信な雑誌げに言う。モラルのかをも、無知を方、問題である。YouTubeでエヴァを見たりし無知動画で将棋を見たり、無知をあるを見たりし機嫌な雑誌だ。もっとははなかなかに満ちているた、無知ブロンド死体幼女が犬に犯されたりする無修正のができ転がっているのかある。CDをコピーしている3にはするだけ社会アングラだの何も言われている。。も、た。だ。CDやDVDをコピーしたりしてあるを見してアニメをタダであるたりしている。進んである。ちょっとずつ、上手くいきつつある。には。もっとや任天堂のかは素晴らしい。もっとはとインターネットは何も、たかを多くの人に知って欲しい。もっとのかを前提として成立しているたビジネスはなかなか崩壊している。いい。もっと情報を見たりぶちまけてしまえばいい。無知を大衆を見たりができ変化には興味ができ。おじさま方、梅田もちおの本よりもネトランを見う。それから、無知をなかなか変わらのかに現金を見たりしている。もっと雑誌だ。みんな買おう。俺は買わない。恥ずかしいし。もっと

code

#!/usr/bin/perl
use strict;
use warnings;

my $filetype = shift;
my $freq = shift;
my $repeat = shift;

my $string = '';
while (<>) {
	$string .= $_;
}

my $token_ref = ($filetype eq 'text')
	? tokenize_japanesetext($string)
	: tokenize_general($string);

for my $i (0..$repeat) {
	$token_ref = glitch_by_estimation($token_ref);
}

print join '', @{$token_ref};
print "\n" if ($filetype eq 'text');

sub tokenize_general {
	my $str = shift;
	my @array = split //, $str;
	return \@array;
}

sub tokenize_japanesetext {
	use Encode;
	
	use Text::MeCab;
	my $mecab = Text::MeCab->new;
	my $str = shift;
	
	$string = decode('utf-8',$string);
	$string =~ tr/\r\n//;
	
	my @tokens;
	for (my $node = $mecab->parse($str); $node; $node = $node->next) {
		push @tokens, $node->surface;
	}
	
	return \@tokens;
}

sub glitch_by_estimation {
	my $array_ref = shift;
	my @array = @$array_ref;
	my %bigram;
	for my $i (2..$#array) {
		$bigram{$array[$i-1]}->{$array[$i]}++;
	}
	
	my @newarray = ($array[0]);
	for my $i (1..$#array) {
		unless ($i % int(rand($freq)+1)) {
			my $list = $bigram{$array[$i-1]};
			my @sorted = sort {$list->{$b} <=> $list->{$a}} keys %$list;
			my $estimated = $sorted[0] || $array[$i];
			
			push @newarray, $estimated;
		}
		else {
			push @newarray, $array[$i];
		}
	}
	
	return \@newarray;
}

2007-11-20

glitch20071120.pl

第1引数は画像ファイル、第2引数の等倍が壊すbyte。

usage

perl glitch20071120.pl ../Documents/icon/sakkaku.jpg 10000 > ./a.jpg

code

#!/usr/bin/perl
my ($source, $param) = @ARGV;

open my $image, '<', $source;
my $string;
while (<$image>) {
    $string .= $_;
}
close $image;

my @array = split //, $string;
my %bigram;
for my $i (2..$#array) {
	$bigram{$array[$i-1]}->{$array[$i]}++;
}

my @newarray = ($array[0]);
for my $i (1..$#array) {
	unless ($i % $param) {
		my $list = $bigram{$array[$i-1]};
		my @sorted = sort {$list->{$b} <=> $list->{$a}} keys %$list;
		my $estimated = $sorted[0] || $array[$i];
		
		push @newarray, $estimated;
	}
	else {
		push @newarray, $array[$i];
	}
}

print join '', @newarray;

2007-11-04

tako3で検索して一発でLDR登録するブックマークレット

http://blog.tkmr.org/tatsuya/show/405-fooo-name-ldr-greasemonkeyのたこさん版。

javascript:location.href='http://reader.livedoor.com/subscribe/?url='+encodeURIComponent('http://tako3.com/'+location.href)+'&extract=on';

2007-10-31

HTML::FeaturedImage - URLに含まれる画像のうち、重要そうなものを取り出すためのPerlモジュール

yuisekiが「エントリのメイン画像抽出があるといいかも」と言ってたときに、昼飯まで暇だったので作った。結果のサンプルはこちら。
仕組みはてきとう。まずURLをたくさん与え、その先にある画像の数を数える。たくさんのページに~~でてきたり、何度もおなじページに~~出てくる画像はどうでもいいものとして、消す。よくあるやり方だけど強力。
よく考えるとHTML::じゃない感じがしてきた。あとで直すかも。HTML::としてふさわしくするため、Web::Scraperにcontent渡せるようにした。

$content = "<html>...";
$hfi->add_page($url, $content);

あと、リンク先が画像っぽいURLのときにはa hrefも取るようにした。閾値のキャッシュとかちょっとアルゴリズム変更とか、細かいところも変更。ちょっとノイズ入るようになったけど、たぶん欲しい物は確実に全部取れるチューニングになってると思う。閾値の式とか画像っぽいURL判定は設定とかプラグインに出したほうがいいかもな。

サンプルを生成するipic.pl

#!/usr/bin/perl
use strict;
use warnings;

use URI;
use XML::Feed;
use Template;

use HTML::FeaturedImage;

my $home = shift or die 'usage : ./ipic.pl http://www.akibablog.net/';
my @feeds = XML::Feed->find_feeds($home);
die 'no feed' unless (@feeds);

my $feed = XML::Feed->parse(URI->new($feeds[0]));

my $template = <<"TEMPLATE";
<html>
<head><title>demo: HTML::FeaturedImage</title></head>
<body>
[% FOR url IN hfi.urls %]
<div>
<h3>[% url %]</h3>
<h4>original</h4>
<p>[% FOR imageurl IN hfi.original(url) %]<a href="[% imageurl %]"><img src="[% imageurl %]" width="80"></a>[% END %]</p>
<h4>predicted</h4>
<p>[% FOR imageurl IN hfi.predict(url) %]<a href="[% imageurl %]"><img src="[% imageurl %]" width="80"></a>[% END %]</p>
</div>
[% END %]</body>
</html>
TEMPLATE

my $hfi = HTML::FeaturedImage->new;

for my $entry ($feed->entries) {
    my $url = $entry->link;
    $hfi->add_page($url);
}

my $tt = Template->new;
$tt->process(\$template, {hfi => $hfi});

HTML/FeaturedImage.pm

package HTML::FeaturedImage;
use strict;
use warnings;

use URI;
use Web::Scraper;
use List::MoreUtils qw(:all);
use Statistics::Lite qw(:all);

sub new {
    my $pkg = shift;
    bless {}, $pkg;
}

sub urls {
    my $self = shift;
    return @{$self->{urls}};
}

sub add_page {
    my ($self, $url, $content) = @_;
    push @{$self->{urls}}, $url;
    my $uri = URI->new($url);
    
    my $scraper = scraper {
        process "img", 'imgs[]' => '@src';
        process "a", 'anchors[]' => '@href';
    };
    my @args = ($uri);
    unshift @args, \$content if (defined $content);
    my $r = $scraper->scrape(@args);
    
    my @imgs;
    push @imgs, @{$r->{imgs}};
    push @imgs, grep /\.(jpe?g|gif|png|bmp)$/i, @{$r->{anchors}};
    
    map {$self->{db}->{all}->{$_}++} uniq @imgs;
    map {$self->{db}->{$url}->{$_}++} uniq @imgs;
    delete $self->{threshold} if (defined $self->{threshold});
    return $self;
}

sub threshold {
    my $self = shift;
    
    return $self->{threshold} if (defined $self->{threshold});
    
    my @dba = values %{$self->{db}->{all}};
    $self->{threshold} = mean(@dba) + stddevp(@dba)/2;
}

sub predict {
    my ($self, $url) = @_;
    
    my @informative_imgs;
    my $img_db = $self->{db};
    my $all = $img_db->{all};
    
    my $imgs = $img_db->{$url};
    while (my ($img, $num) = each %$imgs) {
        if ($self->threshold >= $all->{$img}) {
            push @informative_imgs, $img;
        }
    }
    
    return @informative_imgs;
}

sub original {
    my ($self, $url) = @_;
    
    return keys %{$self->{db}->{$url}};
}

1;

2007-10-28

TsubuanっぽいAPIを自分でつくる

抽出するところをせっかく作ったので、Tsubuanっぽい動作をするCGIも作ってみた。HTML吐いてるところはお好みでどうぞ。$result->{text}を出力するとTsubuan互換になるはず。そしてengineにTagStructureを使うとさらに性能アップ。

tsubuanlike.cgi

#!/usr/bin/perl
use strict;
use warnings;
use utf8;

use HTML::Feature;
use URI::Escape;

my $url = $ENV{QUERY_STRING};
die unless ($url);
$url =~ s/^url\=//;
$url = uri_unescape($url);

my $feature = HTML::Feature->new(
    engine => 'TsubuanLike',
    enc_type => 'utf-8',
);
my $result = $feature->parse($url);

print "Content-Type: text/xml;charset=utf-8\n\n";
print '<Result><![CDATA['.$result->{html}."]]></Result>\n";