# Copyright 2002-2008 Josh Clark and Global Moxie, LLC. This code cannot be 
# redistributed without permission from globalmoxie.com.  For more
# information, consult your Big Medium license.
#
# $Id: User.pm 3043 2008-03-31 14:00:38Z josh $

package BigMed::User;
use strict;
use warnings;
use utf8;

use base qw(BigMed::Data);
use BigMed::MD5 qw(md5_hex);
use Carp;
$Carp::Verbose = 1;

use BigMed::Priv;
use BigMed::Site;


###########################################################
# SET USER DATA SCHEMA
###########################################################

my @data_schema = (
    {
        name  => 'name',
        type  => 'username',
        unique => 1,
        index => 1,
    },
    {
        name  => 'email',
        type  => 'email',
        index => 1,
    },
    {
        name  => 'level',
        type  => 'number_zeroplus_integer',
        index => 1,
    },
    {
        name  => 'creator',
        type  => 'system_id',
        index => 1,
    },
    {
        name => 'password',
        type => 'password',
    },
    {
        name => 'default_site',
        type => 'system_id',
    },
);

BigMed::User->set_schema(
    source     => 'users',
    label      => 'user',
    elements   => \@data_schema,
    systemwide => 1,
);

BigMed::User->add_callback( 'before_trash', \&_before_trash );
BigMed::User->add_callback( 'before_trash_all', \&_before_trash_all );


###########################################################
# LOGIN METHODS
###########################################################

sub login {

    #returns user object if login successful
    #returns empty string if no such user
    #returns undef if error

    my $class = shift;
    @_ % 2
      && croak "login requires hash argument: Odd number of parameters";
    my %param = @_;
    $param{name} && ( $param{'plain_pass'} || $param{'hash_pass'} )
      or return '';

    my $username        = $param{'name'} || '';
    my $hashed_password = $param{'hash_pass'}
      || $class->encode_password( $param{'plain_pass'} ) || '';
    my $user_id = $param{'id'};

    #get user name by id if we have it, or by user name
    my $user;
    if ($user_id) {
        defined( $user = $class->fetch($user_id) ) or return undef;
        undef $user if $user && $user->name ne $username; #incorrect record
    }
    if ( !$user ) {    #no id, or incorrect user
        defined( $user =
              $class->fetch( { name => $username }, { limit => 1 } ) )
          or return undef;
    }

    return ( $user && $user->password eq $hashed_password )
      ? $user
      : '';
}

sub encode_password {
    my $password = $_[1] || "";
    $password =~ s/^\s+//;
    $password =~ s/\s+$//;
    md5_hex($password);
}

###########################################################
# PRIVILEGE METHODS AND HELPERS
###########################################################

sub set_site_privileges {
    my $user = shift;
    ref $user && $user->isa('BigMed::User')
      or croak "set_site_privileges is an object method";
    @_ % 2
      and croak "set_site_privileges arguments must be a hash; odd number of "
      . "arguments";
    my %param = @_;

    my $user_id = $user->id || $user->update_id or return undef;;

    #set level only if valid and if different than user's level
    my $level = $param{level} ? int($param{level}) : 0;
    my $user_level = $user->level || 0;
    undef $level if $level <1 || $level > 5 || $level eq $user_level;
    
    #get site and section IDs (sections ignored for admins & webmasters)
    (my $site_id = ref $param{site} ? $param{site}->id : $param{site})
      or croak "No site id specified in set_site_privileges";
    my @sections;
    my $is_web_or_admin = (! $level && $user_level > 4) || ($level && $level > 4);
    if ( $param{sections} && ! $is_web_or_admin ) {
        @sections =
          ref $param{sections} eq "ARRAY"
          ? @{ $param{sections} }
          : ( $param{sections} );
    }

    #get existing privilege object if any
    defined(
        my $priv = BigMed::Priv->fetch(
            { user  => $user_id, site => $site_id },
            { limit => 1 }
        )
      )
      or return undef;    #error
    $priv = BigMed::Priv->new() unless $priv;

    if ($user_level > 5) { #admins don't need a privilege object
        if ($priv->id) { #erase the object
            $priv->trash or return undef;
        }
        return 1;
    }

    #populate and save the object
    $priv->set_user($user_id);
    $priv->set_site($site_id);
    $priv->set_level($level);
    $priv->set_sections([ map{  ref $_ ? $_->id : $_ } @sections ]);
    $priv->save or return undef;
    
    #update the privileges (returns undef if error, 1 if successful)
    $user->_update_priv_cache($param{site});
    
}

