package Entities::Plan;
BEGIN {
  $Entities::Plan::VERSION = '0.2';
}

use Moose;
use Moose::Util::TypeConstraints;
use MooseX::Types::DateTime;
use namespace::autoclean;
use Carp;

# ABSTRACT: A collection of features (possibly scoped and limited) customers can subscribe to.

=head1 NAME

Entities::Plan - A collection of features (possibly scoped and limited) customers can subscribe to.

=head1 VERSION

version 0.2

=head1 SYNOPSIS

	used internally, see L<Entities>

=head1 DESCRIPTION

A plan is merely a collection of features. Customer get access to these
features by subscribing to a plan. In a paid webapp, for example, you
might have plans such as 'Free', 'Small', 'Medium' and 'Large', with
feature count increasing from plan to plan. Plans can also inherit from
other plans to make things a little easier.

This entity class C<does> the L<Abilities::Features> L<Moose role|Moose::Role>.

NOTE: you are not meant to create plan objects directly, but only through
the C<new_plan()> method in L<Entities>.

=head1 METHODS

=head2 new( name => 'someplan', [ description => 'Just some plan',
features => [], plans => [], created => $dt_obj, modified => $other_dt_obj,
parent => $entities_obj, id => 123 ] )

Creates a new instance of this module. Only 'name' is required.

=head2 id()

Returns the ID of the plan, if set.

=head2 has_id()

Returns a true value if the plan object has an ID attribute.

=head2 _set_id( $id )

Sets the ID of the plan object to the provided value. Only to be used
internally.

=cut

has 'id' => (is => 'ro', isa => 'Any', predicate => 'has_id', writer => '_set_id');

=head2 name()

Returns the name of the plan.

=cut

has 'name' => (is => 'ro', isa => 'Str', required => 1);

=head2 description()

Returns the description text of this plan.

=head2 set_description( $desc )

Changes the description of the object to the provided value.

=cut

has 'description' => (is => 'ro', isa => 'Str', writer => 'set_description');

=head2 _features( [\@features] )

In scalar context, returns an array-ref of all feature names this plan
directly has. In list context returns an array. If an array-ref of feature
names is provided, it replaces the current list.

=head2 has_features()

Returns a true value if the plan has been assigned any features.

=cut

has '_features' => (is => 'rw', isa => 'ArrayRef[Str]', predicate => 'has_features');

=head2 features()

Returns an array of all feature objects this plan has.

=cut

sub features {
	my $self = shift;

	my @features;
	foreach ($self->_features) {
		push(@features, $self->parent->get_feature($_));
	}

	return @features;
}

=head2 _plans( [\@plans] )

In scalar context, returns an array-ref of plan names this plan inherits
from. In list context returns an array. If an array-ref of plan names
is provided, it will replace the current list.

=head2 has_plans()

Returns a true value if the plan object inherits from any other plan.

=cut

has '_plans' => (is => 'rw', isa => 'ArrayRef[Str]', predicate => 'has_plans');

=head2 plans()

Returns an array of all plan objects this plan inherits from.

=cut

sub plans {
	my $self = shift;

	my @plans;
	foreach ($self->_plans) {
		push(@plans, $self->parent->get_plan($_));
	}

	return @plans;
}

=head2 created()

Returns a L<DateTime> object in the time the plan object has been created.

=cut

has 'created' => (is => 'ro', isa => 'DateTime', default => sub { DateTime->now() });

=head2 modified( [$dt] )

Returns a DateTime object in the last time the object has been modified.
If a DateTime object is provided, it is set as the new modified value.

=cut

has 'modified' => (is => 'rw', isa => 'DateTime', default => sub { DateTime->now() });

=head2 parent()

Returns the L<Entities::Backend> instance that stores this object.

=cut

has 'parent' => (is => 'ro', does => 'Entities::Backend', weak_ref => 1);

with 'Abilities::Features';

=head2 add_feature( $feature_name )

Adds the feature named C<$feature_name> to the plan. Croaks if the
feature does not exist, warns if the plan already has that feature.
Returns the plan object itself.

=cut

sub add_feature {
	my ($self, $feature_name) = @_;

	croak "You must provide a feature name." unless $feature_name;

	# does the plan already have that feature?
	if ($self->has_feature($feature_name)) {
		carp "Plan ".$self->name." already has feature ".$feature_name;
		return $self;
	}

	# find this feature, does it even exist?
	my $feature = $self->parent->get_feature($feature_name);
	croak "feature $feature_name does not exist." unless $feature;

	# add this feature
	my @features = $self->_features;
	push(@features, $feature_name);
	$self->_features(\@features);

	return $self;
}

=head2 drop_feature( $feature_name )

