File Coverage

blib/lib/Interchange6/Role/Costs.pm

Criterion	Covered	Total	%
statement	48	48	100.0
branch	20	20	100.0
condition			n/a
subroutine	10	10	100.0
pod	1	1	100.0
total	79	79	100.0

package Interchange6::Role::Costs;

use Carp;
use Interchange6::Cart::Cost;
use Interchange6::Types -types;

use Moo::Role;
use MooX::HandlesVia;
use MooseX::CoverableModifiers;

=head1 ATTRIBUTES

=head2 costs

Holds an array reference of L items.

When called without arguments returns an array reference of all costs associated with the object. Costs are ordered according to the order they were applied.

=cut

has costs => (
    is          => 'ro',
    isa         => ArrayRef[CartCost],
    coerce      => 1,
    default     => sub { [] },
    handles_via => 'Array',
    handles     => {
        apply_cost  => 'push',
        clear_costs => 'clear',
        cost_get    => 'get',
        cost_set    => 'set',
        cost_count  => 'count',
        get_costs   => 'elements',
    },
    init_arg => undef,
);

after 'clear_costs', 'cost_set', 'apply_cost' => sub {
    shift->clear_total;
};

=head2 total

Returns the sum of the objects L added to its C.

=cut

has total => (
    is        => 'lazy',
    isa       => Num,
    clearer   => 1,
    predicate => 1,
);

sub _build_total {
    my $self = shift;

    my @costs    = $self->get_costs;
    my $subtotal = $self->subtotal;

    my $sum      = 0;
    foreach my $i ( 0 .. $#costs ) {

        if ( $costs[$i]->relative ) {
            $costs[$i]->set_current_amount( $subtotal * $costs[$i]->amount );
        }
        else {
            $costs[$i]->set_current_amount( $costs[$i]->amount );
        }

        if ( $costs[$i]->compound ) {
            $subtotal += $costs[$i]->current_amount;
        }
        elsif ( !$costs[$i]->inclusive ) {
            $sum += $costs[$i]->current_amount;
        }
    }

    return sprintf( "%.2f", $subtotal + $sum );
}

=head1 METHODS

=head2 clear_costs

Removes all the costs previously applied (using apply_cost). Used typically if you have free shipping or something similar, you can clear the costs.

This method also calls L.

=head2 clear_total

Clears L.

=head2 cost_get($index)

Returns an element of the array of costs for the object by its index. You can also use negative index numbers, just as with Perl's core array handling.

=head2 cost_count

Returns the number of cost elements for the object.

=head2 get_costs

Returns all of the cost elements for the object as an array (not an arrayref).

=head2 cost_set($index, $cost)

Sets the cost at C<$index> to <$cost>.

This method also calls L.

=head2 has_total

predicate on L.

=head2 apply_cost

Apply cost to object. L is a generic method typicaly used for taxes, discounts, coupons, gift certificates, etc.

B This method also calls L.

B Absolute cost

Uses absolute value for amount. Amount 5 is 5 units of currency used (i.e. $5).

    $cart->apply_cost(amount => 5, name => 'shipping', label => 'Shipping');

B Relative cost

Uses percentage instead of value for amount. Relative is a boolean value (0/1).

    Add 19% German VAT:

    $cart->apply_cost(
        amount => 0.19, name => 'tax', label => 'VAT', relative => 1
    );

    Add 10% discount (negative amount):

    $cart->apply_cost(
        amount => -0.1, name => 'discount', label => 'Discount', relative => 1
    );


B Inclusive cost

Same as relative cost, but it assumes that tax was included in the subtotal already, and only displays it (19% of subtotal value in example). Inclusive is a boolean value (0/1).

        $cart->apply_cost(amount => 0.19, name => 'tax', label => 'Sales Tax', relative => 1, inclusive => 1);

=cut

around apply_cost => sub {
    my ( $orig, $self, @args ) = @_;

    croak "argument to apply_cost undefined" unless defined $args[0];

    my $cost = CartCost->check( $args[0] ) ? $args[0] : CartCost->coerce(@args);

    $orig->($self, $cost);
};

=head2 cost

Returns particular cost by position or by name.

B Return tax value by name

  $cart->cost('tax');

Returns value of the tax (absolute value in your currency, not percentage)

B Return tax value by position

  $cart->cost(0);

Returns the cost that was first applied to subtotal. By increasing the number you can retrieve other costs applied.

=cut

sub cost {
    my ( $self, $loc ) = @_;
    my ( $cost, $ret );

    if ( defined $loc ) {
        if ( $loc =~ /^\d+$/ ) {

            # cost by position
            $cost = $self->cost_get($loc);
        }
        elsif ( $loc =~ /\S/ ) {

            # cost by name
            for my $c ( $self->get_costs ) {
                if ( $c->name eq $loc ) {
                    $cost = $c;
                }
            }
        }
    }
    else {
        croak "Either position or name required as argument to cost";
    }

    if ( defined $cost ) {
        # calculate total in order to reset all costs
        $self->total;
    }
    else {
        croak "Bad argument to cost: " . $loc;
    }

    return $cost->current_amount;
}

1;