sub remove_site_privileges {
    my $user = shift;
    my $site = shift
      or croak "remove_site_privileges requires site id or object";
    my $site_id = ref $site ? $site->id : $site;
    my $user_id = $user->id;
    if (!$user_id) {
        carp "Can't remove site privileges for user object with no id";
        return 1;
    };
    #fetch any privilege objects for the site
    defined( my $priv =
          BigMed::Priv->fetch( { user => $user_id, site => $site_id } ) )
      or return undef;    #error
    $priv->trash if $priv;
    $user->_update_priv_cache($site_id) or return undef;
    return 1;
}

sub privilege_level {
    my $user = shift;
    ref $user && $user->isa('BigMed::User')
      or croak "privilege_level is an object method";
    my $user_level = $user->level || 0;

    my ($site, $section) = @_;
    return $user_level if $user_level > 5 || !$site;
    my @sections = ! ref $section          ? ($section)
                 : ref $section ne 'ARRAY' ? ($section->id)
                 :                           @$section;

    #privilege level applies if no section was requested, or if the
    #section is listed
    my $rsite_priv = $user->_get_site_priv($site) or return undef;
    my $level = $rsite_priv->{level};
    foreach my $sec_id (@sections) {
        if ($sec_id && !$rsite_priv->{$sec_id}) {
            $level = 0;
            last;
        }
    }
    $level;
}

sub allowed_site_selection {
    my $user = shift;
    my $level = shift || 0;
    ref $user && $user->isa('BigMed::User')
      or croak "allowed_site_selection is an object method";

    if ( $user->level && $user->level > 5 ) {    #admins ok at all sites
        my $all_sites =
          BigMed::Site->select( {}, { sort => 'name', order => 'ascend' } )
          or return undef;
        $all_sites->count ? $all_sites : '';
    }
    else {                       #non-admin...
        my $user_id = $user->id
          || croak "User ID required to identify site privileges";

        #get the site ids for permitted sites, and return the selection
        my $all_privs = BigMed::Priv->select( { user => $user_id } )
          or return undef;
        my @sites;
        my $priv;
        my $user_level = $user->level || 0;
        while ($priv = $all_privs->next) {
            my $this_level = $priv->level || $user_level;
            push @sites, $priv->site if !$level || $this_level >= $level;
        }
        defined $priv || return undef;
        return '' if !@sites;
        BigMed::Site->select( { id => \@sites },
            { sort => 'name', order => 'ascend' } );
    }
}


sub allowed_section_hash {
    my ($user, $site) = @_;
    ref $user && $user->isa('BigMed::User')
      or croak "allowed_section_hash is an object method";
    my $rsite_priv = $user->_get_site_priv($site) or return ();
    my %site_priv = %$rsite_priv;
    delete $site_priv{level};
    %site_priv;
}

sub can_edit_user {
    my $user     = shift;
    my $target = shift;
    my ($target_id, $target_user);
    if (ref $target) {
        $target_user = $target;
        $target_id = $target_user->id;
    }
    else {
        $target_id = $target;
    }
    
    my $user_level = $user->level || 0;
    if ( $user_level > 5 || ( $target_id && $target_id == $user->id ) ) {
        return 1;    #admins can edit anyone, and anyone can edit themselves
    }
    
   #it's a non-admin trying to edit someone else. check out the details...    
    #editor must be a webmaster at all sites where the user has privs
    #in order to edit the user. Flag webmaster-level sites...
    defined( my $user_sites = $user->allowed_site_selection(5) )
      or return undef;
    return 0 if !$user_sites && $user_level < 5; #no webmaster privs
 
    #any webmaster can edit a new user
    return 1 if !$target_id || ($target_user && !$target_user->id);
    
    #otherwise, have to find out more about the user and their privileges
    if (!$target_user) {
        return undef if !defined( $target_user = BigMed::User->fetch($target_id) );
        if ( !$target_user ) {
            $user->set_error(
                head => 'ACCT_ERR_HEAD_No such user',
                text => 'ACCT_ERR_TEXT_No such user'
            );
            return undef;
        }
    }
    #non-admins can't edit admin
    return 0
      if $target_user->level > 5 && $user_level < 6;


    my $site;
    my %webmaster;
    $webmaster{$site->id} = 1 while $site = $user_sites->next;
    defined $site or return undef;
    
    #user has webmaster privileges at at least one site;
    #collect sites where target user has privileges; must have privs
    #only at sites where editor does not have webmaster privs...
    defined( my $target_sites = $target_user->allowed_site_selection() )
      or return undef;
    return 0 if !$target_sites;
    while ($site = $target_sites->next) {
        return 0 if !$webmaster{$site->id};
    }
    defined $site or return undef;
    1;
}


