use utf8;

package Interchange6::Schema::Result::Product;

=head1 NAME

Interchange6::Schema::Result::Product

=cut

use base 'Interchange6::Schema::Base::Attribute';

use DateTime;
use Encode;
use Try::Tiny;

use Interchange6::Schema::Candy -components =>
  [qw(Helper::Row::OnColumnChange Helper::Row::SelfResultSet
      InflateColumn::DateTime TimeStamp)];

=head1 DESCRIPTION

The products table contains three product types parent, child and single.

=over

=item *

B<Parent Product> A parent product is a container product in which variations of parent product or "child products" are linked.

=item *

B<Child Product> A child product for example "Acme Pro 10lb Dumbbell" would include the canonical_sku of the parent item whose description might be something like "Acme Pro Dumbbell".  In general a child product would contain attributes while a parent product would not.

=item *

B<Single Product> A single product does not have child products and will become a parent product if a child product exists.

=back

=cut

=head1 ACCESSORS

=head2 sku

Primary key.

=cut

primary_column sku => {
    data_type     => "varchar",
    size          => 64
};

=head2 name

The name used to identify the product.

=cut

column name => {
    data_type     => "varchar",
    size          => 255
};

=head2 short_description

A brief summary of the product.

=cut

column short_description => {
    data_type     => "varchar",
    default_value => "",
    size          => 500
};

=head2 description

Full product description.

=cut

column description => {
    data_type     => "text"
};

=head2 price

Numeric value representing product cost. Default is 0.0.

When C<price> is updated and product has related
L<Interchange6::Schema::Result::PriceModifier/discount> then also update
the related L<Interchange6::Schema::Result::PriceModifier/price>.
This is done using the method C<update_price_modifiers>.

=cut

column price => {
    data_type          => "numeric",
    default_value      => "0.0",
    size               => [ 10, 2 ],
    keep_storage_value => 1,
};

before_column_change price => {
    method   => 'update_price_modifiers',
    txn_wrap => 1,
};

=head2 uri

Unique product uri.  Example "acme-pro-dumbbells". Is nullable.

=cut

unique_column uri => {
    data_type     => "varchar",
    is_nullable   => 1,
    size => 255
};

=head2 weight

Numeric weight of the product.

Is nullable.

=cut

column weight => {
    data_type   => "numeric",
    size        => [ 10, 2 ],
    is_nullable => 1,
};

=head2 priority

Display order priority.

=cut

column priority => {
    data_type     => "integer",
    default_value => 0
};

=head2 gtin

Unique EAN or UPC type data. Is nullable.

=cut

unique_column gtin => {
    data_type     => "varchar",
    is_nullable   => 1,
    size          => 32
};

=head2 canonical_sku

The SKU of the main product if this product is a variant of a main product.  Is nullable.

=cut

column canonical_sku => {
    data_type     => "varchar",
    is_nullable   => 1,
    size          => 64
};

=head2 active

Is this product active? Default is yes.

=cut

column active => {
    data_type     => "boolean",
    default_value => 1
};

=head2 inventory_exempt

Is this producr exempt from inventory? Default is no.

=cut

column inventory_exempt => {
    data_type     => "boolean",
    default_value => 0
};

=head2 created

Date and time when this record was created returned as L<DateTime> object.
Value is auto-set on insert.

=cut

column created => {
    data_type     => "datetime",
    set_on_create => 1
};

=head2 last_modified

Date and time when this record was last modified returned as L<DateTime> object.
Value is auto-set on insert and update.

=cut

column last_modified => {
    data_type     => "datetime",
    set_on_create => 1,
    set_on_update => 1
};

=head1 RELATIONS

=head2 canonical

Type: belongs_to

Related object: L<Interchange6::Schema::Result::Product>

=cut

belongs_to
  canonical => "Interchange6::Schema::Result::Product",
  { 'foreign.sku' => 'self.canonical_sku' },
  { join_type => 'left' };

=head2 variants

Type: has_many

Related object: L<Interchange6::Schema::Result::Product>

=cut

has_many
  variants => "Interchange6::Schema::Result::Product",
  { "foreign.canonical_sku" => "self.sku" },
  { cascade_copy            => 0, cascade_delete => 0 };

