« 2007年11月 | メイン | 2008年2月 »

2007年12月 アーカイブ

2007年12月14日

はてなハイク + Web::Scraper

はてなハイクのユーザーになれないから嫉妬している。 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);

2007年12月17日

PerlでYouTubeのGData検索をする

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;

2007年12月27日

yourfilehostの裏API

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>.

About 2007年12月

2007年12月にブログ「Yusukebe::Tech」に投稿されたすべてのエントリーです。過去のものから新しいものへ順番に並んでいます。

前のアーカイブは2007年11月です。

次のアーカイブは2008年2月です。

他にも多くのエントリーがあります。メインページアーカイブページも見てください。


ブログSEO対策:track word seo