sub _get_site_priv {
    #returns a *reference* to the cached hash of privilege info for the site
    #(this info is loaded if not yet cached)
    #keys are:
    #level => privilege level
    #all => 1 if all sections allowed
    #[SECTION_ID] => 1 if section is allowed
    
    my $user = shift;
    my $site = shift;   
    ( my $site_id = ref $site ? $site->id : $site )
      or croak "Site ID required to retrieve user privileges";
    my $rpriv_cache = $user->stash('priv_cache')
      || $user->set_stash( 'priv_cache', {} )->stash('priv_cache');
    if ( !defined $rpriv_cache->{$site_id} ) {
        $user->_update_priv_cache($site) or return undef;
    }
    $rpriv_cache->{$site_id};
}

sub _update_priv_cache {
    my ( $user, $site ) = @_;
    my $site_id = ref $site ? $site->id : $site;
    my $rpriv_cache = $user->stash('priv_cache')
      || $user->set_stash( 'priv_cache', {} )->stash('priv_cache');

    #fetch the privilege object for the site
    my $user_id = $user->id || $user->update_id or return undef;
    defined( my $priv =
          BigMed::Priv->fetch( { user => $user_id, site => $site_id } ) )
      or return undef;    #error
    
    my $priv_level; #overall site level
    my @sections;
    if ( !$priv && ( !$user->level || $user->level < 6 ) ) {
        $rpriv_cache->{$site_id} = { level => 0 };
        return 1;
    }
    elsif (!$priv) { #admin
        $priv_level = $user->level || 0;
    }
    else { #got a priv object
        $priv_level = $priv->level || $user->level || 0;
        @sections = $priv->sections;
    }
    $rpriv_cache->{$site_id} = { level => $priv_level };    #reset site cache

    #in order to get complete section info, we need
    #the site object. Load if necessary.
    defined( my $site_obj = ref $site ? $site : BigMed::Site->fetch($site_id) )
      or return undef;                            #error fetching site object
    if ( !$site_obj ) {    #no such site with that id, set privs to 0
        $rpriv_cache->{$site_id} = { level => 0 };
        return 1;
    }

    #if section array empty or user is webmaster+, use homepage to grant
    #permissions to homepage (necessary if want to allow publishers and below
    #to edit homepage)
    if ( @sections == 0 || $priv_level > 4 ) {
        defined ( my $home_id = $site_obj->homepage_id ) or return undef;
        @sections = ($home_id) if $home_id;
        push @sections, $site_obj->all_descendants_ids();
    }

    #mark all privileged sections
    my %sections = (level=> $priv_level, map { $_ => 1} @sections );

#used to automatically mark child sections, too, but seems better to
#explicitly state which sections you want to have. could have cases
#where don't want them to be able to edit subsections
#    foreach my $sec (@sections) {
#        $sections{$sec} = 1;
#        my @child_sections = $site_obj->all_descendants_ids($sec);
#        @sections{@child_sections} = (1) x @child_sections;
#    }

    $rpriv_cache->{$site_id} = \%sections;
    1;
}

sub _before_trash {
    my $user = shift;
    my $uid = $user->id or return 1;
    
    require BigMed::Priv;
    my $priv = BigMed::Priv->select( { user => $uid } ) or return;
    $priv->trash_all or return;

    require BigMed::PageAlert;
    my $alerts = BigMed::PageAlert->select({user=>$uid}) or return;
    $alerts->trash_all or return;
    
    return 1;
}

