# MTAmazon 2.22
# Amazon Associates plugin for Movable Type
#
# Copyright 2002 Kalsey Consulting Group
# http://kalsey.com/
# Using this software signifies your acceptance of the license
# agreement that accompanies this software.
#
# Installation and usage instructions can be found at
# http://mtamazon.sourceforge.net/
#
# Last update:
# $Id: MTAmazon.pm,v 1.1 2007/08/29 13:11:45 iay Exp $

package MTPlugins::MTAmazon;

use strict;

# Set configuration variables
my %config;
$config{devtoken} = "";
$config{cachedir} = "./cache";
$config{associateid} = "kalsey-20";

my %months = qw(January 01 February 02 March 03 April 04 May 05 June 06 
                 July 07 August 08 September 09 October 10 November 11 
                 December 12);

my $debug = 0;
my $version = "2.22";

my @arg_related = qw(category title extended excerpt);
my @arg_method = qw(Keyword BrowseNode Asin Upc Author Artist Actor Director Manufacturer Seller Exchange ListMania Wishlist Similarity Power);
my @arg_line = qw(baby books classical dvd electronics garden kitchen magazines music pc-hardware photo software toys universal vhs videogames);
# Sorting doesn't work reliably with Amazon at the moment.
#my %arg_booksort = qw(featured +pmrank sales +salesrank userrating +reviewrank price_asc +pricerank price_desc +inverse-princerank date +daterank title_asc +titlerank title_desc -titlerank);
#my %arg_softsort = qw(featured +pmrank sales +salesrank price title);
#my %arg_outdoorsort = qw(featured sales brand price date title);
#my %arg_toolsort = %arg_outdoorsort;
#my %arg_camerasort = qw(featured +pmrank sales +salesrank title +titlerank);

&readconfig;

sub Amazon {
    my($ctx, $args) = @_;
    eval("use XML::Simple");
    return $ctx->error("XML::Simple is not installed. You need to install it in order to run MTAmazon. See the documentation for instructions on installing the required modules.")
        if ($@);
    use LWP::UserAgent;
    my $url = "";
    my $content = "";
    my($entry, $search, $products, $details, $content_tree);
    if (exists $args->{debug}) {
        $debug = 1;
    }
    my $tokens = $ctx->stash('tokens');
    my $builder = $ctx->stash('builder');
    $args = handle_expressions($ctx, $args);
    my $format = chooseAmazonFormat($tokens);

    # Search string. Check for related attribute first.
    if (exists $args->{related}) {
        defined($entry = $ctx->stash('entry'))
            or return $ctx->error("You used <MTAmazon> and Related outside the context of an entry.");
    }
    # SWITCH: check for related searches and for MT tag searches
    SWITCH: {
        if ($args->{related}) {
           grep {/$args->{related}/} @arg_related
               or return $ctx->error("MTAmazon: " . $args->{related} . "isn't a valid value for the related attribute. Try one of these vaules: " . join(', ', @arg_related));
           if ($args->{related} eq 'category') {
                return '' unless defined(my $cat = $entry->category);
                $search = $cat->label;
                last SWITCH;
            } 
            if (($args->{related} eq 'title')) {
                return '' unless defined($search = $entry->title);
                last SWITCH;
            } 
            if (($args->{related} eq 'extended')) {
                return '' unless defined($search = $entry->text_more);
                last SWITCH;
            } 
            if (($args->{related} eq 'excerpt')) {
                return '' unless defined($search = $entry->excerpt);
                last SWITCH;
            } 
        }
            if (!exists($args->{related}) || length($args->{related})==0) {
                $search = $args->{search};
                last SWITCH;
            }
            return $ctx->error("<MTAmazon> couldn't figure out what to use for a search.");
    }
    defined($search)
        or return $ctx->error("You used <MTAmazon> without a search string.");
    $search =~ s/\s+/%20/g;

    # Associate ID and DevToken
    my $associateid = ($args->{associateid}) ? $args->{associateid} : $config{associateid}; 
    my $devtoken = ($args->{devtoken}) ? $args->{devtoken} : $config{devtoken}; 
    length($devtoken) > 0
        or return $ctx->error("You need an Amazon.com developer's token to use MTAmazon. Visit http://www.amazon.com/webservices/ to apply.");
    $ctx->stash('AmazonAssociateID', $associateid);
    $ctx->stash('AmazonDevToken', $devtoken);

    #Search method. Default is Keyword
    my $method = ($args->{method}) ? $args->{method} : "Keyword";
    #Handle version 1.0 search methods
    $method = "Keyword" if ($method eq "search");
    $method = "BrowseNode" if ($method eq "browse");
    grep {/$method/} @arg_method
           or return $ctx->error("$method isn't a valid search method. Use one of these: " . join(', ', @arg_method));

    # Product line. Default is books
    my $line = ($args->{line}) ? $args->{line} : "books"; 
    grep {/$line/} @arg_line
           or return $ctx->error("$line isn't a valid product line. Use one of these: " . join(', ', @arg_line));
    my $lastn = $args->{lastn} ? $args->{lastn} : 10;
    $lastn =~ m|^\d*$|
        or return $ctx->error("lastn must be a number.");
    my $sort = $args->{sort};
    if ($sort) {
        ValidateSort($sort, $line)
            or return $ctx->error("You can't sort by $sort in $line.");
    }
    debug("Searching $method $search in $line");
    return '' if $lastn == 0;
    # figure how many pages we need to retreive:
    # one page for every 10 or portion thereof
    my $pages = int($lastn/10 + .9999);
    for (my $page = 1; $page <= $pages; $page++) {
        $content = AmazonGetXML($search, $associateid, $method, $line, $devtoken, $page, $format, $sort);
        # Get the timestamp for the cache or use Now if the cache is new
        # If there's already a tmestamp tag, use it. Otherwise use the
        # new timestamp
        my $cacheTime = (@{$content}[0]) ? @{$content}[0] : time();
        $cacheTime = $ctx->stash('AmazonCacheDateTime') ? 
            $ctx->stash('AmazonCacheDateTime') :
            $cacheTime;
        $ctx->stash('AmazonCacheDateTime', $cacheTime);
        eval { $content_tree = XMLin(@{$content}[1]) };
        return $ctx->error("Error reading XML content: $@.")
            if ($@);
        next unless (!$@ and ref $content_tree and ($content_tree->{Details} or $content_tree->{ListingProductDetails}));
        $ctx->stash('AmazonXML', XMLout($content_tree));
        # Load the products from the current iteration of the XML doc
        if ($content_tree->{'Details'}) {
            if ((ref $content_tree->{'Details'}) eq 'HASH') {
                $details = [ $content_tree->{'Details'} ];
            } else {
                $details = $content_tree->{'Details'};
            }
        } elsif ($content_tree->{'ListingProductDetails'}) {
            if ((ref $content_tree->{'ListingProductDetails'}) eq 'HASH') {
                $details = [ $content_tree->{'ListingProductDetails'} ];
            } else {
                $details = $content_tree->{'ListingProductDetails'};
            }
        }
        # Load the curent iteration's products into the main array
        push @$products, @$details;
    }
    return '' unless defined @$products; 
    my $count;
    my $prod = '';
    for my $i (@$products) {
        last if ++$count > $lastn;
        $ctx->stash('AmazonItem', $i);
        my $out = $builder->build($ctx, $tokens);
        return $ctx->error( $builder->errstr ) unless defined $out;
        $prod .= $out;
    }
    $prod;
}