=head2 cart_products

Type: has_many

Related object: L<Interchange6::Schema::Result::CartProduct>

=cut

has_many
  cart_products => "Interchange6::Schema::Result::CartProduct",
  "sku",
  { cascade_copy => 0, cascade_delete => 0 };

=head2 price_modifiers

Type: has_many

Related object: L<Interchange6::Schema::Result::PriceModifier>

=cut

has_many
  price_modifiers => "Interchange6::Schema::Result::PriceModifier",
  "sku",
  { cascade_copy => 0, cascade_delete => 0 };

=head2 inventory

Type: might_have

Related object: L<Interchange6::Schema::Result::Inventory>

=cut

might_have
  inventory => "Interchange6::Schema::Result::Inventory",
  "sku",
  { cascade_copy => 0, cascade_delete => 0 };

=head2 media_products

Type: has_many

Related object: L<Interchange6::Schema::Result::MediaProduct>

=cut

has_many
  media_products => "Interchange6::Schema::Result::MediaProduct",
  "sku",
  { cascade_copy => 0, cascade_delete => 0 };

=head2 merchandising_products

Type: has_many

Related object: L<Interchange6::Schema::Result::MerchandisingProduct>

=cut

has_many
  merchandising_products =>
  "Interchange6::Schema::Result::MerchandisingProduct",
  "sku",
  { cascade_copy => 0, cascade_delete => 0 };

=head2 merchandising_product_related

Type: has_many

Related object: L<Interchange6::Schema::Result::MerchandisingProduct>

=cut

has_many
  merchandising_product_related =>
  "Interchange6::Schema::Result::MerchandisingProduct",
  { "foreign.sku_related" => "self.sku" },
  { cascade_copy          => 0, cascade_delete => 0 };

=head2 navigation_products

Type: has_many

Related object: L<Interchange6::Schema::Result::NavigationProduct>

=cut

has_many
  navigation_products => "Interchange6::Schema::Result::NavigationProduct",
  "sku",
  { cascade_copy => 0, cascade_delete => 0 };

=head2 navigation

Type: many_to_many with navigation

=cut

many_to_many navigations => "navigation_products", "navigation";

=head2 orderlines

Type: has_many

Related object: L<Interchange6::Schema::Result::Orderline>

=cut

has_many
  orderlines => "Interchange6::Schema::Result::Orderline",
  "sku",
  { cascade_copy => 0, cascade_delete => 0 };

=head2 product_attributes

Type: has_many

Related object: L<Interchange6::Schema::Result::ProductAttribute>

=cut

has_many
  product_attributes => "Interchange6::Schema::Result::ProductAttribute",
  "sku",
  { cascade_copy => 0, cascade_delete => 0 };

=head2 media

Type: many_to_many with media

=cut

many_to_many media => "media_products", "media";

=head2 _product_reviews

Type: has_many

Related object: L<Interchange6::Schema::Result::ProductReview>

This is considered a private method. Please see public L</product_reviews> method.

=cut

has_many
  _product_reviews => "Interchange6::Schema::Result::ProductReview",
  "sku", { cascade_copy => 0 };

=head2 _reviews

Type: many_to_many

This is considered a private method. Accessor to related Message results. Please see public L</reviews> and L</add_to_reviews> methods.

=cut

many_to_many _reviews => "_product_reviews", "message";

=head1 METHODS

Attribute methods are provided by the L<Interchange6::Schema::Base::Attribute> class.

=head2 insert

Override inherited method to call L</generate_uri> method in case L</name>
and L</sku> have been supplied as arguments but L</uri> has not.

=cut

sub insert {
    my ( $self, @args ) = @_;
    if ( $self->name && $self->sku && !$self->uri ) {
        $self->generate_uri;
    }
    $self->next::method(@args);
    return $self;
}

=head2 update_price_modifiers

Called when L</price> is updated.

=cut

sub update_price_modifiers {
    my ( $self, $old_value, $new_value ) = @_;

    my $price_modifiers =
      $self->price_modifiers->search( { discount => { '!=' => undef } } );

    while ( my $result = $price_modifiers->next ) {
        $result->update(
            {
                price => sprintf( "%.2f",
                    $new_value - ( $new_value * $result->discount / 100 ) )
            }
        );
    }
}