sub _before_trash_all {
    my $selection = shift;
    return 1 if !$selection->count;
    
    my ($user, @id);
    $selection->set_index(0);
    while ( $user = $selection->next ) {
        push @id, $user->id if $user->id;
    }
    return if !defined $user;
    return 1 if !@id;

    require BigMed::Priv;
    my $privs = BigMed::Priv->select({user=>\@id}) or return;
    $privs->trash_all or return;

    require BigMed::PageAlert;
    my $alerts = BigMed::PageAlert->select({user=>\@id}) or return;
    $alerts->trash_all or return;
    
    return 1;
}
1;

__END__

=head1 NAME

BigMed::User - Big Medium user account record

=head1 DESCRIPTION

A BigMed::User object represents a user account in the Big Medium system. User
objects determine access privileges, content ownership, and login credentials
to the Big Medium system.

=head1 USAGE

BigMed::User is a subclass of BigMed::Data. In addition to the methods 
documented below, please see the BigMed::Data documentation for details about
topics including:

=over 4

=item Creating a new data object

=item Saving a data object

=item Finding and sorting saved data objects

=item Data access methods

=item Error handling

=back

=head1 METHODS

=head2 Data Access Methods

The BigMed::User object holds the following pieces of data. They can be
accessed and set using the standard data access methods described in the
BigMed::Data documentation. See the L<"Searching and Sorting"> section below
for details on the data columns available to search and sort BigMed::Site
objects.

=over 4

=item * id

The numeric ID of the user

=item * name

The username for the account

=item * email

The email address for the account

=item * level

The numeric privilege level indicating the default access level that the user
has at sites and within the Big Medium system. The privilege levels correspond
to these values:

=over 4

=item * 1 = guest

=item * 2 = writer

=item * 3 = editor

=item * 4 = publisher

=item * 5 = webmaster

=item * 6 = administrator

=back

=item * password

The md5-hashed value of the user's plain-text password.

=item * creator

The user id of the user who created this account.

=item * default_site

The id of the site to which the user has indicated he/she would prefer to be
logged into by default, if any.

=item * mod_time

The time when the object was last saved to disk, in UTC (Greenwich Mean)
time. The format: YYYY-MM-DD HH:MM:SS

=item * create_time

The time when the object was first saved to disk, in UTC (Greenwich Mean)
time. The format: YYYY-MM-DD HH:MM:SS

=back

=head2 Searching and Sorting

You can look up and sort records by any combination of the following fields.
See the C<fetch> and C<select> documentation in BigMed::Data for more info.

=over 4

=item * id

=item * mod_time

=item * name

=item * email

=item * level

=item * creator

=back

=head2 C<trash> and C<trash_all> methods

When the C<trash> and C<trash_all> data methods are called on BigMed::User
objects and selections, a few additional steps are taken in addition to
deleting the object(s) from the data store:

=over 4

=item * Associated BigMed::PageAlert objects are removed.

=item * Associated BigMed::Priv objects are removed.

=back

=head2 Login Methods

=over 4

=item BigMed::User->login(name=>$username, plain_pass=>$password)

Returns the user object for the account if the username/password combination is
correct. Returns empty string if no such combination exists, or returns undef
if there was an I/O error.

The arguments are submitted as a hash, and this hash may include the following
key/value pairs:

=over 4

=item * name => $username

The username of the account. This must be submitted with either the
C<plain_pass> or C<hash_pass> key/value pair in order to get a successful
result.

=item * plain_pass => $password

The plain-text password for the account.

=item * hash_pass => $md5_password

The MD5-hashed password for the account. This value takes precedence over
C<plain_pass>; if C<hash_pass> is submitted, C<plain_pass> will be ignored.

=item * id => $user_id

The numeric id of the user account. Providing this value improves the
performance of the account verification.

=back

=item * BigMed::User->encode_password($password)

Returns the MD5-hashed value of the argument.

=back

=head2 Site Privilege Methods

User objects can be used to specify and retrieve the user's privilege level
at individual sites and their sections.

=over 4

=item * $user->set_site_privileges(%args)

Establishes site privileges for the user at the site. If sections are
specified in the C<sections> array, the user's privileges will be limited
only to those sections. Returns some true value on success, or undef if
there was an I/O error.

The hash of argument values may include the following key/value pairs:

=over 4

=item * site

The numeric id or the site object of the site for which you're setting
privileges.

=item * sections => \@sections

An optional array of section IDs or section objects to which the user's
privileges should be limited. An empty or undefined array gives the user
privileges to all sections of the site.

=item * level => $number

