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

use Moose;
use Moose::Util::TypeConstraints;
use MooseX::Types::DateTime;
use MooseX::Types::Digest qw/MD5/;
use MooseX::Types::Email qw/EmailAddress/;
use Digest::MD5 qw/md5_hex/;
use namespace::autoclean;
use Carp;

# ABSTRACT: A user entity that interacts with a web application.

=head1 NAME

Entities::User - A user entity that interacts with a web application.

=head1 VERSION

version 0.2

=head1 SYNOPSIS

	used internally, see L<Entities>

=head1 DESCRIPTION

A user is an entity that interacts with your webapp. Generally, this is
a human person that has signed up for your service, or was created by
a L<customer|Entities::Customer>, though it could be a privileged bot
or whatever.

The user is that actual entity the performs actions on your webapp, and is
thus required to be authorized to perform the actions they wish to perform.
This is done either by assuming <roles|Entities::Role> or by explicitely
being given <actions|Entities::Action>.

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

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

=head1 METHODS

=head2 new( username => 'someguy', passphrase => 's3cr3t', [ realname => 'Some Guy',
is_super => 0, roles => [], actions => [], customer => $customer_obj, id => 123,
emails => [], created => $dt_obj, modified => $other_dt_obj, parent => $entities_obj ] )

Creates a new instance of this module. Only 'username' and 'passphrase'
are required.

=head2 id()

Returns the ID of the user, if set.

=head2 has_id()

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

=head2 _set_id( $id )

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

=cut

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

=head2 username()

Returns the username of this user.

=head2 set_username( $name )

Changes the username of the user to the provided name.

=cut

has 'username' => (is => 'ro', isa => 'Str', required => 1, writer => 'set_username');

=head2 realname()

Returns the real name of the user (i.e. person).

=head2 set_realname( $name )

Changes the real name of the user to the provided name.

=cut

has 'realname' => (is => 'ro', isa => 'Str', writer => 'set_realname');

=head2 passphrase()

Returns an MD5 digest of the passphrase set for this user.

=head2 set_passphrase( $new_passphrase )

Changes the passphrase of the user to the provided passphrase. Automatically
created an MD5 digest of the passphrase, so do not pass a digested string
here.

=cut

has 'passphrase' => (is => 'ro', isa => MD5, required => 1, writer => '_set_passphrase');

sub set_passphrase {
	my ($self, $passphrase) = @_;

	croak "You must provide a passphrase." unless $passphrase;

	$self->_set_passphrase(md5_hex($passphrase));

	return $self;
}

=head2 _roles( [\@roles] )

In scalar context, returns an array-ref of all role names this user
belongs to. In list context returns an array. If an array-ref of
role names is provided, it will replace the current list.

=head2 has_roles()

Returns a true value if the user belongs to any role.

=cut

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

=head2 roles()

Returns an array of all role objects this user belongs to.

=cut

sub roles {
	my $self = shift;

	my @roles;
	foreach ($self->_roles) {
		push(@roles, $self->parent->get_role($_));
	}

	return @roles;
}

=head2 _actions( [\@actions] )

In scalar context, returns an array-ref of all action names this user
has been granted. In list context returns an array. If an array-ref of
action names is provided, it will replace the current list.

=head2 has_actions()

Returns a true value if the user has beene explicitely granted any actions.

=cut

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

=head2 actions()

Returns an array of all action objects this user has been granted.

=cut

sub actions {
	my $self = shift;

	my @actions;
	foreach ($self->_actions) {
		push(@actions, $self->parent->get_action($_));
	}

	return @actions;
}

=head2 is_super()

Returns a true value if this user is a super-user. Super user
can perform every possible action, in ANY SCOPE.

=cut

has 'is_super' => (is => 'ro', isa => 'Bool', default => 0);

=head2 customer()

Returns the L<customer|Entities::Customer> entity this user belongs to,
if any.

=head2 has_customer()

Returns a true value if this user is a child of a customer entity.

=cut

has 'customer' => (is => 'ro', isa => 'Entities::Customer', weak_ref => 1, predicate => 'has_customer');

=head2 emails( [\@emails] )

In scalar context, returns an array-ref of all email addresses set for this
user. In list context returns an array. If an array-ref of email addresses
is provided, it will replace the current list.

=head2 has_emails()

Returns a true value if the user has any emails assigned.

=cut

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

=head2 created()

Returns a L<DateTime> object in the time the user 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';

=head2 add_to_role( $role_name )

Adds the user to role named C<$role_name>. Croaks if such a role does not
exist, warns if the user is already a member of this role. Returns the
user object itself.

=cut

sub add_to_role {
	my ($self, $role_name) = @_;

	croak "You must provide a role name." unless $role_name;

	# does the user already belongs to this role?
	if ($self->belongs_to($role_name)) {
		carp "User ".$self->username." already belongs to role ".$role_name;
		return $self;
	}

	# find this role, does it even exist?
	my $role = $self->parent->get_role($role_name);
	croak "Role $role_name does not exist." unless $role;

	# add the role
	my @roles = $self->_roles;
	push(@roles, $role_name);
	$self->_roles(\@roles);

	return $self;
}