=head2 generate_uri($attrs)

Called by L</new> if no uri is given as an argument.

The following steps are taken:

=over

1. Join C<< $self->name >> and C<< $self->uri >> with C<-> and stash
in C<$uri> to allow manipulation via filters

2. Remove leading and trailing spaces and replace remaining spaces and
C</> with C<->

3. Search for all rows in L<Interchange6::Schema::Result::Setting> where
C<scope> is C<Product> and C<name> is <generate_uri_filter>

4. For each row found eval C<< $row->value >>

5. Finally set the value of column L</uri> to C<$uri>

=back

Filters stored in L<Interchange6::Schema::Result::Setting> are executed via
eval and have access to C<$uri> and also the product result held in 
C<$self>

Examples of filters stored in Setting might be:

    {
        scope => 'Product',
        name  => 'generate_uri_filter',
        value => '$uri =~ s/badstuff/goodstuff/gi',
    },
    {
        scope => 'Product',
        name  => 'generate_uri_filter',
        value => '$uri = lc($uri)',
    },

=cut

sub generate_uri {
    my $self = shift;

    my $uri = join("-", $self->name, $self->sku);

    # make sure we have clean utf8
    try {
        $uri = Encode::decode( 'UTF-8', $uri, Encode::FB_CROAK )
          unless utf8::is_utf8($uri);
    }
    catch {
        $self->throw_exception(
            "Product->generate_uri failed to decode UTF-8 text: $_" );
    };

    $uri =~ s/^\s+//;       # remove leading space
    $uri =~ s/\s+$//;       # remove trailing space
    $uri =~ s{[\s/]+}{-}g;  # change space and / to -

    my $filters = $self->result_source->schema->resultset('Setting')->search(
        {
            scope => 'Product',
            name  => 'generate_uri_filter',
        },
    );

    while ( my $filter = $filters->next ) {
        eval $filter->value;
        $self->throw_exception("Product->generate_uri filter croaked: $@")
          if $@;
    }

    $self->uri($uri);
}

=head2 path

Produces navigation path for this product.
Returns array reference in scalar context.

Uses $type to select specific taxonomy from navigation if present.

=cut

sub path {
    my ( $self, $type ) = @_;

    my $options = {};

    if ( defined $type ) {
        $options = { "navigation.type" => $type };
    }

    # search navigation entries for this product
    my $navigation_product = $self->search_related(
        'navigation_products',
        $options,
        {
            prefetch => 'navigation',
            order_by => {
                -desc =>
                  [ 'me.priority', 'navigation.priority' ]
            },
            rows => 1,
        }
    )->single;

    my @path;

    if ( defined $navigation_product ) {
        my $nav = $navigation_product->navigation;
        my @anc = $nav->ancestors;

        @path = ( @anc, $nav );
    }

    return wantarray ? @path : \@path;
}

=head2 tier_pricing

Tier pricing can be calculated for a single role and also a combination of several roles.

=over 4

=item Arguments: array reference of L<Role names|Interchange6::Schema::Result::Role/name>

=item Return Value: in scalar context an array reference ordered by quantity ascending of hash references of quantity and price, in list context returns an array instead of array reference

=back

The method always returns the best price for specific price points including
any PriceModifier rows where roles_id is undef.

  my $aref = $product->tier_pricing( 'trade' );

  # [ 
  #   { quantity => 1,   price => 20 }, 
  #   { quantity => 10,  price => 19 }, 
  #   { quantity => 100, price => 18 }, 
  # ]

=cut

# TODO: SysPete is not happy with the initial version of this method.
# Patches always welcome.

