File Coverage

blib/lib/Ado/Model/Users.pm

Criterion	Covered	Total	%
statement	46	79	58.2
branch	4	16	25.0
condition	9	15	60.0
subroutine	17	21	80.9
pod	13	13	100.0
total	89	144	61.8

package Ado::Model::Users;    #A table/row class
use 5.010001;
use strict;
use warnings;
use utf8;
use parent qw(Ado::Model);
use Carp;
use Email::Address;
sub is_base_class { return 0 }
my $CLASS      = __PACKAGE__;
my $TABLE_NAME = 'users';

sub TABLE       { return $TABLE_NAME }
sub PRIMARY_KEY { return 'id' }
my $COLUMNS = [
    'id',         'group_id',   'login_name', 'login_password',
    'first_name', 'last_name',  'email',      'description',
    'created_by', 'changed_by', 'tstamp',     'reg_date',
    'disabled',   'start_date', 'stop_date'
];

sub COLUMNS { return $COLUMNS }
my $ALIASES = {};

sub ALIASES { return $ALIASES }
my $CHECKS = {
    'changed_by' => {'allow' => qr/(?^x:^\d{1,}$)/},
    'disabled'   => {
        'required' => 1,
        'defined'  => 1,
        'allow'    => qr/(?^x:^\d{1,1}$)/,
        'default'  => '1'
    },
    'tstamp' => {
        'required' => 1,
        'defined'  => 1,
        'allow'    => qr/(?^x:^\d{1,10}$)/
    },
    'login_password' => {
        'required' => 1,
        'defined'  => 1,

        #result of Mojo::Util::sha1_hex($login_name.$login_password)
        'allow' => qr/^[A-Fa-f0-9]{40}$/x
    },
    'stop_date'   => {'allow' => qr/(?^x:^-?\d{1,}$)/},
    'description' => {
        'allow'   => qr/(?^x:^.{0,255}$)/,
        'default' => ''
    },
    'last_name' => {'allow' => qr/(?^x:^.{1,100}$)/},
    'email'     => {
        'required' => 1,
        'defined'  => 1,
        'allow'    => $Email::Address::addr_spec
    },
    'group_id' => {'allow' => qr/(?^x:^-?\d{1,}$)/},
    'reg_date' => {
        'required' => 1,
        'defined'  => 1,
        'allow'    => qr/(?^x:^-?\d{1,}$)/
    },
    'start_date' => {
        'required' => 1,
        'defined'  => 1,
        'allow'    => qr/(?^x:^-?\d{1,}$)/
    },
    'id'         => {'allow' => qr/(?^x:\d{1,}$)/},
    'login_name' => {
        'required' => 1,
        'defined'  => 1,
        'allow'    => qr/(?^x:^.{1,100}$)/
    },
    'created_by' => {'allow' => qr/(?^x:^-?\d{1,}$)/},
    'first_name' => {'allow' => qr/(?^x:^.{1,100}$)/}
};

sub CHECKS { return $CHECKS }

__PACKAGE__->QUOTE_IDENTIFIERS(0);

#__PACKAGE__->BUILD;#build accessors during load

#find and instantiate a user object by email
sub by_email {
    state $sql = $_[0]->SQL('SELECT') . ' WHERE email=?';
    return $_[0]->query($sql, $_[1]);
}

#find and instantiate a user object by login_name
sub by_login_name {
    state $sql = $_[0]->SQL('SELECT') . ' WHERE login_name=?';
    return $_[0]->query($sql, $_[1]);
}

sub name {
    ref($_[0]) || Carp::croak("The method $_[0]::name must be called only on instances!");
    return $_[0]->{name} ||= do {
        Mojo::Util::trim(
            ($_[0]->{data}{first_name} || '') . ' ' . ($_[0]->{data}{last_name} || ''))
          || $_[0]->{data}{login_name};
    };
}

sub add {
    my $class = shift;
    my $args  = $class->_get_obj_args(@_);
    state $dbix = $class->dbix;

    state $GR = 'Ado::Model::Groups';    #shorten class name
    my ($group, $user);
    my $try = eval {
        $dbix->begin_work;

        #First we need a primary group for the user.
        $group = $GR->create(
            name        => $args->{login_name},
            disabled    => 0,
            description => 'Primary group for user ' . $args->{login_name},
            created_by => $args->{created_by} || 1,
        );

        #Let us create the user now...
        $user = $class->create(
            first_name     => $args->{first_name},
            last_name      => $args->{last_name},
            login_name     => $args->{login_name},
            login_password => $args->{login_password},
            email          => $args->{email},
            disabled       => $args->{disabled},
            tstamp         => time,
            reg_date       => time,
            created_by     => $args->{created_by},
            changed_by     => $args->{changed_by},
            stop_date      => $args->{stop_date},
            start_date     => $args->{start_date},
            description    => $args->{description},
            group_id       => $group->id,
        );

        #And link them additionally
        Ado::Model::UserGroup->create(
            user_id  => $user->id,
            group_id => $group->id
        );
        $dbix->commit;
    };
    unless ($try) {
        $dbix->rollback or croak($dbix->error);
        carp("ERROR adding user(rolling back):[$@]");
    }
    return $user;
}

