1package Gantry::Control::C::Users;
2use strict;
3
4use Gantry qw/-TemplateEngine=TT/;
5
6use Gantry::Utils::Validate;
7
8use Gantry::Control;
9use Gantry::Control::Model::auth_users;
10use Gantry::Control::Model::auth_group_members;
11
12use Gantry::Utils::CRUDHelp qw( form_profile );
13use Gantry::Plugins::CRUD;
14
15my $crud = Gantry::Plugins::CRUD->new(
16    add_action      => \&_add,
17    edit_action     => \&_edit,
18    delete_action   => \&_delete,
19    form            => \&_form,
20
21    template        => 'form.tt',
22    text_descr      => 'user',
23    use_clean_dates => 1,
24);
25
26our @ISA = ( 'Gantry' );
27
28my $AUTH_USERS = 'Gantry::Control::Model::auth_users';
29my $AUTH_GROUP_MEMBERS = 'Gantry::Control::Model::auth_group_members';
30
31############################################################
32# Functions                                                #
33############################################################
34
35#-------------------------------------------------
36# $self->do_main( $order )
37#-------------------------------------------------
38sub do_main {
39    my ( $self, $order ) = @_;
40
41    $order ||= 2;
42
43    my $order_map = {
44        1 => 'active',
45        2 => 'user_id',
46        3 => 'user_name',
47        4 => 'last_name, first_name',
48        5 => 'email'
49    };
50
51    # stash template name and page title
52    $self->stash->view->template( 'results.tt' );
53    $self->stash->view->title( 'Users' );
54
55    my $retval = {
56        headings       => [
57            '<a href="' . $self->location . '/main/1">Active</a>',
58            '<a href="' . $self->location . '/main/2">User ID</a>',
59            '<a href="' . $self->location . '/main/3">User Name</a>',
60            '<a href="' . $self->location . '/main/4">Name</a>',
61            '<a href="' . $self->location . '/main/5">E-mail</a>'
62        ],
63        header_options => [
64            {
65                text => 'Add',
66                link => $self->location() . "/add",
67            },
68        ],
69    };
70
71    my @rows = $AUTH_USERS->retrieve_all(
72        { 'order_by' => $order_map->{$order} }
73    );
74
75    foreach my $row ( @rows ) {
76        my $id = $row->id;
77        push(
78            @{$$retval{rows}},
79            {
80                data => [
81                    ( $row->active ? 'yes' : 'no' ),
82                    $row->user_id,
83                    $row->user_name,
84                    ( $row->last_name . ", " . $row->first_name ),
85                    $row->email
86                ],
87                options => [
88                    {
89                        text => 'Edit',
90                        link => ( $self->location . "/edit/$id" )
91                    },
92                    {
93                        text => 'Delete',
94                        link => ( $self->location . "/delete/$id" ),
95                    },
96                ]
97            }
98        );
99    }
100
101    # stash view data
102    $self->stash->view->data( $retval );
103
104} # end do_main
105
106
107
108#-------------------------------------------------
109# $self->do_add( $r )
110#-------------------------------------------------
111sub do_add {
112    my ( $self ) = ( shift );
113
114    $crud->add( $self );
115
116} # end do_add
117
118sub _add {
119    my( $self, $params, $data ) = @_;
120
121    my %param = %{ $params };
122
123    $param{'crypt'} = encrypt( $param{passwd} );
124
125    my $new_row = $AUTH_USERS->create( \%param );
126    $new_row->dbi_commit;
127
128} # end do_add
129
130#-------------------------------------------------
131# $self->do_edit( $id )
132#-------------------------------------------------
133sub do_edit {
134    my ( $self, $id ) = @_;
135
136    # Load row values
137    my $user = $AUTH_USERS->retrieve( $id );
138
139    $crud->edit( $self, { user => $user } );
140
141} # end do_edit
142
143#-------------------------------------------------
144# $self->_edit( $param, $data )
145#-------------------------------------------------
146sub _edit {
147    my( $self, $params, $data ) = @_;
148
149    my %param = %{ $params };
150
151    $param{'crypt'} = encrypt( $param{passwd} );
152
153    my $user = $data->{user};
154
155    # Make update
156    $user->set( %param );
157    $user->update;
158    $user->dbi_commit;
159
160} # end do_edit
161
162#-------------------------------------------------
163# $self->do_delete( $id, $yes )
164#-------------------------------------------------
165sub do_delete {
166    my ( $self, $id, $yes ) = @_;
167
168    # Load row values
169    my $user = $AUTH_USERS->retrieve( $id );
170    $crud->delete( $self, $yes, { user => $user } );
171
172} # end do_delete
173
174#-------------------------------------------------
175# $self->_delete( $data )
176#-------------------------------------------------
177sub _delete {
178    my( $self, $data ) = @_;
179
180    my $user = $data->{user};
181
182    my @mems = $AUTH_GROUP_MEMBERS->search( user_id => $user->user_id );
183    foreach ( @mems ) {
184        $_->delete;
185    }
186    $AUTH_GROUP_MEMBERS->dbi_commit;
187
188    $user->delete;
189    $AUTH_USERS->dbi_commit();
190
191
192} # end delete_page
193
194#-------------------------------------------------
195# _form( $row ? )
196#-------------------------------------------------
197sub _form {
198    my ( $self, $data ) = @_;
199
200    my $row = $data->{user};
201
202    my ( @available_ids, %existing_ids );
203    my @users = $AUTH_USERS->retrieve_all();
204    foreach ( @users ) {
205        ++$existing_ids{ $_->user_id };
206    }
207
208    for ( my $i = 1; $i < 300; ++$i ) {
209        push( @available_ids, { label => $i, value => $i } )
210            unless defined $existing_ids{ $i };
211    }
212
213    my @fields;
214
215    push( @fields,
216        {   name    => 'user_id',
217            is      => 'int4',
218            label   => 'User ID',
219            type    => 'select',
220            options => \@available_ids,
221        }
222    ) if $self->path_info =~ /add/i;
223
224    push( @fields,
225        {   name    => 'active',
226            label   => 'Active',
227            type    => 'select',
228            is      => 'boolean',
229            options => [
230                { label => 'Yes', value => 't' },
231                { label => 'No',  value => 'f' },
232            ],
233        },
234        {   name    => 'user_name',
235            label   => 'User&nbsp;Name',
236            type    => 'text',
237            is      => 'varchar',
238        },
239        {   name    => 'passwd',
240            label   => 'Password',
241            is      => 'varchar',
242            type    => 'password',
243        },
244        {   name    => 'first_name',
245            label   => 'First&nbsp;Name',
246            is      => 'varchar',
247            type    => 'text',
248        },
249        {   name    => 'last_name',
250            label   => 'Last&nbsp;Name',
251            is      => 'varchar',
252            type    => 'text',
253        },
254        {   optional => 1,
255            name    => 'email',
256            is      => 'varchar',
257            label   => 'E-mail',
258            type    => 'text',
259        }
260    );
261
262    my $form =  {
263        legend => $self->path_info =~ /edit/i ? 'Edit' : 'Add',
264        width => 400,
265        row => $row,
266        fields => \@fields
267    };
268
269    return( $form );
270
271} # end _form
272
273sub site_links {
274    my $self = shift;
275
276    return( [
277        { link => ($self->app_rootp . '/users'), label => 'Users' },
278        { link => ($self->app_rootp . '/groups'), label => 'Groups' },
279        { link => ($self->app_rootp . '/pages'), label => 'Pages' },
280    ] );
281}
282
283# EOF
2841;
285
286__END__
287
288=head1 NAME
289
290Gantry::Control::C::Users - User Management
291
292=head1 SYNOPSIS
293
294  use Gantry::Control::C::Users;
295
296=head1 DESCRIPTION
297
298This Handler manages users in the database to facilitate the use of that
299information for authentication, autorization, and use in applications.
300This replaces the use of htpasswd for user management and puts more
301information at the finger tips of the application.
302
303=head1 APACHE
304
305  <Location /admin/users >
306    SetHandler  perl-script
307
308    PerlSetVar  title   "User Management: "
309
310    PerlSetVar  dbconn  "dbi:Pg:dbname=..."
311    PerlSetVar  dbuser  "<database_username>"
312    PerlSetVar  dbpass  "<database_password>"
313    PerlSetVar  dbcommit  off
314
315    PerlHandler Gantry::Control::C::Users
316  </Location>
317
318=head1 DATABASE
319
320This is the auth_users table that is used by this module. It is also
321used by the Authentication modules to verify usernames and passwords.
322The passwords are ecrypted by the crypt(3) function in perl.
323
324  create table "auth_users" (
325    "id"            int4 default nextval('auth_users_seq') NOT NULL,
326    "user_id"       int4,
327    "active"        bool,
328    "user_name"     varchar,
329    "passwd"        varchar,
330    "crypt"         varchar,
331    "first_name"    varchar,
332    "last_name"     varchar,
333    "email"         varchar
334  );
335
336=head1 METHODS
337
338Most of the methods are mapped to urls.
339
340=over 4
341
342=item do_add
343
344=item do_delete
345
346=item do_edit
347
348=item do_main
349
350=item redirect_to_main
351
352Decides where to go after a button press.
353
354=back
355
356One method is provided for templates to call.
357
358=over 4
359
360=item site_links
361
362Provides the site nav links for use at the top and/or bottom of the page.
363
364=back
365
366=head1 SEE ALSO
367
368Gantry::Control(3), Gantry(3)
369
370=head1 LIMITATIONS
371
372The passwords for users are enrypted so they can not be seen at all. In
373some situations this could be a very big problem.
374
375=head1 AUTHOR
376
377Tim Keefer <tkeefer@gmail.com>
378
379=head1 COPYRIGHT
380
381Copyright (c) 2005-6, Tim Keefer.
382
383This library is free software; you can redistribute it and/or modify
384it under the same terms as Perl itself, either Perl version 5.8.6 or,
385at your option, any later version of Perl 5 you may have available.
386
387=cut
388