sub tier_pricing {
    my ( $self, $args ) = @_;

    my $cond = { 'role.name' => undef };

    if ( $args ) {
        $self->throw_exception(
            "Argument to tier_pricing must be an array reference")
          unless ref($args) eq 'ARRAY';

        $cond = { 'role.name' => [ undef, { -in => $args } ] };
    }

    my @result = $self->price_modifiers->search(
        $cond,
        {
            join   => 'role',
            select => [ 'quantity', { min => 'price' } ],
            as       => [ 'quantity', 'price' ],
            group_by => 'quantity',
            order_by => { -asc => 'quantity' },
            result_class => 'DBIx::Class::ResultClass::HashRefInflator',
        },
    )->all;

    if ( scalar @result && $result[0]->{quantity} < 1 ) {

        # zero or minus qty should not be possible so we adjust to one if found

        $result[0]->{quantity} = 1;
    }

    # maybe no qty 1 tier is defined so make sure we've got one

    if ( scalar @result && $result[0]->{quantity} == 1 ) {
        $result[0]->{price} = $self->price
          if $self->price < $result[0]->{price};
    }
    else {
        unshift @result, +{ quantity => 1, price => $self->price };
    }

    # Remove quantities that are inappropriate due to price at higher
    # quantity being higher (or same as) that a price at a lower quantity.
    # Normally caused when there are different price breaks for different
    # roles but we have been asked to combine multiple roles.

    my @return;
    my $previous;
    foreach my $i ( @result ) {
        push @return, $i;
        unless ( defined $previous ) {
            $previous = $i->{price};
            next;
        }
        pop @return unless $i->{price} < $previous;
    }

    return wantarray ? @return : \@return;
}

=head2 selling_price

Arguments should be given as a hash reference with the following keys/values:

=over 4

=item * quantity => $quantity

=item * roles => array reference of L<Role names|Interchange6::Schema::Result::Role/name>

=back

PriceModifier rows which have roles_is undefined are always included in the search in addition to any C<roles> that are provided as arguments. This enables promotional prices to be specified between fixed dates in L<Pricing price|Interchange6::Schema::Result::Pricing> to apply to all classes of user whether logged in or not.

C<quantity> defaults to 1 if not supplied.

Returns lowest price from L</price> and L<Pricing price|Interchange6::Schema::Result::Pricing/price>.

Throws exception on bad arguments though unexpected keys in the hash reference will be silently discarded.

If the query was constructed using
L<Interchange6::Schema::ResultSet::Product/with_lowest_selling_price> then
the cached value will be used rather than running a new query B<UNLESS>
arguments are supplied in which case a new query is performed.

=cut

sub selling_price {
    my ( $self, $args ) = @_;

    my $price = $self->price;

    if ( $self->has_column_loaded('selling_price') && !defined $args ) {

        # initial query on Product already included selling_price so use it

        return $self->get_column('selling_price');
    }

    if ($args) {
        $self->throw_exception(
            "Argument to selling_price must be a hash reference")
          unless ref($args) eq 'HASH';
    }
    else {
        $args = {};
    }

    # quantity

    if ( defined $args->{quantity} ) {
        $self->throw_exception(
            sprintf( "Bad quantity: %s", $args->{quantity} ) )
          unless $args->{quantity} =~ /^\d+$/;
    }
    else {
        $args->{quantity} = 1;
    }

    # roles

    my $role_cond = undef;

    if ( $args->{roles} ) {
        $self->throw_exception(
            "Argument roles to selling price must be an array reference")
          unless ref( $args->{roles} ) eq 'ARRAY';

        $role_cond = [ undef, { -in => $args->{roles} } ];
    }

    # now finally we can see if there is a better price for this customer

    my $today = $self->result_source->schema->format_datetime(DateTime->today);

    my $selling_price = $self->price_modifiers->search(
        {
            'role.name' => $role_cond,
            quantity => { '<=', $args->{quantity} },
            start_date => [ undef, { '<=', $today } ],
            end_date   => [ undef, { '>=', $today } ],
        },
        {
            join => 'role',
        },
    )->get_column('price')->min;

    return
      defined $selling_price
      && $selling_price < $price ? $selling_price : $price;
}

=head2 highest_price

If this is a canonical product without variants or a variant product then
this method will return undef. If highest price is the same as L</selling_price>
then we again return undef.

If the query was constructed using
L<Interchange6::Schema::ResultSet::Product/with_highest_price> then
the cached value will be used rather than running a new query.

This method calls L</variant_count> and L</selling_price> so when constructing
a resultset query consider also chaining the associated ResultSet methods.

=cut