#Add an existing user to a potentially not existing group(create the group)
sub add_to_group {
    my $self = shift;
    my $args = $self->_get_obj_args(@_);
    state $dbix = $self->dbix;
    state $GR   = 'Ado::Model::Groups';    #shorten class name
    my $ingroup;
    my $try = eval {
        $dbix->begin_work;

        #Create the group if it does not exist yet
        if (!(($ingroup = $GR->by_name($args->{ingroup}))->id)) {
            $ingroup = $GR->create(
                name        => $args->{ingroup},
                disabled    => 0,
                description => 'Additional group initially created for user ' . $self->login_name,
                created_by => $args->{created_by} || 1,
            );
        }

        #Link them
        Ado::Model::UserGroup->create(
            user_id  => $self->id,
            group_id => $ingroup->id
        );
        $dbix->commit;
    };
    unless ($try) {
        $dbix->rollback or croak($dbix->error);
        carp("ERROR adding user to group (rolling back):[$@]");
    }
    return $ingroup;
}

__PACKAGE__->SQL(SELECT_group_names => <<"SQL");
    SELECT name FROM groups
        WHERE id IN (SELECT group_id FROM user_group WHERE user_id=?)
SQL

sub ingroup {
    my ($self, $group) = @_;
    state $sql = __PACKAGE__->SQL('SELECT_group_names');
    my @groups = $self->dbix->query($sql, $self->id)->flat;
    if ($group) {
        return List::Util::first { $_ eq $group } @groups;
    }
    return @groups;
}

$CLASS->SQL('user_id_by_group_name' => <<"UG");
    SELECT user_id FROM user_group WHERE group_id =
        (SELECT id FROM groups  WHERE name = ?)
UG

$CLASS->SQL('by_group_name' => <<"SQL");
    SELECT id, login_name, first_name, last_name, email
    FROM ${\ $CLASS->TABLE }
    WHERE id IN(${\ $CLASS->SQL('user_id_by_group_name') })
        AND (disabled=0 AND (stop_date>? OR stop_date=0) AND start_date
    ORDER BY first_name, last_name ASC

SQL

#Selects users belonging to a group only.
#returns a list of hashes
sub by_group_name {
    my ($class, $group, $limit, $offset) = @_;

    state $SQL = $class->SQL('by_group_name') . $CLASS->SQL_LIMIT('?', '?');
    $limit  //= 500;
    $offset //= 0;
    my $time = time;
    my @a = $class->query($SQL, $group, $time, $time, $limit, $offset);
    return map { +{%{$_->data}, name => $_->name} } @a;
}

1;

=pod

=encoding utf8

=head1 NAME

A class for TABLE users in schema main

=head1 SYNOPSIS


    #In a controller use the helper.
    #Find a user by login_name and change the current user
    my $user       = Ado::Model::Users->by_login_name($login_name);
    $c->user($user);

    #in a template
    Hello, <%=user->name%>!

    #Create a new user.
    my $user = Ado::Model::Users->add(login_name=>'petko'...);
    #Add the user to a group
    $user->add_to_group('cool');

=head1 DESCRIPTION

This class maps to rows in table C.

=head1 ATTRIBUTES

Ado::Model::Users inherits all attributes from Ado::Model
and provides the following.

=head2 name

Readonly. Returns concatenated L and L of the user
or the username (in case the first two are not available).

    # Hello, Guest
    Hello, <%=user->name%>!

=head1 COLUMNS

Each column from table C has an accessor method in this class.

=head2 id

=head2 group_id

=head2 login_name

=head2 login_password

=head2 first_name

=head2 last_name

=head2 email

=head2 description

=head2 created_by

=head2 changed_by

=head2 tstamp

=head2 reg_date

=head2 disabled

=head2 start_date

=head2 stop_date

=head1 ALIASES

none

=head1 METHODS

Ado::Model::Users inherits all methods from Ado::Model and provides the
following additional methods:

=head2 add

Given enough parameters creates a new user object and inserts it  into the
table C. Creates a primary group for the user with the same group
C. Throws an exception if any of the above fails. Returns (the
eventually newly created) user object.

    my $user = Ado::Model::Users->add(
        login_name     => $login_name,
        login_password => Mojo::Util::sha1_hex($login_name.$login_password)
    );

=head2 add_to_group

Adds a user with C to a group.
Creates the group if it does not already exists.
Returns the group.

    $ingroup = $user->add_to_group(ingroup=>'admin');

=head2 by_email

Selects a user by email column.

    my $user = Ado::Model::Users->by_email('[e-mail]');
    say $user->email if $user->id;

=head2 by_group_name

Selects active users (C$now OR stop_date=0)
AND start_date<$now )>) belonging to a given group only and within a given
range, ordered by C alphabetically. C<$limit> defaults
to 500 and C<$offset> to 0. Only the following fields are retrieved: C
login_name, first_name, last_name, email>.

Returns an array of hashes. The L method is executed for each  row in
the resultset and the evaluation is available via key 'name'.

  #get contacts of the user 'berov'
  my @users = Ado::Model::Users->by_group_name('vest_contacts_for_berov', $limit, $offset);

=head2 by_login_name

Selects a user by login_name column.

    my $user = Ado::Model::Users->by_login_name('guest');
    say $user->login_name if $user->id;

=head2 ingroup

Given a group name returns true if a user is member of the group.
Returns false otherwise.
Returns a list of all group names a user belongs to if no group name passed.

    say $user->name . ' is admin!' if $user->ingroup('admin');
    say $user->name .' is member of the following groups:'
    . join(', ', $user->ingroup);

=head1 GENERATOR

L

This class contains also custom code.

=head1 SEE ALSO

L, L,
L, L, L

=cut