File Coverage

blib/lib/MojoMojo/Schema/Result/Person.pm

Criterion	Covered	Total	%
statement	27	45	60.0
branch	2	14	14.2
condition	3	6	50.0
subroutine	9	16	56.2
pod	11	11	100.0
total	52	92	56.5

package MojoMojo::Schema::Result::Person;

use strict;
use warnings;

use Digest::SHA;

use parent qw/MojoMojo::Schema::Base::Result/;

use Text::Textile;
my $textile = Text::Textile->new( flavor => "xhtml1", charset => 'utf-8' );

__PACKAGE__->load_components(
    qw/DateTime::Epoch TimeStamp EncodedColumn Core/);
__PACKAGE__->table("person");
__PACKAGE__->add_columns(
    "id",
    {
        data_type         => "INTEGER",
        is_nullable       => 0,
        size              => undef,
        is_auto_increment => 1
    },

    "active",
    # -1 = user registered but hasn't confirmed e-mail address yet;
    # 0 = manually set to inactive from Site Settings -> Users;
    # 1 = active user
    {
        data_type     => "INTEGER",
        is_nullable   => 0,
        default_value => -1,
        size          => undef
    },

    "registered",

#   { data_type => "BIGINT", is_nullable => 0, size => undef, epoch => 'ctime' },
    {
        data_type        => "BIGINT",
        is_nullable      => 0,
        size             => undef,
        inflate_datetime => 'epoch',
        set_on_create    => 1,
    },
    "views",
    { data_type => "INTEGER", is_nullable => 1, size => undef },
    "photo",
    { data_type => "INTEGER", is_nullable => 1, size => undef },
    "login",
    { data_type => "VARCHAR", is_nullable => 0, size => 100 },
    "name",
    { data_type => "VARCHAR", is_nullable => 0, size => 100 },
    "email",
    { data_type => "VARCHAR", is_nullable => 0, size => 100 },
    "pass",
    {
        data_type           => "CHAR",
        is_nullable         => 0,
        size                => 40,
        encode_column       => 1,
        encode_class        => 'Digest',
        encode_args         => { algorithm => 'SHA-1', format => 'hex' },
        encode_check_method => 'check_password',
    },
    "timezone",
    { data_type => "VARCHAR", is_nullable => 1, size => 100 },
    "born",
    {
        data_type                 => "BIGINT",
        is_nullable               => 1,
        size                      => undef,
        default_value             => undef,
        # epoch => 1,
        inflate_datetime          => 'epoch',
        datetime_undef_if_invalid => 1,
    },
    "gender",
    { data_type => "CHAR", is_nullable => 1, size => 1 },
    "occupation",
    { data_type => "VARCHAR", is_nullable => 1, size => 100 },
    "industry",
    { data_type => "VARCHAR", is_nullable => 1, size => 100 },
    "interests",
    { data_type => "TEXT", is_nullable => 1, size => undef },
    "movies",
    { data_type => "TEXT", is_nullable => 1, size => undef },
    "music",
    { data_type => "TEXT", is_nullable => 1, size => undef },
);
__PACKAGE__->set_primary_key("id");
__PACKAGE__->add_unique_constraint( login => [qw/login/], );
__PACKAGE__->add_unique_constraint( email => [qw/email/], );
__PACKAGE__->has_many(
    "entries",
    "MojoMojo::Schema::Result::Entry",
    { "foreign.author" => "self.id" }
);
__PACKAGE__->has_many(
    "tags",
    "MojoMojo::Schema::Result::Tag",
    { "foreign.person" => "self.id" }
);
__PACKAGE__->has_many(
    "comments",
    "MojoMojo::Schema::Result::Comment",
    { "foreign.poster" => "self.id" }
);
__PACKAGE__->has_many(
    "role_members",
    "MojoMojo::Schema::Result::RoleMember",
    { "foreign.person" => "self.id" },
);
__PACKAGE__->has_many(
    "page_versions",
    "MojoMojo::Schema::Result::PageVersion",
    { "foreign.creator" => "self.id" },
);
__PACKAGE__->many_to_many( roles => 'role_members', 'role' );
__PACKAGE__->has_many(
    "contents",
    "MojoMojo::Schema::Result::Content",
    { "foreign.creator" => "self.id" }
);

=head1 NAME

MojoMojo::Schema::Result::Person - store user info

=head1 METHODS

=head2 is_admin

Checks if user belongs to list of admins.

=cut

sub is_admin {
    my $self   = shift;
    my $admins = MojoMojo->pref('admins');
    my $login  = $self->login;
    return 1 if $login && $admins =~ m/\b$login\b/;
    return 0;
}

=head2 link

Returns a relative link to the user's home node.

=cut

sub link {
    my ($self) = @_;
    return lc "/" . ( $self->login || MojoMojo->pref('anonymous_user') );
}

=head2 can_edit <path>

Checks if a user has rights to edit a given path.

=cut

sub can_edit {
    my ( $self, $page ) = @_;
    return 0 unless $self->active;

    # allow admins
    return 1 if $self->is_admin;

    # allow edit unless users are restricted to home page
    return 1 unless MojoMojo->pref('restricted_user');

    # allow users editing their pages
    my $link = $self->link;
    return 1 if $page =~ m|^$link\b|i;
    return 0;
}

=head2 pages

Return the pages created by the user.

=cut

sub pages {
    my ($self) = @_;
    my @pages =
      $self->result_source->related_source('page_versions')
      ->related_source('page')->resultset->search(
        { 'versions.creator' => $self->id, },
        {
            join     => [qw/versions/],
            order_by => ['me.name'],
            distinct => 1,
        }
      )->all;
    return $self->result_source->related_source('page_versions')
      ->related_source('page')->resultset->set_paths(@pages);
}

=head2 pass_matches <pass1> <pass2>

Returns true if pass1 eq pass2.

=cut

sub pass_matches {
    return 1 if ( $_[0] eq $_[1] );
    return 0;
}

=head2 valid_pass <password>

Check password against database.

=cut

sub valid_pass {
    my ( $self, $pass ) = @_;
    return $self->check_password($pass);
}

=head2 hashed

Apply a SHA1 hash to the input string.

=cut

sub hashed {
    my ( $self, $secret ) = @_;
    return Digest::SHA::sha1_hex( $self->id . $secret );
}

# FIXME: the formatter is arbitrarily taken to be Textile; it could be MultiMarkdown
# http://github.com/marcusramberg/mojomojo/issues/#issue/29

=head2 interests_formatted

Format a person's interests.

=cut

sub interests_formatted { $textile->process( shift->interests ); }

=head2 music_formatted

Format a person's music preferences.

=cut
sub music_formatted     { $textile->process( shift->music ); }

=head2 movies_formatted

Format a person's movie tastes.

=cut

sub movies_formatted    { $textile->process( shift->movies ); }

=head2 age

Returns age of the user in years.

=cut

sub age {
    my ($self) = @_;
    if ( my $birthdate = $self->born ) {
        my $diff = DateTime->now - $birthdate;
        return $diff->years;
    }
}

=head1 AUTHOR

Marcus Ramberg <[e-mail]>

=head1 AUTHOR

Marcus Ramberg <[e-mail]>

=head1 LICENSE

This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;