last.fmのプレイリストを1時間おきにtumblrに登録するPerlスクリプト

 最近ECMAScript系ばかりいじってたので、そろそろPerlの方もリハビリ。
 お題はタイトル通り。

#!/usr/local/bin/perl

use strict;
use warnings;
use Encode;
use YAML;
use FindBin;

use DBIx::Simple;
use SQL::Abstract;

use DateTime;
use DateTime::Format::HTTP;
use XML::LibXML::Reader;

use LWP::UserAgent;
use HTTP::Request::Common qw(POST);

use Readonly;
Readonly my $path => $FindBin::Bin . "/";
Readonly my $yml => YAML::LoadFile($path . "lastfm_conf.yml");#スキーマは後述

my $db = DBIx::Simple->new('dbi:SQLite:dbname=' . $path .'lastfeed.db');#スキーマは後述
$db->abstract = SQL::Abstract->new;

my $feed_url = $yml->{lastfm}->{feed} . $yml->{lastfm}->{user} . "/recenttracks.rss";
my $reader = XML::LibXML::Reader->new(location => $feed_url);

while ( $reader->nextElement("item") ) {

    my $rd = XML::LibXML::Reader->new( string => $reader->readOuterXml );
    $rd->nextElement('title');
    my $musician_title = encode( 'utf-8', $rd->readInnerXml );
    $rd->nextElement('link');
    my $link = encode( 'utf-8', $rd->readInnerXml );
    my $album = [ split "/_/", $link ]->[1];
    $album =~ s/[+]/ /g;
    $rd->nextElement('pubDate');
    my $epoch =
      DateTime::Format::HTTP->parse_datetime( $rd->readInnerXml )->epoch;

    my ($count) =
      $db->select( "tracks", "count(*)", { epoch => $epoch } )->list;
    unless ($count) {
        my $dump = {
            epoch          => $epoch,
            album          => $album,
            musician_title => $musician_title,
            link           => $link
        };
        $db->insert( "tracks", $dump );
    }
}

my $now = DateTime->now->set_time_zone( "Asia/Tokyo" );

if ( 0 <= $now->minute && $now->minute < 15 ) {

    my $an_hour_ago = $now->add( hours => -1 );
    $db->delete( "tracks", { epoch => { '<=', $an_hour_ago->epoch } } );

    my @in_body;
    my $result = $db->select( "tracks", "*", undef, ["epoch DESC"] );
    while ( my $row = $result->hash ) {
        my $a =
          '<a href="' . $row->{link} . '">' . $row->{musician_title} . '</a>';
        push @in_body, '<li>' . $a . " : " . $row->{epoch} . '</li>';
    }

    my %formdata = %{ $yml->{tumblr}->{formdata} };
    $formdata{'title'} =
      'last.fm : ' . $an_hour_ago->hour . ' 時台のプレイリスト';
    $formdata{'body'} = '<ol>' . join( "", @in_body ) . '</ol>';
    my $request = POST( $yml->{tumblr}->{api}, [%formdata] );
    LWP::UserAgent->new->request($request) if @in_body;
}

__END__

 あとは、crontabで20〜30分おきにこのスクリプトを呼び出すようにしておく。これくらいの間隔なら、漏れることは多分ないと思う。00分に投稿するのにキリのいい数字だし。

--lastfeed.db
CREATE TABLE tracks (
id INTEGER PRIMARY KEY,
musician_title text,
album text,
link text,
epoch timestamp
);
---
#lastfm_conf.yml
lastfm:
  user: (ユーザ名)
  feed: http://ws.audioscrobbler.com/1.0/user/
tumblr:
  formdata:
    email: (メールアドレス)
    password: (パスワード)
    type: regular
  api: http://www.tumblr.com/api/write

 あと、いくつも意味なしプレイがある気もしますが、そこは「やってみたかったから」ということで。