sub highest_price {
    my $self = shift;

    return undef unless $self->variant_count;

    my $highest_price;

    if ( $self->has_column_loaded('highest_price') ) {
        $highest_price = $self->get_column('highest_price');
    }
    else {
        $highest_price = $self->variants->get_column('price')->max;
    }

    if ( $self->has_column_loaded('selling_price') ) {
        return $highest_price if $highest_price > $self->selling_price;
        return undef;
    }

    if ( $highest_price >
        $self->self_rs->with_lowest_selling_price->single->selling_price )
    {
        return $highest_price;
    }

    return undef;
}

=head2 find_variant \%input [\%match_info]

Find product variant with the given attribute values
in $input.

Returns variant in case of success.

Returns undef in case of failure.

You can pass an optional hash reference \%match_info
which is filled with attribute matches (only valid
in case of failure).

=cut

sub find_variant {
    my ( $self, $input, $match_info ) = @_;

    if ( my $canonical = $self->canonical ) {
        return $canonical->find_variant( $input, $match_info );
    }

    my $gather_matches;

    if ( ref($match_info) eq 'HASH' ) {
        $gather_matches = 1;
    }

    # get all variants
    my $all_variants = $self->search_related('variants');
    my $variant;

    while ( $variant = $all_variants->next ) {
        my $sku;

        if ($gather_matches) {
            $sku = $variant->sku;
        }

        my $variant_attributes = $variant->search_related(
            'product_attributes',
            {
                'attribute.type' => 'variant',
            },
            {
                join     => 'attribute',
                prefetch => 'attribute',
            },
        );

        my %match;

        while ( my $prod_att = $variant_attributes->next ) {
            my $name = $prod_att->attribute->name;

            my $pav_rs =
              $prod_att->search_related( 'product_attribute_values', {},
                { join => 'attribute_value', prefetch => 'attribute_value' } );

            if (   $pav_rs->count != 1
                || !defined $input->{$name}
                || $pav_rs->next->attribute_value->value ne $input->{$name} )
            {
                if ($gather_matches) {
                    $match_info->{$sku}->{$name} = 0;
                    next;
                }
                else {
                    last;
                }
            }

            if ($gather_matches) {
                $match_info->{$sku}->{$name} = 1;
            }

            $match{$name} = 1;
        }

        if ( scalar( keys %$input ) == scalar( keys %match ) ) {
            return $variant;
        }
    }

    return;
}

=head2 attribute_iterator( %args )

=over 4

=item Arguments: C<< hashref => 1 >>

=back

Return a hashref of attributes keyed on attribute name instead of an arrayref.

=over 4

=item Arguments: C<< selected => $sku >>

=back

Set the 'selected' SKU. For a child product this is set automatically.

=over 4

=item Arguments: C<< cond => $cond >>

=back

Search condition to use. Default is:

    { 'attribute.type' => 'variant' }

=over 4

=item Arguments: C<< order_by => $order_by >>

=back

Ordering to use in query. Default is:

    [
        { -desc => 'attribute.priority' },
        { -asc => 'attribute.title' },
        { -desc => 'attribute_value.priority' },
        { -asc => 'attribute_value.title' },
    ]

Set the 'selected' SKU. For a child product this is set automatically.

=over 4

=item Returns: An arrayref of attributes complete with their respective attribute values.

=back

For canonical products, it shows all the attributes of the child products.

For a child product, it shows all the attributes of the siblings.

Example of returned arrayref:

   [
     {
       attribute_values => [
         {
           priority => 2,
           selected => 0,
           title => "Pink",
           value => "pink"
         },
         {
           priority => 1,
           selected => 0,
           title => "Yellow",
           value => "yellow"
         }
       ],
       name => "color",
       priority => 2,
       title => "Color"
     },
     {
       attribute_values => [
         {
           priority => 2,
           selected => 0,
           title => "Small",
           value => "small"
         },
         {
           priority => 1,
           selected => 0,
           title => "Medium",
           value => "medium"
         },
       ],
       name => "size",
       priority => 1,
       title => "Size"
     }
   ]

=cut

