Yusukebe::Tech

using_frontend_proxy: 1

をつけないとポート番号とかがuri_forででて嫌よ。 tomyhero++

Web から時間のかかる処理をキューとしてやらせたくて、TheSchwartz を使おうかと思っているが、 とりあえず Gearman で挙動を確かめてみた。 といっても、ほとんど ZIGOROu さんのコードを参考にさせてもらいました →log4ZIGOROu : Gearmanを使ってみた 目的は時間のかかる処理を Gearman がキューとして受け付けて、順番に処理していく様子を眺めたかったので、

• worker は なんか文字列を受け取って、10秒待ってから、log.txt というファイルに受け取った文字列と共に今の時刻を追加で書き込む
• client は 実行されると dispatch_background メソッドを使って結果を受け取るのを待たずにタスクをディスパッチする。この場合にタスクへの引数は実行された時刻

というサンプルにしてみた。まずは worker 。

!/usr/bin/perl

use strict;
use warnings;

use Gearman::Worker;
use Storable;
use IO::File;

my $worker = Gearman::Worker->new;
$worker->job_servers(qw|localhost|);
$worker->register_function(
    sum => sub {
        my $job = shift;
        sleep(10);
        &work( $job->arg );
    }
);
$worker->work while 1;

sub work {
    my $client_time = shift;
    my $text        = "client:$client_time worker:" . time();
    my $io          = IO::File->new();
    $io->open( 'log.txt', 'a' ) or die $!;
    $io->print("$text\n");
    $io->close;
}

次に client のソース。

#!/usr/bin/perl

use strict;
use warnings;

use Gearman::Client;
use Gearman::Task;

my $client = Gearman::Client->new;
$client->job_servers(qw|localhost|);

$client->dispatch_background( "sum", time(), {} );

gearmand を立ち上げて、worker も実行。 そんでおもむろに client を適当に連射。 するとちゃんとキューとして受け付けて10秒待ってから書き込んでくれてる様子。

client:1204818581 worker:1204818591
client:1204818599 worker:1204818609 #連射スタート
client:1204818600 worker:1204818619
client:1204818601 worker:1204818629
client:1204818601 worker:1204818639
client:1204818602 worker:1204818649
client:1204818602 worker:1204818659
client:1204818603 worker:1204818669
client:1204818668 worker:1204818679 #連射終わる
client:1204818715 worker:1204818725

次は TheSchwartz を使ってみる。

Imager::DTPの縦書きは便利だけど「ー」がうまく「｜」の方向になってくれない。 なので回転させてリフレクトさせた。 場所がずれるのでかなり適当に調整、ぶっちゃけ勘＞＜ ちなみにこんな問題です。

--- Letter.pm.org       2008-02-21 00:36:56.000000000 +0900
+++ Letter.pm   2008-02-21 12:29:39.000000000 +0900
@@ -4,6 +4,7 @@
 use Imager;
 use Imager::Matrix2d;
 use vars qw($VERSION);
+use utf8;

 $VERSION = '0.05';

@@ -67,12 +68,28 @@
                $self->getFont()->transform(matrix=>$m);
        }
        # draw letter - using Imager::String method
+       my $font = $self->getFont;
+       my $x = $o{x} + $self->getLeftBearing();
+       my $y = $o{y} + $self->getGlobalAscent() - $self->getAscent();
+       if($self->getText() eq "ー" ){
+           my $m1 = Imager::Matrix2d->rotate(degrees => 270);
+           my $m2 = Imager::Matrix2d->reflect(axis => 'x');
+           my $matrix = $m1 * $m2;
+           $font->transform(matrix => $matrix);
+           my $bbox = $font->bounding_box( string => $self->getText(),
+                                           size=>$font->{size});
+           $x = $x + $bbox->total_width / 2;
+           $y = $y - $self->getAscent() + $self->getAscent() / 4;
+       }else{
+           my $matrix = Imager::Matrix2d->rotate(degrees => 0);
+            $font->transform(matrix => $matrix);
+       }
        $o{target}->string(
                %{$o{others}},
-               x => $o{x} + $self->getLeftBearing(),
-               y => $o{y} + $self->getGlobalAscent() - $self->getAscent(),
+               x => $x,
+               y => $y,
                text => $self->getText(),
-               font => $self->getFont(),
+               font => $font,
                utf8 => 1, vlayout => 0, align => 0
        ) or die $o{target}->errstr;
        # draw baseline position - for debug

