Transports/Model/User.pm

use strict;
use warnings;

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

# 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 can_import =>
        type is 'boolean',
        label is 'Import request',
        is mandatory,
        default is 'false',
        since '0.0.12';

column landscapes =>
        refers_to Transports::Model::UserOnLandscapeCollection by 'user_on',
        label is 'Landscape',
        since '0.0.13';

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 or $self->current_user->can_import ) )
    {
        return 1;
    } elsif ( $right eq 'read' and $args{'column'} eq 'name' ) {
        return (1);

    } elsif (
                $right eq 'update' and
                ( $self->id == $self->current_user->id or $self->current_user->admin )
        ) {
        return (1);
    }

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

1;

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