sub attribute_iterator {
    my ( $self, %args ) = @_;
    my ($canonical);

    if ( $canonical = $self->canonical ) {

        # get canonical object
        $args{selected} = $self->sku;
        return $canonical->attribute_iterator(%args);
    }

    my $cond = {
        'attribute.type' => 'variant',
    };

    $cond = $args{cond} if defined $args{cond};

    my $order_by = [
        { -desc => 'attribute.priority' },
        { -asc => 'attribute.title' },
        { -desc => 'attribute_value.priority' },
        { -asc => 'attribute_value.title' },
    ];

    $order_by = $args{order_by} if defined $args{order_by};

    # search for variants
    my @prod_atts = $self->search_related('variants')->search_related(
        'product_attributes',
        $cond,
        {
            join    => [
                'attribute', { product_attribute_values => 'attribute_value' },
            ],
            prefetch => [
                'attribute', { product_attribute_values => 'attribute_value' },
            ],
            order_by => $order_by,
        }
    )->hri->all;

    my %attributes;
    my @ordered_names;
    foreach my $prod_att ( @prod_atts ) {
        my $name = $prod_att->{attribute}->{name};

        unless ( exists $attributes{$name} ) {
            push @ordered_names, $name;
            $attributes{$name} = {
                name             => $name,
                title            => $prod_att->{attribute}->{title},
                priority         => $prod_att->{attribute}->{priority},
                value_map        => {},
                attribute_values => [],
            };
        }

        my $att_record = $attributes{$name};

        foreach my $prod_att_val ( @{ $prod_att->{product_attribute_values} } )
        {
            my %attr_value = (
                value    => $prod_att_val->{attribute_value}->{value},
                title    => $prod_att_val->{attribute_value}->{title},
                priority => $prod_att_val->{attribute_value}->{priority},
                selected => 0,
            );

            if ( !exists $att_record->{value_map}->{ $attr_value{value} } ) {
                $att_record->{value_map}->{ $attr_value{value} } = \%attr_value;
                push @{$attributes{$name}->{attribute_values}}, \%attr_value;
            }

            # determined whether this is the current attribute
            if ( $args{selected} && $prod_att->{sku} eq $args{selected} ) {
                $att_record->{value_map}->{ $attr_value{value} }->{selected} =
                  1;
            }
        }
    }

    foreach my $key ( keys %attributes ) {
        delete $attributes{$key}->{value_map};
    }

    if ( $args{hashref} ) {
        return \%attributes;
    }

    return [ map { $attributes{$_} } @ordered_names ];
}

=head2 add_variants @variants

Add variants from a list of hash references.

Returns product object.

Each hash reference contains attributes and column
data which overrides data from the canonical product.

The canonical sku of the variant is automatically set.

Example for the hash reference (attributes in the first line):

     {color => 'yellow', size => 'small',
      sku => 'G0001-YELLOW-S',
      name => 'Six Small Yellow Tulips',
      uri => 'six-small-yellow-tulips'}

Since there is a risk that attributes names might clash with Product column
names (for example L</weight>) an improved syntax exists to prevent such
problems. This is considered to be the preferred syntax:

    {
        sku   => 'ROD00014-2-6-mid',
        uri   => 'fishingrod-weight-2-length-6-flex-mid',
        price => 355,
        attributes => [
            { weight => '2' },
            { length => '6' },
            { action => 'mid' },
        ],
    }

=cut

