映画生活のTV放映予定の映画リストをeventcastに登録する

本当は上映されてる映画のスケジュールをeventcastに登録したかったのだけど、
そこまでやろうとするとどうやれば良いのか考え付かなかったので、
とりあえず出来るところからやってみた。

流れは、

映画情報 - ぴあ映画生活にある「今週TV放映予定の映画」っていうTV放映予定の映画リストを取ってくる
Web::Scraperを使ってパーツパーツを切り出す
タグは自分がわかりやすいように☆の数と映画とテレビ局名とかにした
日付が入ってなかったり、またがってたりするので補完
それをeventcastの登録パラメータの形にする
IDとパスワードを書いたYAMLを読み込んでログイン、token文字列を取得して登録

という感じ。

ハマってしまったのが、既に登録済みのイベントでも
http://clip.eventcast.jp/event/post
にpostすると新規登録になってしまい、同じイベントが増えてしまうということ。
この場合は既に登録してあるイベントページに/clipを付けた、
http://clip.eventcast.jp/event/＜ハッシュ＞/clip
にpostすればよさそう。
はじめコレに気づかず/postに登録しまくってしまい、
eventcastの人に「複数登録されてますよ」と連絡を受けた。
こういうところを適当にやっちゃうのが自分のダメなところだな。。

以下ソース。
utf8flagがやっぱりわからないな。
Web::Scraperでutf8flag付きの文字列持ってきて、それをハッシュの中に取り込んでた場合に、
ループさせて一つずつ落としていくしかないのかな。
postのパラメータになるハッシュだから、そのまま渡したいって思ったりもするんだけど。

#!/usr/bin/perl

use strict;
use warnings;

use utf8;
use URI;
use Web::Scraper;
use LWP::UserAgent;
use HTTP::Cookies;
use HTTP::Request;
use HTTP::Headers;
use DateTime;
use YAML::Tiny;
use Encode;

sub add_clips {
    use Data::Dumper;

    my ( $yaml, $movies_ref ) = @_;

    my $conf = YAML::Tiny->new();
    $conf = YAML::Tiny->read($yaml);
    my $cookie_jar = HTTP::Cookies->new(
        autosave       => 1,
        ignore_discard => 1,
    );

    my $ua = LWP::UserAgent->new( keep_alive => 4 );
    $ua->cookie_jar($cookie_jar);

    my $login_url = 'http://clip.eventcast.jp/login';
    my $res = $ua->post( $login_url => $conf->[0] );

    my $confirm_url = 'http://clip.eventcast.jp/event/confirm';
    MOVIE:
    for my $movie_ref ( @{$movies_ref} ) {
        for my $param (values %{$movie_ref}) { # utf-8フラグを落とす
            $param = encode('utf-8', $param);
        }
        my $url = $movie_ref->{url};
        warn "clip $url";
        $res = $ua->get( "$confirm_url?url=$url" );
        my $post_url = $res->request->uri; # 新規なら/post 登録済みなら情報ページ
        my $token = scraper {
            process '#event-edit > input[name="token"]',
                'hidden' => '@value';
            result 'hidden';
        }->scrape( $res->content );
        next MOVIE if ! $token; # 複数登録されてる場合は登録しない

        my %clip_param = (
            'url'      => $url,
            %{$movie_ref},
            'time_flg' => 1,

            'token' => $token,
            'Post'  => encode('utf-8', '登録する'),
        );

        $ua->post( $post_url => \%clip_param ); # 登録
    }
}

sub get_movie_list {
    my $list_url = 'http://www.eigaseikatu.com/title/tvlist/';
    my $year     = DateTime->now->year;

    my $movies = scraper {
        process 'th.date', 'sd' => sub {
            if ( $_->as_text =~ / ([0-9]{1,2}) /xms ) {
                return $1;
            }
        };
        process 'td.time > span.start', 'start' => sub {
            if ( $_->as_text =~ / ([0-9]{2}):([0-9]{2}) /xms ) {
                return +{ h => $1, i => $2 };
            }
        };
        process 'td.time > span.end', 'end' => sub {
            if ( $_->as_text =~ / ([0-9]{2}):([0-9]{2}) /xms ) {
                return +{ h => $1, i => $2 };
            }
        };
        process 'h3 > a',
            'url'   => '@href',
            'title' => 'TEXT';
        process 'span.star > img', 'star' => sub {
            my $src = $_->attr('src');
            return 100 if $src =~ / 100 /xms;
            if ( $src =~ / 0([0-9]{2}) /xms ) {
                return $1;
            }
        };
        process 'span.star', 'channel' => 'TEXT';
        process 'span.commonCaption', 'notes[]' => sub {
            my $note = $_->as_text;
            $note =~ s/\x{a0}//g;
            return $note;
        };
        return 'sd', 'start', 'end', 'url', 'title', 'star', 'channel', 'notes';
    };

    my $list = scraper {
        process 'h2.month', 'month' => sub {
            if ( $_->as_text =~ / ([0-9]{1,2}) /xms ) {
                return $1;
            }
        };
        process 'div#mainTvSchedule > table > tbody > tr',
            'movies[]' => $movies;
        result 'month', 'movies';
    }->scrape( URI->new($list_url) );

    my $month = $list->{month};
    my $pre_movie_ref; # 対象行の前の行 日付の補完に必要
    my $movies_list = $list->{movies};
    my @movies      = map {
        my $movie_ref = $_;
        $movie_ref->{note} = join "\n", @{$movie_ref->{notes}};
        $movie_ref->{tags} = $movie_ref->{star}. "点 映画 テレビ ". $movie_ref->{channel};

        # 日にちの補完
        ( $movie_ref->{sy}, $movie_ref->{sm} )
            = ($pre_movie_ref)
            ? ( $pre_movie_ref->{sy}, $pre_movie_ref->{sm} )
            : ( $year, $month )
            ;    # 表の1行目以外は前の日の情報を使う
        $movie_ref->{sd}
            = ( !$movie_ref->{sd} )
            ? $pre_movie_ref->{sd}
            : $movie_ref->{sd};
        my $start_dt = DateTime->new(
            year      => $movie_ref->{sy},
            month     => $movie_ref->{sm},
            day       => $movie_ref->{sd},
            time_zone => 'Asia/Tokyo',
        );

        # 前の日よりも小さい数字なら1月足す
        $start_dt->add( months => 1 )
            if $pre_movie_ref && $pre_movie_ref->{sd} > $movie_ref->{sd};
        ( $movie_ref->{sy}, $movie_ref->{sm} )
            = ( $start_dt->year, $start_dt->month );
        my ( $start, $end ) = ( $movie_ref->{start}, $movie_ref->{end} );
        # 日付を跨ぐ放送は終わりの時間の日付を足す
        $start_dt->add( days => 1 ) if $end->{h} < $start->{h};
        ( $movie_ref->{ey}, $movie_ref->{em}, $movie_ref->{ed} )
            = ( $start_dt->year, $start_dt->month, $start_dt->day );
        ( $movie_ref->{sh}, $movie_ref->{eh}, $movie_ref->{si}, $movie_ref->{ei} )
            = ( $start->{h}, $end->{h}, $start->{i}, $end->{i} );

        delete $movie_ref->{start};
        delete $movie_ref->{end};
        delete $movie_ref->{notes};
        delete $movie_ref->{star};
        delete $movie_ref->{channel};
        $pre_movie_ref = $movie_ref;
    } ( @{$movies_list} );

    return \@movies;
}

my $yaml = './pass.yml';
my $movies_ref = get_movie_list();
add_clips($yaml, $movies_ref);

YAMLの中身。

---
username: ID
password: パスワード