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 'User is administrator',
        is mandatory,
        default is 0,
        since '0.0.8';

column can_import =>
        type is 'boolean',
        label is 'User can import requests',
        is mandatory,
        default is 0,
        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 ( $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;
    }

    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	51	use Transports::Model::UserOnLandscapeCollection;
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	dpavlin	83	label is 'User is administrator',
32	dpavlin	27	is mandatory,
33	dpavlin	83	default is 0,
34	dpavlin	27	since '0.0.8';
35
36	dpavlin	46	column can_import =>
37			type is 'boolean',
38	dpavlin	83	label is 'User can import requests',
39	dpavlin	46	is mandatory,
40	dpavlin	83	default is 0,
41	dpavlin	46	since '0.0.12';
42
43	dpavlin	51	column landscapes =>
44			refers_to Transports::Model::UserOnLandscapeCollection by 'user_on',
45			label is 'Landscape',
46			since '0.0.13';
47	dpavlin	32
48	dpavlin	1	package Transports::Model::User;
49			use base qw/Transports::Record/;
50
51			# Your model-specific methods go here.
52
53	dpavlin	15	=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	dpavlin	5	}
67
68	dpavlin	15	=head2 password
69
70			Never display a password
71
72			=cut
73
74	dpavlin	17	sub password {
75			return '*****';
76			}
77	dpavlin	15
78	dpavlin	17	=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	dpavlin	31	my %args = (@_);
95	dpavlin	27
96	dpavlin	31	return $self->SUPER::current_user_can( $right, %args ) unless ($right && $self->id && $self->current_user);
97	dpavlin	27
98	dpavlin	17	#Carp::confess if ($right eq 'read' and not $args{'column'});
99	dpavlin	31
100	dpavlin	77	if ( $self->id == $self->current_user->id or $self->current_user->admin or $self->current_user->can_import ) {
101	dpavlin	17	return 1;
102	dpavlin	77	# } elsif ( $right eq 'read' and $args{'column'} eq 'name' ) {
103			# return 1;
104	dpavlin	17	}
105
106			return $self->SUPER::current_user_can( $right, %args );
107			}
108
109	dpavlin	1	1;
110