sub add_variants {
    my ( $self, @variants ) = @_;
    my %attr_map;
    my $attr_rs = $self->result_source->schema->resultset('Attribute');

    for my $var_ref (@variants) {
        my %attr;
        my %product;
        my $sku;

        unless ( exists $var_ref->{sku} && ( $sku = $var_ref->{sku} ) ) {
            die "SKU missing in input for add_variants.";
        }

        if ( defined $var_ref->{attributes} ) {

            # new syntax with explicit attributes

            %attr = %{ delete $var_ref->{attributes} };
        }

        # weed out attribute values that might be mixed in with columns
        # as happens with old syntax

        while ( my ( $name, $value ) = each %$var_ref ) {
            if ( $self->result_source->has_column($name) ) {
                $product{$name} = $value;
            }
            else {
                $attr{$name} = $value;
            }
        }

        while ( my ( $name, $value ) = each %attr ) {

            my ( $attribute, $attribute_value );

            if ( !$attr_map{$name} ) {
                my $set = $attr_rs->search(
                    {
                        name => $name,
                        type => 'variant',
                    }
                );

                if ( !( $attribute = $set->next ) ) {
                    die "Missing variant attribute '$name' for SKU $sku";
                }

                $attr_map{$name} = $attribute;
            }

            # search for attribute value
            unless ( $attribute_value =
                $attr_map{$name}
                ->find_related( 'attribute_values', { value => $value } ) )
            {
                die "Missing variant attribute value '$value'"
                  . " for attribute '$name' and SKU $sku";
            }

            $attr{$name} = $attribute_value;
        }

        # clone with new values
        $product{canonical_sku} = $self->sku;

        $self->copy( \%product );

        # find or create product attribute and product attribute value
        while ( my ( $name, $value ) = each %attr ) {
            my $product_attribute = $attr_map{$name}
              ->find_or_create_related( 'product_attributes', { sku => $sku } );

            $product_attribute->create_related( 'product_attribute_values',
                { attribute_values_id => $value->id } );
        }
    }

    return $self;
}

=head2 discount_percent

If L</selling_price> is lower than L</price> returns the rounded percentage
discount or undef.

B<NOTE:> for parent products (products that have variants) this will always
return undef.

=cut

sub discount_percent {
    my $self = shift;

    if ( $self->variant_count || $self->selling_price == $self->price ) {
        return undef;
    }

    return sprintf( "%.0f",
        ( $self->price - $self->selling_price ) / $self->price * 100 );

}

=head2 media_by_type

Return a Media resultset with the related media, filtered by type
(e.g. video or image). On the results you can call
C<display_uri("type")> to get the actual uri.

=cut

sub media_by_type {
    my ( $self, $typename ) = @_;
    my @media_out;

    # track back the schema and search the media type id
    my $type = $self->result_source->schema->resultset('MediaType')
      ->find( { type => $typename } );
    return unless $type;
    return $self->media->search(
        {
            media_types_id => $type->media_types_id,
        },
        {
            order_by => 'uri',
        }
    );
}

=head2 product_reviews

Reviews should only be associated with parent products. This method returns the related ProductReview records for a parent product. For a child product the ProductReview records for the parent are returned.

=cut

sub product_reviews {
    my $self = shift;
    if ( $self->canonical_sku ) {
        return $self->canonical->_product_reviews;
    }
    else {
        return $self->_product_reviews;
    }
}

=head2 reviews

Reviews should only be associated with parent products. This method returns the related Message (reviews) records for a parent product. For a child product the Message records for the parent are returned.

=over

=item * Arguments: L<$cond|DBIx::Class::SQLMaker> | undef, L<\%attrs?|DBIx::Class::ResultSet#ATTRIBUTES>

=back

Arguments are passed as paremeters to search the related reviews.

=cut

sub reviews {
    my $self = shift;

    # use parent if I have one
    $self = $self->canonical if $self->canonical_sku;

    return $self->_reviews->search(@_);
}

=head2 top_reviews

Returns the highest-rated approved public reviews for this product. Argument is max number of reviews to return which defaults to 5.

=cut

sub top_reviews {
    my ( $self, $rows ) = @_;
    $rows = 5 unless defined $rows;
    return $self->reviews( { public => 1, approved => 1 },
        { rows => $rows, order_by => { -desc => 'rating' } } );
}

=head2 variant_count

Returns the number of variants of this product. If the query was constructed
using L<Interchange6::Schema::ResultSet::Product/with_variant_count> then
the cached value will be used rather than running a new query.

=cut

sub variant_count {
    my $self = shift;
    if ( $self->has_column_loaded('variant_count') ) {
        return $self->get_column('variant_count');
    }
    else {
        return $self->variants->count;
    }
}

=head2 has_variants

Alias for L</variant_count> for backwards-compatibility.

=cut

sub has_variants {
    return shift->variant_count;
}

=head2 average_rating

Returns the average rating across all public and approved product reviews or undef if there are no reviews. Optional argument number of decimal places of precision must be a positive integer less than 10 which defaults to 1.