The numeric privilege level (1-5, see documentation of the C<level> attribute
above under L<Data Access Methods>) for the user at this site. If unspecified,
the privilege level will be set to the user's default privilege level.

Note that privileges may not be set to 6 (the admin level); admin
privileges may be enjoyed only by users with admin privileges set
in the C<level> attribute of the user object itself.

=back

User accounts with administrator accounts always have privileges
to all sites and all sections. Setting privileges for an admin user has
no effect.

Also, granting webmaster privileges to a site automatically gives the
user access to all sections, and the C<sections> attribute is ignored.

=item * $user->allowed_site_selection($level)

Returns a driver selection object containing the sites to which the
user has permissions. The selection is pre-sorted into alphabetical
order by site name. Returns an empty string if the user does not have
matching privileges at any site. Returns undef if there is an I/O error.

The optional $level argument makes the method return sites where the
user has permissions of the specified level or higher. For example,
this will return a selection object containing sites where the user
has permission levels 4, 5 or 6:

    $user->allowed_site_select(4)

If $level is not specified, the method returns a selection object
containing all sites where the user has permissions of any level.

This code, for example, will print a list of the user's allowed sites,
in alphabetical order:

    my $user = shift;
    defined( my $selection = $user->allowed_site_selection )
      or $user->error_stop;  #i/o error
    if ( !$selection ) {
        print $user->name, " does not have permission at any sites.\n";
    }
    else {
        print $user->name, " has permissions at these sites:\n";
        my $site;
        print $site->name, "\n" while ( $site = $selection->next );
        defined $site || $user->error_stop;    #i/o error
    }

=item * $user->privilege_level($site_obj_or_id, $section_obj_or_id)

Returns the numeric privilege level that the user has at the specified
site and section. Returns 0 if the user has no privileges, or undef if
there was an I/O error.

    defined( my $level = $user->privilege_level($site, $section) )
      or $user->error_stop; #i/o error
    if ($level) {
        #user has privileges at this site and section
    }

The optional site and section arguments may be either the IDs or the objects
for the site and section. If no site is specified, the user's default
privilege level is returned. If a site specified, but not section, then
the return value will be the level that the user has generally at the site
(even though those privileges may extend to only some of the site's sections).

Privilege values are cached in the user object after lookup.

=item * $user->allowed_section_hash($site_obj_or_id)

Returns a hash whose keys are IDs of sections at which the user has
privileges in the site specified in the method argument. The values
of the hash are true values to allow for quick lookups of whether the
user has privileges at the section. This is somewhat faster than
checking privileges via C<privilege_level> for each section in a loop.

The site argument may be either the site ID or the site object itself.

An empty hash in the return value can indicate either that the user has no
section privileges at the site, or that there was an I/O error along
the way. It's good practice to check for an error if an empty hash is
received.

This gets you an unordered list of all allowed sections:

    my %user_sections = $user->allowed_section_hash($site);
    my @unordered_sections = keys %user_sections;
    @unordered_sections == 0 && $user->error && $user->error_stop;

...while the following code gets a list of all allowed sections in tree order
(see documentation for the BigMed::Site C<all_descendants_ids> method).

    my %user_sections = $user->allowed_section_hash;
    keys %user_sections == 0 && $user->error && $user->error_stop;

    #get all descendants of the homepage section
    defined ( my $homepage = $site->homepage_obj ) or $site->error_stop;
    my @all_sections = $homepage
      ? $site->all_descendants_ids($homepage)
      : ();
    my @sorted_sections = grep{$user_sections{$_}} @all_sections;

Privilege values are cached in the user object after lookup.

=back

=item * $user->can_edit_user($other_user)

Returns true if the user has permission to edit the other user. Returns 0
if no permission and undef if there was an error checking the privileges
(if there was an error, the error string is in the error message queue).

The site argument may be either the ID or the object of the other user.

The rules that determine whether one user has permission to edit another
user's settings are:

=over 4

=item 1 Admin users can edit any other user.

=item 2 Any user can edit themselves.

=item 3 Users with webmaster privileges can edit other users
who have privileges only at the sites where the user has webmaster
privileges.

=back

=item * $user->remove_site_privileges($site)

Removes all privileges for the user at the site named in the argument.
The argument can be either the site id or the site object. Returns some
true value if successful, or undef if there was an error.

=back