#!/usr/local/bin/perl
#
# $Id: asin.cgi,v 0.2 2011/12/08 03:06:55 dankogai Exp dankogai $
#
use strict;
use warnings;
use Encode;
use URI::Amazon::APA;
use LWP::UserAgent;
use XML::Simple;
use YAML::Syck;
use JSON::Syck;
use Fcntl;
use MLDBM qw/DB_File Storable/;

# Make this readable by httpd and unGETttable by users
my $awskey = '/home/dankogai/.awskey.yml';
# Make this readable AND writable by httpd
my $cache   = '/home/www/api/.asin/cache.db';
# You can also change them if you want
my $ttl     = 86400;
my $awsroot = 'http://webservices.amazon.co.jp/onca/xml';
# As of 2011-10-26, you need AssociateTag as well
# https://affiliate.amazon.co.jp/gp/advertising/api/detail/api-changes.html
my $associatetag = 'blogsofdankog-22';

if ( $ENV{PATH_INFO} =~ /\A\/([0-9A-Za-z]{10})\.(yml|xml)\z/ ) {
    my ( $asin, $type ) = ( $1, $2 );
    my $handler = {
        xml => sub {
            print "Content-Type: text/xml; charset=UTF-8\n\n",
              encode_utf8 XMLout( shift, NoAttr => 1 );
        },
        yml => sub {
            print "Content-Type: text/x-yaml; charset=UTF-8\n\n",
              YAML::Syck::Dump(shift);
        },
      }->{$type}
      or die "unknown type : $type";
    $handler->( fetch( $asin, $cache, $ttl, $awskey, $awsroot ) );
}
elsif ( $ENV{PATH_INFO} =~ /\A\/([0-9A-Za-z]{10})\/(.+)\z/ ) {
    my ( $asin, $cb ) = ( $1, $2 );
    print "Content-Type: application/x-javascript; charset=UTF-8\n",
      "Access-Control-Allow-Origin: *\n\n", "$cb(",
      JSON::Syck::Dump( fetch( $asin, $cache, $ttl, $awskey, $awsroot ) ),
      ");\n";
}
else {
    die "invalid PATH_INFO:", $ENV{PATH_INFO};
}

sub fetch {
    my ( $asin, $dbfile, $ttl, $keyfile, $root ) = @_;
    my $ret;
    if ( -f $dbfile ) {
        tie my %db, 'MLDBM', $dbfile, O_RDONLY | O_NONBLOCK, 0444
          or die "$dbfile:$!";
        $ret = $db{$asin};
    }
    if ( $ret && time() < $ret->{mtime} + $ttl ) {
        $ret->{cache} = 1;
    }
    else {
        $ret = ask_aws( $asin, $keyfile, $root );
        if ( $ret->{ASIN} ) {
            tie my %db, 'MLDBM', $dbfile, O_CREAT | O_RDWR | O_EXLOCK, 0666
              or die "$dbfile:$!";
            $ret->{mtime} = time();
            $db{$asin} = $ret;
        }
    }
    $ret;
}

sub ask_aws {
    my ( $asin, $keyfile, $root ) = @_;
    my $awskey = YAML::Syck::LoadFile($keyfile) or die "$awskey:$!";
    my $u = URI::Amazon::APA->new($root);
    $u->query_form(
        Service       => 'AWSECommerceService',
        Operation     => 'ItemLookup',
        ItemId        => $asin,
        ResponseGroup => 'Large',
	AssociateTag  => $associatetag,
    );
    $u->sign(%$awskey);
    my $r = LWP::UserAgent->new->get($u);
    return { Error => { Code => $r->code } } if !$r->is_success;
    my $o = XMLin( $r->content );
    $o->{OperationRequest}{Errors}
      || $o->{Items}{Request}{Errors}
      || $o->{Items}{Item};
}