If the query was constructed using
L<Interchange6::Schema::ResultSet::Product/with_average_rating> then
the cached value will be used rather than running a new query.

=cut

sub average_rating {
    my ( $self, $precision ) = @_;
    my $avg;

    $precision = 1 unless ( defined $precision && $precision =~ /^\d$/ );

    if ( $self->has_column_loaded('average_rating') ) {

        # initial query on Product already included average_rating so use it

        $avg = $self->get_column('average_rating');
    }
    else {

        # we need a new query

        $avg = $self->reviews( { public => 1, approved => 1 } )
          ->get_column('rating')->func('AVG');
    }
    return defined $avg ? sprintf( "%.*f", $precision, $avg ) : undef;
}

=head2 add_to_reviews

Reviews should only be associated with parent products. This method returns the related ProductReview records for a parent product. For a child product the ProductReview records for the parent are returned.

=cut

# much of this was cargo-culted from DBIx::Class::Relationship::ManyToMany

sub add_to_reviews {
    my $self = shift;
    @_ > 0
      or $self->throw_exception( "add_to_reviews needs an object or hashref" );
    my $rset_message = $self->result_source->schema->resultset("Message");
    my $obj;
    if ( ref $_[0] ) {
        if ( ref $_[0] eq 'HASH' ) {
            $_[0]->{type} = "product_review";
            $obj = $rset_message->create( $_[0] );
        }
        else {
            $obj = $_[0];
            unless ( my $type = $obj->message_type->name eq "product_review" ) {
                $self->throw_exception(
                    "cannot add message type $type to reviews" );
            }
        }
    }
    else {
        push @_, type => "product_review";
        $obj = $rset_message->create( {@_} );
    }
    my $sku = $self->canonical_sku || $self->sku;
    $self->product_reviews->create( { sku => $sku, messages_id => $obj->id } );
    return $obj;
}

=head2 set_reviews

=over 4

=item Arguments: (\@hashrefs_of_col_data | \@result_objs)

=item Return Value: not defined

=back

Similar to L<DBIx::Class::Relationship::Base/set_$rel> except that this method DOES delete objects in the table on the right side of the relation.

=cut

sub set_reviews {
    my $self = shift;
    @_ > 0
      or $self->throw_exception(
        "set_reviews needs a list of objects or hashrefs" );
    my @to_set = ( ref( $_[0] ) eq 'ARRAY' ? @{ $_[0] } : @_ );
    $self->product_reviews->delete_all;
    $self->add_to_reviews( $_, ref( $_[1] ) ? $_[1] : {} ) for (@to_set);
}

=head2 quantity_in_stock

Returns undef if L<inventory_exempt> is true and otherwise returns the
quantity of the product in the inventory. For a product variant the
quantity returned is for the variant itself whereas for a canonical
(parent) product the quantity returned is the total for all variants.

If the query was constructed using
L<Interchange6::Schema::ResultSet::Product/with_quantity_in_stock> then
the cached value will be used rather than running a new query.

=cut

sub quantity_in_stock {
    my $self = shift;

    # if already loaded by resultset query then return that value
    return $self->get_column('quantity_in_stock')
      if $self->has_column_loaded('quantity_in_stock');

    my $quantity;
    my $variants = $self->variants;
    if ( $variants->has_rows ) {
        my $not_exempt = $variants->search( { inventory_exempt => 0 } );
        if ( $not_exempt->has_rows ) {
            $quantity = $not_exempt->search_related( 'inventory',
                { quantity => { '>' => 0 } } )->get_column('quantity')->sum;
        }
    }
    elsif ( ! $self->inventory_exempt ) {
        my $inventory = $self->inventory;
        $quantity = defined $inventory ? $self->inventory->quantity : 0;
    }
    return $quantity;
}


=head2 delete

Overload delete to force removal of any product reviews. Only parent products should have reviews so in the case of child products no attempt is made to delete reviews.

=cut

# FIXME: (SysPete) There ought to be a way to force this with cascade delete.

sub delete {
    my ( $self, @args ) = @_;
    my $guard = $self->result_source->schema->txn_scope_guard;
    $self->product_reviews->delete_all unless defined $self->canonical_sku;
    $self->next::method(@args);
    $guard->commit;
}

1;
