The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

package WWW::EchoNest::CatalogProxy;

BEGIN {
    our @EXPORT       = ();
    our @EXPORT_OK    = ();
}
use parent qw[ WWW::EchoNest::Proxy Exporter ];

use 5.010;
use strict;
use warnings;
use Carp;
use List::Util qw[ first ];

use WWW::EchoNest;
our $VERSION = $WWW::EchoNest::VERSION;

use WWW::EchoNest::Id qw( is_id );
use WWW::EchoNest::Functional qw(
                                    all
                                    update
                                    make_stupid_accessor
                               );



# FUNCTIONS ############################################################
#
my @types  = qw( artist song );
sub _types { @types }



########################################################################
#
# METHODS
#

# Acceptable catalog types are 'song' and 'artist'
sub new {
    my($class, $args_ref) = @_;
    my $object            = 'catalog';
    my $id                = $args_ref->{id};
    my $name              = $args_ref->{name};
    # pyechonest uses a 'buckets' arg for catalog creation -- not sure why
    # my $buckets           = $args_ref->{buckets}    || [];
    my $type              = $args_ref->{type}       // 'song';

    # Acceptable catalog types
    croak "unrecognized type: $type" if ! grep { $type eq $_ } @types;

    $args_ref->{object}    = $object;
    $args_ref->{type}      = $type if ! exists $args_ref->{type};
    my $instance           = $class->SUPER::new($args_ref);

    my @core_attrs = qw( name );
    my %args = map { $_ => 1 } keys %$args_ref;
    my @provided_attrs = @args{ @core_attrs };
    
    # Get the profile if any of the core_attrs were left out
    if (! all( @provided_attrs )) {
        if ( is_id($id) ) {
            my($profile, $catalog_info);
            eval {
                $profile = $instance->get_attribute( { method => 'profile' } );
                update( $args_ref, $profile->{catalog} );
            };
            croak "Catalog $id does not exist: $@" if $@;
        } else {
            my($profile, $existing_type);
            eval {
                # See if the catalog already exists
                $profile = $instance->get_attribute( { method => 'profile' } );
                $existing_type = $profile->{catalog}{type} // 'Unknown';
		
                if ($type ne $existing_type) {
                    croak "Catalog type requested ($type) does not match "
                          . "existing catalog type ($existing_type)";
                }
                update( $args_ref, $profile->{catalog} );
            };
            if ($@) {
                my $new_catalog_href =
                    $instance->post_attribute(
                                              {
                                               method     => 'create',
                                               type       => $type,
                                               params     => $args_ref,
                                              }
                                             );
                update( $args_ref, $new_catalog_href );
            }
        }
    }
    for my $k (keys %$args_ref) {
        $instance->{$k} = $args_ref->{$k};
    }
    return $instance;
}

sub get_type { $_[0]->{type} }

sub get_id {
    my($self)   = @_;
    my $id      = $self->{id};
    my $type    = $self->{type};

    croak 'No type!' if ! $type;

    if (! defined($id)) {
        my $args_ref = {};
        
        eval {
            my $profile = $self->get_attribute( { method => 'profile', } );
            my $existing_type = $profile->{catalog}{type} // 'Unknown';
		
            if ($type ne $existing_type) {
                croak "Catalog type requested ($type) does not match "
                      . "existing catalog type ($existing_type)";
            }
            update( $args_ref, $profile->{catalog} );
        };
        if ($@) {
            $args_ref->{method} = 'create';
            $args_ref->{type}   = $type;
            update( $args_ref, $self->post_attribute($args_ref) );
        }
        for my $k (keys %$args_ref) {
            $self->{$k} = $args_ref->{$k};
        }
    }

    return $self->{id};
}

make_stupid_accessor( qw[ name ] );

sub get_attribute {
    my($self, $args_ref) = @_;
    my $id     = $self->{id};
    my $name   = $self->{name};
    $args_ref->{id}   = $id      if $id;
    # We shouldn't use both name and id
    $args_ref->{name} = $name    if $name && ! $id;
    return $self->SUPER::get_attribute( $args_ref );
}

# Doesn't add the id or name fields
sub get_attribute_simple {
    my $self = shift;
    return $self->SUPER::get_attribute( @_ );
}

sub post_attribute {
    my($self, $args_ref) = @_;
    my $id     = $self->{id};
    my $name   = $self->{name};
    $args_ref->{id}   = $id      if $id;
    # We shouldn't use both name and id
    $args_ref->{name} = $name    if $name && ! $id;
    return $self->SUPER::post_attribute( $args_ref );
}

1;

__END__

=head1 NAME

WWW::EchoNest::CatalogProxy
For internal use only!

=head1 AUTHOR

Brian Sorahan, C<< <bsorahan@gmail.com> >>

=head1 SUPPORT

Join the Google group: <http://groups.google.com/group/www-echonest>

=head1 ACKNOWLEDGEMENTS

Thanks to all the folks at The Echo Nest for providing access to their
powerful API.

=head1 LICENSE AND COPYRIGHT

Copyright 2011 Brian Sorahan.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.