sub AmazonTitle {
    my $ctx = shift;
    defined(my $i = $ctx->stash('AmazonItem'))
        or return '';
    $i->{ProductName} || '';
}

sub AmazonASIN {
    my $ctx = shift;
    defined(my $i = $ctx->stash('AmazonItem'))
        or return '';
    $i->{Asin} || '';
}

sub AmazonArtists {
    my ($ctx, $args) = @_;
    defined(my $i = $ctx->stash('AmazonItem'))
        or return '';
    defined(my $artists = $i->{Artists}->{Artist})
        or return '';
    my $out = '';
    $args = handle_expressions($ctx, $args);
    my $glue = ($args->{glue} || ', ');
    if (ref $artists) {
        $out = join($glue, @$artists);
    } else {
        $out = $artists;
    }
    $out;
}

sub AmazonAuthors {
    my ($ctx, $args) = @_;
    defined(my $i = $ctx->stash('AmazonItem'))
        or return '';
    defined(my $authors = $i->{Authors}->{Author})
        or return '';
    my $out = '';
    $args = handle_expressions($ctx, $args);
    my $glue = ($args->{glue} || ', ');
    if (ref $authors) {
        $out = join($glue, @$authors);
    } else {
        $out = $authors;
    }
    $out;
}

sub AmazonCatalog {
    my $ctx = shift;
    defined(my $i = $ctx->stash('AmazonItem'))
        or return '';
    $i->{Catalog} || '';
}

sub AmazonManufacturer {
    my $ctx = shift;
    defined(my $i = $ctx->stash('AmazonItem'))
        or return '';
    $i->{Manufacturer} || '';
}

sub AmazonUsedPrice {
    my $ctx = shift;
    defined(my $i = $ctx->stash('AmazonItem'))
        or return '';
    $i->{UsedPrice} || '';
}

sub AmazonMediumImage {
    my $ctx = shift;
    defined(my $i = $ctx->stash('AmazonItem'))
        or return '';
    $i->{ImageUrlMedium} || '';
}