yourfilehostには非公開の裏APIがあって、それを利用すると主に動画のサムネイルがとってこれて便利。 動画、例えばURLだと

http://www.yourfilehost.com/media.php?cat=video&file=guns_dont_kill_people.flv

というのがあるとする。そこにアクセスしてHTMLを覗く。 Flashの動画プレーヤーに引数を渡しているobjectタグの子要素paramタグでname属性がmovieのvalue属性値にヒントがみつかった。 そこが query param 形式になっていてるので、video= から始まるqueryをとってきて逆にdecodeしてみると、長いが

http://www.yourfilehost.com/video-embed.php?vidlink=&cid=a5f6dd20981c6b3a69e949b289613b07&adult=&cat=video&file=guns_dont_kill_people.flv&family=off&videoembed_id=http://liveu-s-64.vo.llnwd.net/yourfilehost/unit1/flash8/a5/a5f6dd20981c6b3a69e949b289613b07.flv?e=1198692000&rs=50&ri=768&h=0b513647b3d06f0eabfea8987d10dbed

というURLになる。ここがAPIのアクセスポイント。 ここにアクセスしてみると、query param 形式でいろいろとその動画の情報を取得できる。 photo=**********.jpg というのもあってサムネイルのURLもとってこれる！ Web::Scraperでスクレイプして、CGIモジュールで解析するのがおそらくスマート。 でもいちいちやってたらめんどいので、モジュール作りました。 テストをworemacxさんに書いてもらったよ。woremacx++; 以下にソースを張っておきます＆CodeReposのここに置いておく→ /lang/perl/WWW-YourFileHost - CodeRepos::Share - Trac

package WWW::YourFileHost;

use warnings;
use strict;
use Carp;
use URI;
use Web::Scraper;
use URI::Escape;
use LWP::UserAgent;
use CGI;

our $VERSION = '0.01';

sub new {
    my ( $class, %opt ) = @_;
    my $self = bless { %opt }, $class;
    $self->_scrape;
    $self;
}

sub _scrape {
    my $self = shift;
    my $url = $self->{url} || croak "url param is requred";
    croak "url is not yourfilehost link"
    unless $url =~ m!yourfilehost.com/media.php\?!;

    my $s = scraper {
    process '//object[@id="objectPlayer"]' =>
        process '//param[@name="movie"]', 'value' => '@value';
    };

    my $res = $s->scrape( URI->new($url) );
    croak "video information is not found" unless $res->{value};
    $res->{value} =~ m/&video=(.*?)&/;
    my $api_url = uri_unescape($1);
    
    my $ua = LWP::UserAgent->new();
    $res = $ua->get($api_url);
    croak "" unless $res->is_success;
    my $query = CGI->new($res->content);
    $self->{query} = $query;
}

sub photo {
    my $self = shift;
    return $self->{query}->param("photo");
}

sub video_id {
    my $self = shift;
    return $self->{query}->param("video_id");
}

sub embed {
    my $self = shift;
    return $self->{query}->param("embed");
}

1;

__END__

=head1 NAME

WWW::YourFileHost - Get video informations from YourFileHost

=head1 VERSION

This document describes WWW::YourFileHost version 0.0.1

=head1 SYNOPSIS

    use WWW::YourFileHost;

    my $url = 
    "http://www.yourfilehost.com/media.php?cat=video&file=hoge.wmv";
    my $yourfilehost = WWW::YourFileHost->new( url => $url );
    print $yourfilehost->photo . "\n";
    print $yourfilehost->video_id . "\n";
    print $yourfilehost->embed . "\n";

=head1 AUTHOR

Yusuke Wada  C<< <yusuke (at) kamawada.com> >>


=head1 LICENCE AND COPYRIGHT

Copyright (c) 2007, Yusuke Wada C<< <yusuke@kamawada.com> >>. All rights reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.

