Transports/Model/User.pm

use strict;
use warnings;

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

# 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';

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