Removes the feature named C<$feature_name> from the plan. This only
removes the feature if it was directly provided to the plan, and not
through inheritance, so it's possible the plan will still have that feature
after removal if it inherits it from a plan that provides it.

Warns if the plan doesn't have that feature, doesn't croak if the
feature does not exist at all. Returns the plan object itself.

=cut

sub drop_feature {
	my ($self, $feature_name) = @_;

	croak "You must provide a feature name." unless $feature_name;

	# does the plan even have this feature?
	unless ($self->has_direct_feature($feature_name)) {
		carp "Plan ".$self->name." doesn't have feature $feature_name.";
		return $self;
	}

	# remove the feature
	my @features;
	foreach ($self->_features) {
		next if $_ eq $feature_name;
		push(@features, $_);
	}
	$self->_features(\@features);

	return $self;
}

=head2 has_direct_feature( $feature_name )

Returns a true value if the plan was directly provided with the
feature named C<$feature_name>.

=cut

sub has_direct_feature {
	my ($self, $feature_name) = @_;

	unless ($feature_name) {
		carp "You must provide a feature name.";
		return;
	}

	# find the feature
	foreach ($self->_features) {
		return 1 if $_ eq $feature_name;
	}

	return;
}

=head2 take_from_plan( $plan_name )

Setup an inheritance from the plan named C<$plan_name>. This plan will
then inherit all features from that plan. Croaks if the provided plan
does not exist, warns if the plan object already inherits from it.
Returns the plan object itself.

=cut

sub take_from_plan {
	my ($self, $plan_name) = @_;

	croak "You must provide a plan name." unless $plan_name;

	# does this plan already inherit from the provided plan?
	if ($self->in_plan($plan_name)) {
		carp "Plan ".$self->name." already takes from ".$plan_name;
		return $self;
	}

	# find the plan, does it even exist?
	my $plan = $self->parent->get_plan($plan_name);
	croak "plan $plan_name does not exist." unless $plan;

	# add the plan
	my @plans = $self->_plans;
	push(@plans, $plan_name);
	$self->_plans(\@plans);

	return $self;
}

=head2 dont_take_from_plan( $plan_name )

This badly named method removes the inheritance between the current plan
object and the plan named C<$plan_name>. Warns if the plan doesn't inherit
from the provided plan. Doesn't croak if C<$plan_name> can't be found.

Returns the plan object itself.

=cut

sub dont_take_from_plan {
	my ($self, $plan_name) = @_;

	croak "You must provide a plan name." unless $plan_name;

	# is the plan even inheriting this plan?
	unless ($self->in_plan($plan_name)) {
		carp "Plan ".$self->name." doesn't have plan $plan_name.";
		return $self;
	}

	# remove the plan
	my @plans;
	foreach ($self->_plans) {
		next if $_ eq $plan_name;
		push(@plans, $_);
	}
	$self->_plans(\@plans);

	return $self;
}

=head1 METHODS CONSUMED FROM Abilities::Features

The following methods are consumed by this class from the L<Abilities::Features>
Moose role. See the documentation for that role for more information on
these methods.

=head2 has_feature( $feature_name | @feature_names )

=head2 in_plan( $plan_name | @plan_names )

=head2 inherits_from_plan( $plan_name | @plan_names )

=head2 all_features()

=head1 METHOD MODIFIERS

The following list documents any method modifications performed through
the magic of L<Moose>.

=head2 around qw/_plans _features/

If the C<_plans()> and C<_features()> methods are called with no arguments
and in list context - will automatically dereference the array-ref into
arrays.

=cut

around qw/_plans _features/ => sub {
	my ($orig, $self) = (shift, shift);

	if (scalar @_) {
		return $self->$orig(@_);
	} else {
		my $ret = $self->$orig || [];
		return wantarray ? @$ret : $ret;
	}
};

=head2 after anything_that_changes_object

Automatically saves the object to the backend after any method that changed
it was executed. Also updates the 'modified' attribute with the current time
before saving. Note, however, that the C<plans()> and C<features()> methods
are not here, since they are only meant to be used for writing internally.

=cut

after qw/set_description add_feature drop_feature take_from_plan dont_take_from_plan/ => sub {
	$_[0]->modified(DateTime->now);
	$_[0]->parent->save($_[0]);
};

=head1 SEE ALSO

L<Entities>.

=head1 AUTHOR

Ido Perlmuter, C<< <ido at ido50 dot net> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-entities at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Entities>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Entities::Plan

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Entities>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Entities>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Entities>

=item * Search CPAN

L<http://search.cpan.org/dist/Entities/>

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2010 Ido Perlmuter.

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.

=cut

__PACKAGE__->meta->make_immutable;
1;