Transports/Model/User.pm

use strict;
use warnings;

package Transports::Model::User::Schema;
use Jifty::DBI::Schema;
use Transports::Model::UserOnSourceCollection;

# Your column definitions go here.  See L<Jifty::DBI::Schema> for
# documentation about how to write column definitions.

column name => 
    type is 'text',
    label is 'Name',
    is mandatory,
    is distinct;

column email =>
    type is 'text',
    label is 'Email address',
    is mandatory,
    is distinct;

column password =>
    type is 'text',
    label is 'Password',
    is mandatory,
    render_as 'password';

column admin =>
        type is 'boolean',
        label is 'Administrator',
        is mandatory,
        default is 'false',
        since '0.0.8';

column sources =>
        refers_to Transports::Model::UserOnSourceCollection by 'user_on',
        label is 'Source systems',
        since '0.0.10';

package Transports::Model::User;
use base qw/Transports::Record/;

# Your model-specific methods go here.

=head2 password_is STRING

Returns true if and only if the current user's password matches STRING

=cut


sub password_is {
        my $self = shift;
        my $string = shift || return;
        warn "password_is ", $self->_value('password'), " == $string\n";
        return 1 if ($self->_value('password') eq $string);
        return 0;
}

=head2 password

Never display a password

=cut

sub password {
        return '*****';
}

=head2 current_user_can

Allows the current user to see all their own attributes and
everyone else to see their username.

Allows the current user to update any of their own attributes
except whether or not their email has been confirmed.

Passes everything else off to the superclass.

=cut


sub current_user_can {
    my $self  = shift;
    my $right = shift;
    my %args  = (@_);

    return $self->SUPER::current_user_can( $right, %args ) unless ($right && $self->id && $self->current_user);

    #Carp::confess if ($right eq 'read' and not $args{'column'});

    if ( $right eq 'read'
        and ( $self->id == $self->current_user->id or $self->current_user->admin ) )
    {
        return 1;
    } elsif ( $right eq 'read' and $args{'column'} eq 'name' ) {
        return (1);

    } elsif ( $right eq 'update'
        and $self->id == $self->current_user->id
        and $args{'column'} ne 'email_confirmed' )
    {
        return (1);
    }

    return $self->SUPER::current_user_can( $right, %args );
}

1;

1	dpavlin	1	use strict;
2			use warnings;
3
4			package Transports::Model::User::Schema;
5			use Jifty::DBI::Schema;
6	dpavlin	32	use Transports::Model::UserOnSourceCollection;
7	dpavlin	1
8			# Your column definitions go here. See L<Jifty::DBI::Schema> for
9			# documentation about how to write column definitions.
10
11			column name =>
12			type is 'text',
13			label is 'Name',
14			is mandatory,
15			is distinct;
16
17			column email =>
18			type is 'text',
19			label is 'Email address',
20			is mandatory,
21			is distinct;
22
23	dpavlin	27	column password =>
24	dpavlin	1	type is 'text',
25			label is 'Password',
26	dpavlin	3	is mandatory,
27	dpavlin	1	render_as 'password';
28
29	dpavlin	27	column admin =>
30			type is 'boolean',
31			label is 'Administrator',
32			is mandatory,
33			default is 'false',
34			since '0.0.8';
35
36	dpavlin	32	column sources =>
37			refers_to Transports::Model::UserOnSourceCollection by 'user_on',
38			label is 'Source systems',
39			since '0.0.10';
40
41	dpavlin	1	package Transports::Model::User;
42			use base qw/Transports::Record/;
43
44			# Your model-specific methods go here.
45
46	dpavlin	15	=head2 password_is STRING
47
48			Returns true if and only if the current user's password matches STRING
49
50			=cut
51
52
53			sub password_is {
54			my $self = shift;
55			my $string = shift \|\| return;
56			warn "password_is ", $self->_value('password'), " == $string\n";
57			return 1 if ($self->_value('password') eq $string);
58			return 0;
59	dpavlin	5	}
60
61	dpavlin	15	=head2 password
62
63			Never display a password
64
65			=cut
66
67	dpavlin	17	sub password {
68			return '*****';
69			}
70	dpavlin	15
71	dpavlin	17	=head2 current_user_can
72
73			Allows the current user to see all their own attributes and
74			everyone else to see their username.
75
76			Allows the current user to update any of their own attributes
77			except whether or not their email has been confirmed.
78
79			Passes everything else off to the superclass.
80
81			=cut
82
83
84			sub current_user_can {
85			my $self = shift;
86			my $right = shift;
87	dpavlin	31	my %args = (@_);
88	dpavlin	27
89	dpavlin	31	return $self->SUPER::current_user_can( $right, %args ) unless ($right && $self->id && $self->current_user);
90	dpavlin	27
91	dpavlin	17	#Carp::confess if ($right eq 'read' and not $args{'column'});
92	dpavlin	31
93	dpavlin	17	if ( $right eq 'read'
94	dpavlin	31	and ( $self->id == $self->current_user->id or $self->current_user->admin ) )
95	dpavlin	17	{
96			return 1;
97			} elsif ( $right eq 'read' and $args{'column'} eq 'name' ) {
98			return (1);
99
100			} elsif ( $right eq 'update'
101			and $self->id == $self->current_user->id
102			and $args{'column'} ne 'email_confirmed' )
103			{
104			return (1);
105			}
106
107			return $self->SUPER::current_user_can( $right, %args );
108			}
109
110	dpavlin	1	1;
111