CDTubeのYouTue検索は正規表現のスクレイピングで対応していたが、 HTMLの構造が変わったのか、とってこれなくなった。 よってGDataに移行。 APIキーなくても情報をとってこれるんだね。例

#!/usr/bin/perl

use strict;
use warnings;
use utf8;
use URI::Escape;
use XML::Atom::Feed;
use URI;

my $query = "ダーリン 桑田 佳祐";
my $url = "http://gdata.youtube.com/feeds/api/videos?vq=" .
    URI::Escape::uri_escape_utf8($query);
my $feed = XML::Atom::Feed->new(URI->new($url));
my @entries = $feed->entries;
die "" unless $entries[0];
my $video_id;
foreach my $link ( $entries[0]->link ) {
    my $href = $link->href;
    if($href =~ m!www.youtube.com/watch\?v=(.*)$!){
        $video_id = $1;
    }
}

print $video_id;

はてなハイクのユーザーになれないから嫉妬している。 PlaggerのEFTも書きたい。

use Web::Scraper;
use URI;
use YAML;

my $url = shift || "http://h.hatena.ne.jp/";
my $entries = scraper {
    process 'li.entry', 'entries[]' => scraper {
        process 'div.title', 'title' => 'TEXT';
        process 'span.username > a', 'username' => 'TEXT';
        process 'span.timestamp > a', 'timestamp' => 'TEXT', permalink => '@href';
    };
    result 'entries';
}->scrape(URI->new($url));

print Dump($entries);

born1981のユーザー数がやたら増えてきて目で数えられないので書いた。

var num = 0; var elements = document.getElementsByTagName("input"); for(var i=0;i<elements.length;i++){ if(elements[i].getAttribute('type') == 'submit'){ num++} }; alert(num);

さっき書いたスクリプトを参考にVeohのURLからFLVのパスをEnclosureにセットするPlaggerのassets。CodeReposにうｐした→ /lang/perl/plagger/assets/plugins/Filter-FindEnclosures/veoh.pl - CodeRepos::Share - Trac。

# author: yusukebe

sub handle {
    my ($self, $url) = @_;
    $url =~ qr!http://www.veoh.com/videos/.*!;
}

sub find {
    my ($self, $args) = @_;
    my $id = $args->{url} =~ qr!videos/(.*)! ? $1 : "";
    $id = $1 if $id  =~ /(.*)\?/;
    return unless $id;
    my $ua = Plagger::UserAgent->new;
    my $url = "http://www.veoh.com/rest/video/$id/details";
    my $res = $ua->fetch($url);
    return if $res->is_error;
    my $content = $res->content;
    $content =~ /fullPreviewHashPath="(.*?)"/;
    my $enclosure = Plagger::Enclosure->new;
    $enclosure->url($1);
    $enclosure->type('video/flv');
    $enclosure->filename("$id.flv");
    return $enclosure;
}

Veohって動画共有サイトのビデオ、FLVファイルをダウンロードするスクリプト書いた。 「google videoやyoutubeとかの動画を落として保存。」ってサイトがソース公開という神なことをしてくれていたので、解析する手間が省けた。どうもです。 これからPlaggerのFilter-FindEnclosuresのassetsを書く予定。

#!/usr/bin/perl

use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Request;

my $url = $ARGV[0];
my ( $id, $flv_url, $file_name );
$id = $1 if $url =~ m|videos/(.*)|;
$id = $1 if $id  =~ /(.*)\?/;
die unless $id;

my $ua       = LWP::UserAgent->new( keep_alive => 1 );
my $rest_url = "http://www.veoh.com/rest/video/$id/details";
my $content  = $ua->get($rest_url)->content;
$flv_url = $1 if $content =~ /fullPreviewHashPath="(.*?)"/;
return unless $flv_url;
warn "$url => $id.flv\n";
$ua->request( HTTP::Request->new( GET => $flv_url ), "$id.flv" );

YAML.pm は Merge Key に対応してない。 おそらく、YAML1.0 spec だからだと思われる。 YAML の Merge Key については以下を参照。

• Merge Key Language-Independent Type for YAML?Version?1.1
• RedHanded ≫ YAML's Merge Key