sub AmazonSmallImage {
    my $ctx = shift;
    defined(my $i = $ctx->stash('AmazonItem'))
        or return '';
    $i->{ImageUrlSmall} || '';
}

sub AmazonLargeImage {
    my $ctx = shift;
    defined(my $i = $ctx->stash('AmazonItem'))
        or return '';
    $i->{ImageUrlLarge} || '';
}

sub AmazonSalePrice {
    my $ctx = shift;
    defined(my $i = $ctx->stash('AmazonItem'))
        or return '';
    $i->{OurPrice} || '';
}

sub AmazonListPrice {
    my $ctx = shift;
    defined(my $i = $ctx->stash('AmazonItem'))
        or return '';
    $i->{ListPrice} || $i->{OurPrice};
}

sub AmazonReleaseDate { 
    my($ctx, $args) = @_; 
    $args = handle_expressions($ctx, $args);
    defined(my $i = $ctx->stash('AmazonItem')) 
        or return ''; 
    use MT::Util qw( format_ts ); 
    return '' 
        unless $i->{ReleaseDate}; 
    return $i->{ReleaseDate} unless $args->{format}; 
    my $date = $i->{ReleaseDate}; 
    my (undef, $d, $m, $y) = $date =~ m|((\d+)\s+)?(\w+),\s+(\d+)|; 
    $d ||= '00'; 
    $m = $months{$m}; 
    $date = "$y$m$d"; 
    my $out = format_ts($args->{'format'}, $date . "000000", $ctx->stash('blog'));  $out =~ s/\b0{1,2}[,\b]+//g; 
    $out; 
}

sub AmazonLink {
    my $ctx = shift;
    defined(my $i = $ctx->stash('AmazonItem'))
        or return '';
    $i->{url};
}

sub AmazonCacheDateTime {
      my($ctx, $args) = @_;
      $args = handle_expressions($ctx, $args);
      use MT::Util qw( format_ts );
      my @ts = localtime($ctx->stash('AmazonCacheDateTime'));
      my $ts = sprintf "%04d%02d%02d%02d%02d%02d", $ts[5]+1900, $ts[4]+1, @ts[3,2,1,0];
      my $format = $args->{'format'} ? $args->{'format'} : "%B %e, %Y %I:%M %p";
      my $out = format_ts($format, $ts, $ctx->stash('blog'));
      $out;
}

sub AmazonXML {
  my $ctx = shift;
  $ctx->stash('AmazonXML');
}

sub AmazonAssociateID {
    my $ctx = shift;
    $ctx->stash('AmazonAssociateID');
}

sub AmazonDevToken {
    my $ctx = shift;
    $ctx->stash('AmazonDevToken');
}