=head2 drop_role( $role_name )

Drops the assignment of the user to the role named C<$role_name>. Warns
if the user doesn't belong to this role, does not croak if the role does
not even exist. Returns the user object itself.

=cut

sub drop_role {
	my ($self, $role_name) = @_;

	croak "You must provide a role name." unless $role_name;

	# does the user even have this role?
	unless ($self->belongs_to($role_name)) {
		carp "User ".$self->username." doesn't have role $role_name.";
		return $self;
	}

	# remove the role
	my @roles;
	foreach ($self->_roles) {
		next if $_ eq $role_name;
		push(@roles, $_);
	}
	$self->_roles(\@roles);

	return $self;
}

=head2 grant_action( $action_name )

Grants the action named C<$action_name> to the user. Croaks if this action
does not exist, warns if the user has already been granted this action.
Returns the user object itself.

=cut

sub grant_action {
	my ($self, $action_name) = @_;

	croak "You must provide an action name." unless $action_name;

	# do we already have this action?
	if ($self->has_direct_action($action_name)) {
		carp "User ".$self->username." already has action ".$action_name;
		return $self;
	}

	# find this action, does it even exist?
	my $action = $self->parent->get_action($action_name);
	croak "Action $action_name does not exist." unless $action;

	# add this action
	my @actions = $self->_actions;
	push(@actions, $action_name);
	$self->_actions(\@actions);

	return $self;
}

=head2 has_direct_action( $action_name )

Returns a true value if the user has been explictely granted the action
named C<$action_name> (i.e. not via roles).

=cut

sub has_direct_action {
	my ($self, $action_name) = @_;

	unless ($action_name) {
		carp "You must provide an action name.";
		return;
	}

	foreach ($self->_actions) {
		return 1 if $_ eq $action_name;
	}

	return;
}

=head2 drop_action( $action_name )

Removes the action named C<$action_name> from the list of actions the user
has been explictely granted to perform. This doesn't necessarily mean the
user will not be able to perform this action anymore, as it might be
available to them via roles. Warns if the user wasn't granted this action,
does not croak if the action does not exist. Returns the user object
itself.

=cut

sub drop_action {
	my ($self, $action_name) = @_;

	croak "You must provide an action name." unless $action_name;

	# do we even have this action?
	unless ($self->has_direct_action($action_name)) {
		carp "User ".$self->username." doesn't have action $action_name.";
		return $self;
	}

	# remove the action
	my @actions;
	foreach ($self->_actions) {
		next if $_ eq $action_name;
		push(@actions, $_);
	}
	$self->_actions(\@actions);

	return $self;
}

=head2 add_email( $email )

Adds the provided email address to the user's list of email addresses.
Warns if the email is already assigned to this user. Does not (yet) check
if the email is not assigned to any other user. Returns the user object
itself.

=cut

sub add_email {
	my ($self, $email) = @_;

	croak "You must provide an email address." unless $email;

	if ($self->has_email($email)) {
		carp "User ".$self->username." already has email $email";
	} else {
		my @emails = $self->emails;
		push(@emails, $email);
		$self->emails(\@emails);
	}

	return $self;
}

=head2 has_email( $email )

Returns a true value if the user has the provided email.

=cut

sub has_email {
	my ($self, $email) = @_;

	unless ($email) {
		carp "You must provide an email address.";
		return;
	}

	foreach ($self->emails) {
		return 1 if $_ eq $email;
	}

	return;
}

=head2 drop_email( $email_address )

Removes the email address given from the user's list of email addresses.
Warns if user doesn't have that address. Returns the user object itself.

=cut

sub drop_email {
	my ($self, $email) = @_;

	croak "You must provide an email address." unless $email;

	# do we even have this action?
	unless ($self->has_email($email)) {
		carp "User ".$self->username." doesn't have email address $email.";
		return $self;
	}

	# remove the email
	my @emails;
	foreach ($self->emails) {
		next if $_ eq $email;
		push(@emails, $_);
	}
	$self->emails(\@emails);

	return $self;
}

=head1 METHODS CONSUMED FROM Abilities

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

=head2 can_perform( $action_name | @action_names )

=head2 belongs_to( $role_name | @role_names )

=head2 inherits_from_role( $role_name | @role_names )

=head2 all_abilities()

=head1 METHOD MODIFIERS

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

=head2 around qw/_roles _actions emails/

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

=cut

around qw/_roles _actions emails/ => sub {
	my ($orig, $self) = (shift, shift);

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

=head2 around BUILDARGS

Called before creating a new instance of Entities::User, this automatically
turns the provided passphrase into an L<MD5 digest|Digest::MD5>.

=cut

around BUILDARGS => sub {
	my ($orig, $class, %params) = @_;

	if ($params{passphrase}) {
		$params{passphrase} = md5_hex($params{passphrase});
	}

	return $class->$orig(%params);
};

=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<roles()>, C<action()> and
C<emails()> methods are not here, since they are only meant to be used
for writing internally.

=cut

after qw/set_realname set_username set_passphrase add_to_role drop_role grant_action drop_action add_email drop_email/ => 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

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;