Amazon.co.jp から新刊情報をゲットする

そもそも少なかった本屋に立ち寄る機会がめっきり減ってしまい、買い続けている本の続きが出ていても気付かずにいつの間にか店頭から消えてしまったりして困ってます。かといって「出るかな？出たかな？」と気にし続けるのもせっかちな性格ゆえ精神衛生上よくないので、とりあえず www.amazon.co.jp からデータ取ってくるスクリプトを書いた。

あらかじめ登録しといた検索用キーワードにヒットしたデータから、ローカルのキャッシュファイルにない商品だけをリストアップしてメールで送信する仕組み。これを cron で 1 日 1 回とか実行させとけば、うっかりしてても新刊が出るのに気づけるわけですよ。引きこもりに優しいインターネット。
いろいろ手抜きしてるものだけど、とりあえず晒しておこう。

#!/usr/bin/perl 

use strict;
use warnings;
use utf8;
use FindBin;
use File::Spec;
use Encode;
use Net::Amazon;
#use Cache::File;
use Perl6::Say;
use YAML::Syck;
use Time::HiRes qw(sleep);
use Digest::SHA1 qw(sha1 sha1_hex);
use Storable;
use Template;
use Net::SMTP;
use MIME::Entity;

local $YAML::Syck::ImplicitUnicode = 1;

my $yaml_filename = 'config.yaml';
my $stored = 'stored_titles';
my %default_opts = (
    mode => 'books',
    type => 'Medium',
    'sort' => 'daterank',
);

my $enc = set_encoding();

say 'Load YAML File.';
my $conf_ref = YAML::Syck::LoadFile(
    File::Spec->catfile( $FindBin::Bin, $yaml_filename )
);

my %conf = %{ $conf_ref->{global} };
my $searches_ref = $conf_ref->{titles};

# Stored file name
my $stored_filename = 
    File::Spec->catfile( $FindBin::Bin, $stored );

#my $cache_dir = File::Spec->catdir( $FindBin::Bin, 'cache' );

#my $cache_file = Cache::File->new(
#    cache_root => $cache_dir,
#    default_expires => '30 min',
#);

my $ua = Net::Amazon->new(
    token => $conf{dev_token},
    locale => 'jp',
#    cache => $cache_file,
);

my %title;

say 'Get property by Amazon WebService.';

for my $search_ref ( @{ $searches_ref } ) {
    my %args;
    @args{ keys %{ $search_ref } } =
        map { encode($enc, $_) } values %{ $search_ref };

    say 'Send request: ', join(', ', values %{ $search_ref });

    @args{ keys %default_opts } = (values %default_opts);
    my $res = $ua->search(%args);

    if ( $res->is_error ) {
        warn 'Request failed: ' . $res->message();
        next;
    }

    for my $item ( $res->properties ) {
        my $asin = $item->ASIN;
        my $title = $item->title;
        my $pub_date = $item->publication_date;
        my $authors = '(登録なし)';

        next if !$title or !$pub_date;

        if ( my @ret = ($item->authors) ) {
            my @defined;
            map { push @defined, $_ if defined $_ } @ret;
            $authors = join ', ', @defined;
        }

        my $prop = {
            ASIN => $asin,
            title => $title,
            authors => $authors,
            publisher => $item->publisher,
            price => $item->OurPrice,
            pub_date => $pub_date,
        };

        $title{$asin} = $prop;
    }

    say 'Received response. wait 1 sec.';
    sleep 1;
}

say STDERR YAML::Syck::Dump(\%title);

my %stored_title;

if (-e $stored_filename ) {
    %stored_title = %{ retrieve($stored_filename) };
}

my @new_titles;

for my $asin ( reverse sort keys %title ) {
    if (!exists $stored_title{$asin}) {
        #say 'New item found: ', $title{$asin}{title};

        my $hash_data = encode_utf8( join(' ', values %{ $title{$asin} }) );

        $stored_title{$asin} = sha1( $hash_data );
        push @new_titles, $title{$asin};
    }
}

store \%stored_title, $stored_filename;

if ( @new_titles > 0 ) {
    my @search_vars;

    for my $search_ref ( @{ $searches_ref } ) {
        push @search_vars, join(
            ', ',
            map { "$_ => $search_ref->{$_}" } sort keys %{ $search_ref },
        ) . "\n";
    }

    my $tmpl = Template->new;

    my $vars = {
        associate_id => $conf{associate_id},
        titles_cnt => scalar @new_titles,
        new_titles => \@new_titles,
        search_vars => \@search_vars,
    };

    my $output = '';
    $tmpl->process(\*DATA, $vars, \$output)
        or die $tmpl->error(), "\n";

    my %mconf = %{ $conf_ref->{mail} };

    my $MIME_enc = 'MIME-Header-ISO_2022_JP';
    my $body_enc = 'iso-2022-jp-1';

    my $entity = MIME::Entity->build(
        Encoding => '-SUGGEST',
        Charset => 'iso-2022-jp',
        From => encode($MIME_enc, $mconf{from}),
        To => encode($MIME_enc, $mconf{to}),
        Subject => encode($MIME_enc, $mconf{subject}),
        Data => encode($body_enc, $output),
    );

    say 'Sending mail...';
    my $smtp = Net::SMTP->new( $mconf{host},
        Hello => $mconf{domain},
        Timeout => 30,
    );

    $smtp->mail($mconf{from});
    $smtp->to($mconf{to});

    $smtp->data();
    $smtp->datasend($entity->stringify);
    $smtp->dataend();

    $smtp->quit;
}


sub set_encoding {
    my $enc;

    eval {
        require Term::Encoding;
        $enc = Term::Encoding::get_encoding();

    };

    $enc ||= 'utf-8';

    binmode STDIN, ":encoding($enc)";
    binmode STDOUT, ":encoding($enc)";
    binmode STDERR, ":encoding($enc)";

    return $enc;
}

__END__
新しいアイテムが見つかりました。
全 [% titles_cnt %] 件:
[% FOREACH item = new_titles %]
------------------------------------------------------------
タイトル: [% item.title %]
著者: [% item.authors %]
発売日: [% item.pub_date %]
価格: [% item.price %]
出版社: [% item.publisher %]
URL: http://www.amazon.co.jp/gp/search?ie=UTF8&tag=[% associate_id %]&index=fe-books-jp&linkCode=ur2&camp=247&creative=1211&keywords=[% item.ASIN %]
[% END %]
検索条件:
[% FOREACH item = search_vars %] -[% item %][% END %]
以上です。

Template toolkits を初めて使った。テンプレートをスクリプトに埋め込めるのは、こういうちょっとしたものに使うとき便利ね。

検索のキーワードとかは YAML ファイルに分離させてる。

    - title: 新吼えろペン
      publisher: 小学館

    - title: おおきく振りかぶって
      browsenode: 508086

こんな感じで。browsenode とかは AWS のドキュメントを見てねってことで。

ぐまあーかいぶ

Amazon.co.jp から新刊情報をゲットする

コメント