sub AmazonField { 
    my ($ctx, $args) = @_; 
    $args = handle_expressions($ctx, $args);
    my $name = $args->{name}; 
    return '' unless $name; 
    defined(my $i = $ctx->stash('AmazonItem')) 
     or return ''; 
    if ($name =~ m|/|) {
        my @path = split(/\//, $name);
        $name = pop @path;
        for my $node (@path) {
            $i = $i->{$node};
        }
    }
    $i->{$name} || ''; 
 } 

# ---- Utility Functions --------

sub AmazongetRemoteXML {
    my($search, $associateid, $method, $line, $devtoken, $format, $page, $sort) = @_;
        # Amazon changed the naming of some searches in 2.0. We don't
        # want to break existing templates or require users to update
        # their templates to the new naming convention, so we do some
        # translations here.
        $method = 'Similarity' if $method eq 'Similar';
        # Amazon uses the suffix "Search" on some parameters, "Request"
        # on others, and "Profile" on one so we need to determine which
        # suffix to use. Beware, though, the Amazon documentation is 
        # incorrect. Some items are documented to use a Request sufix
        # but actually use a Search suffix.
        if (grep /$method/, qw(Keyword BrowseNode Asin Upc Author Artist Actor Director Manufacturer Seller Exchange ListMania Wishlist Similarity)) {
           $method .= "Search";
        } elsif (grep /$method/, qw(Power)) {
           $method .= "Request";
        }
    my $url = "http://xml-eu.amazon.com/onca/xml3?t=$associateid&" .
        "dev-t=$devtoken&" .
        "$method=$search&" .
        "mode=$line-uk&type=$format&page=$page&f=xml&locale=uk";
    $url .= "&sort=$sort" if $sort;
    $url .= "&offerstatus=open" if ($method eq 'SellerSearch');
    debug("Getting $url");
    my $ua = new LWP::UserAgent;
    $ua->agent("MTAmazon/$version");
    my $http_request = new HTTP::Request('GET', $url);
    my $http_response = $ua->request($http_request);
    my $content = $http_response->{'_content'};
    $content =~ s/<[^\/]([^>]+)>\s+<\/[^>]+>/<$1 \/>/g; # convert nodes that contain only spaces to empty nodes
    $content;
}

sub AmazonSaveFile {
    my($content, $file) = @_;
    if ($config{cachedir}) {
        debug("Saving cache to $file");
        open (CACHE, ">$file") or warn "Can't write to $file: $!\n";
        print CACHE "$content";
        close CACHE;
    }
}

sub AmazonGetXML {
    my($search, $associateid, $method, $line, $devtoken, $page, $format, $sort) = @_;
    my @content;
    my $file = "$associateid.$format.$method.$search.$line";
    $file =~ s/(\W|%20)//g;
    $file = $config{cachedir}."/amazon." . $file . ".$page.xml";
    open (CACHE, "<$file");
    my @stat = stat($file) unless eof(CACHE);
    close CACHE;
    if (@stat) {
        # Cache exists
        debug("Cache Exists: $file");
        my $CacheTTL = time() - $stat[9];
        if ($CacheTTL > 3600) {
            # Cache is stale
            debug("The cache is stale");
            $content[1] = AmazongetRemoteXML($search, $associateid, $method, $line, $devtoken, $format, $page, $sort);
            AmazonSaveFile($content[1], $file);
            return \@content;
        }
    } else {
        # Cache doesn't exist
        debug("No cache for this query");
        $content[0] = 0;
        $content[1] = AmazongetRemoteXML($search, $associateid, $method, $line, $devtoken, $format, $page, $sort);
        AmazonSaveFile($content[1], $file);
        return \@content;
    }
    # if we got here, then the cache existed and was fresh
    # so load from cache
    $content[0] = $stat[9];
    $content[1] = $file;
    \@content;
}

sub debug {
    my $msg = shift;
    warn "$msg\n" if $debug;
}

sub chooseAmazonFormat {
    my $tokens = shift;
    my @heavy_tags = qw(AmazonField);
    for my $tok (@$tokens) {
        for my $item (@$tok) {
            if ($item =~ m/AmazonField/) {
                return "heavy";
            }
        }
    }
    return "lite";
}

sub ValidateSort {
    my($sort, $line) = @_;
    my $ret = 0;
    ($sort, my $order) = split(/\s/,$sort);
#    SORT: {
#        if ($line eq 'books') {
#            $ret = 1
#                if grep {/$sort/} %arg_booksort;
#            last SORT;
#        }
#        if ($line eq 'software') {
#            $ret = 1
#                if grep {/$sort/} %arg_softsort;
#            last SORT;
#        }
#        if ($line eq 'garden') {
#            $ret = 1
#                if grep {/$sort/} %arg_outdoorsort;
#            last SORT;
#        }
#        if ($line eq 'universal') {
#            $ret = 1
#                if grep {/$sort/} %arg_toolsort;
#            last SORT;
#        }
#        if ($line eq 'photo') {
#            $ret = 1
#                if grep {/$sort/} %arg_camerasort;
#            last SORT;
#        }
#    }
    $ret;
}

# Process MT tags in all arguments. Returns an argument reference
# with all tags processed.
sub handle_expressions {
    my($ctx, $args) = @_;
    use MT::Util qw(decode_html);
    my %new_args;
    my $builder = $ctx->stash('builder');
    for my $arg (keys %$args) {
        my $expr = decode_html($args->{$arg});
        if ( ($expr =~ m/\<MT.*?\>/g) ||
              $expr =~ s/\[(MT(.*?))\]/<$1>/g) {
            my $tok = $builder->compile($ctx, $expr);
            my $out = $builder->build($ctx, $tok);
            return $ctx->error("Error in argument expression: ".$builder->errstr) unless defined $out;
            $new_args{$arg} = $out;
        } else {
            $new_args{$arg} = $expr;
        }
    }
    \%new_args;
}

sub readconfig {
    # start the filename with a dot to prevent errors on older MT versions
    use MT::ConfigMgr;
    my $cfg = MT::ConfigMgr->instance;
    my $path = $cfg->PluginPath;
    my $cfgfile = File::Spec->catfile($path,'.mtamazon.config');
    open FH, $cfgfile or
        die("Error opening file '$path/.mtamazon.config': $!");
    while (<FH>) {
        chomp;
        next if !/\S/ || /^#/;
        my($var, $val) = $_ =~ /^\s*(\S+)\s+(.+)$/;
        $var = lc($var);
        $val =~ s/\s*$//;
        next unless $var && $val;
        die("mtamazon.config: variable '$var' not defined")
            unless exists $config{$var};
        $config{$var} = $val;
    }
    close FH;
    1;
}

1;