File Coverage

blib/lib/Labyrinth/Plugin/Users.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             package Labyrinth::Plugin::Users;
2              
3 2     2   6418 use warnings;
  2         3  
  2         63  
4 2     2   7 use strict;
  2         2  
  2         83  
5              
6             my $VERSION = '5.18';
7              
8             =head1 NAME
9              
10             Labyrinth::Plugin::Users - Plugin Users handler for Labyrinth
11              
12             =head1 DESCRIPTION
13              
14             Contains all the default user handling functionality for the Labyrinth
15             framework.
16              
17             =cut
18              
19             # -------------------------------------
20             # Library Modules
21              
22 2     2   6 use base qw(Labyrinth::Plugin::Base);
  2         2  
  2         604  
23              
24             use Labyrinth::Audit;
25             use Labyrinth::DBUtils;
26             use Labyrinth::Media;
27             use Labyrinth::MLUtils;
28             use Labyrinth::Session;
29             use Labyrinth::Writer;
30             use Labyrinth::Support;
31             use Labyrinth::Users;
32             use Labyrinth::Variables;
33              
34             use Clone qw/clone/;
35             use Digest::MD5 qw(md5_hex);
36             use URI::Escape qw(uri_escape);
37              
38             # -------------------------------------
39             # Constants
40              
41             use constant MaxUserWidth => 300;
42             use constant MaxUserHeight => 400;
43              
44             # -------------------------------------
45             # Variables
46              
47             # type: 0 = optional, 1 = mandatory
48             # html: 0 = none, 1 = text, 2 = textarea
49              
50             my %fields = (
51             email => { type => 1, html => 1 },
52             effect => { type => 0, html => 1 },
53             userid => { type => 0, html => 0 },
54             nickname => { type => 0, html => 1 },
55             realname => { type => 1, html => 1 },
56             aboutme => { type => 0, html => 2 },
57             search => { type => 0, html => 0 },
58             image => { type => 0, html => 0 },
59             accessid => { type => 0, html => 0 },
60             realmid => { type => 0, html => 0 },
61             );
62              
63             my (@mandatory,@allfields);
64             for(keys %fields) {
65             push @mandatory, $_ if($fields{$_}->{type});
66             push @allfields, $_;
67             }
68              
69             my $LEVEL = ADMIN;
70              
71             # -------------------------------------
72             # The Subs
73              
74             =head1 PUBLIC INTERFACE METHODS
75              
76             =over 4
77              
78             =item UserLists
79              
80             Provide the current user list, taking into account of any search strings and
81             filters.
82              
83             =item Gravatar
84              
85             Provide the gravatar for a specified user.
86              
87             =item Item
88              
89             Provide the content attributed to the specified user.
90              
91             =item Name
92              
93             Provide the name of the specified user.
94              
95             =item Password
96              
97             Check and store a change of password.
98              
99             =item Register
100              
101             Provide the template variable hash for a new user to register.
102              
103             =item Registered
104              
105             Set the email address for the newly registered user, to auto log them in.
106              
107             =back
108              
109             =cut
110              
111             sub UserLists {
112             my (%search,$search,$key);
113             my @fields = ();
114             $search{where} = '';
115             $search{order} = 'realname,nickname';
116             $search{search} = 1;
117             $search{access} = MASTER + 1;
118              
119             if(Authorised(ADMIN)) {
120             $search{order} = 'u.realname' if($cgiparams{ordered});
121             $search{search} = 0;
122             $search{access} = PUBLISHER if($tvars{loginid} > 1);
123             }
124              
125             if($cgiparams{'all'}) {
126             $key = 'SearchUsers';
127             @fields = ('%','%');
128              
129             } elsif($cgiparams{'letter'}) {
130             $search = ($cgiparams{'letter'} || '') . '%';
131             @fields = ($search,$search);
132             $key = 'SearchUserNames';
133              
134             } elsif($cgiparams{'searchname'}) {
135             $search = '%' . $cgiparams{'searchname'} . '%';
136             @fields = ($search,$search);
137             $key = 'SearchUserNames';
138              
139             } elsif($cgiparams{'searched'}) {
140             @fields = ($cgiparams{'searched'},$cgiparams{'searched'});
141             $key = 'SearchUsers';
142              
143             } else {
144             $key = 'SearchUsers';
145             @fields = ('%','%');
146             }
147              
148             my @rows = $dbi->GetQuery('hash',$key,\%search,@fields);
149             LogDebug("UserList: key=[$key], rows found=[".scalar(@rows)."]");
150              
151             for(@rows) {
152             ($_->{width},$_->{height}) = GetImageSize($_->{link},$_->{dimensions},$_->{width},$_->{height},MaxUserWidth,MaxUserHeight);
153             $_->{gravatar} = GetGravatar($_->{userid},$_->{email});
154              
155             if($_->{url} && $_->{url} !~ /^https?:/) {
156             $_->{url} = 'http://' . $_->{url};
157             }
158             if($_->{aboutme}) {
159             $_->{aboutme} = '

' . $_->{aboutme} unless($_->{aboutme} =~ /^\s*

/si);

160             $_->{aboutme} .= '

' unless($_->{aboutme} =~ m!

\s*$!si);
161             }
162             my @grps = $dbi->GetQuery('hash','LinkedUsers',$_->{userid});
163             if(@grps) {
164             $_->{member} = $grps[0]->{member};
165             }
166             if(Authorised(ADMIN)) {
167             $_->{name} = $_->{realname};
168             $_->{name} .= " ($_->{nickname})" if($_->{nickname});
169             } else {
170             $_->{name} = $_->{nickname} || $_->{realname};
171             }
172             }
173              
174             $tvars{users} = \@rows if(@rows);
175             $tvars{searched} = $fields[0] if(@fields);
176             }
177              
178             sub Gravatar {
179             my $nophoto = uri_escape($settings{nophoto});
180             $tvars{data}{gravatar} = $nophoto;
181              
182             return unless $cgiparams{'userid'};
183             my @rows = $dbi->GetQuery('hash','GetUserByID',$cgiparams{'userid'});
184             return unless @rows;
185              
186             $tvars{data}{gravatar} =
187             'http://www.gravatar.com/avatar.php?'
188             .'gravatar_id='.md5_hex($rows[0]->{email})
189             .'&default='.$nophoto
190             .'&size=80';
191             }
192              
193             sub Item {
194             return unless $cgiparams{'userid'};
195              
196             my @rows = $dbi->GetQuery('hash','GetUserByID',$cgiparams{'userid'});
197             return unless(@rows);
198              
199             $rows[0]->{tag} = '' if($rows[0]->{link} =~ /blank.png/);
200             $rows[0]->{link} = '' if($rows[0]->{link} =~ /blank.png/);
201              
202             ($rows[0]->{width},$rows[0]->{height}) = GetImageSize($rows[0]->{link},$rows[0]->{dimensions},$rows[0]->{width},$rows[0]->{height},MaxUserWidth,MaxUserHeight);
203             $rows[0]->{gravatar} = GetGravatar($rows[0]->{userid},$rows[0]->{email});
204              
205             $tvars{data} = $rows[0];
206             }
207              
208             sub Name {
209             return unless($cgiparams{'userid'});
210             return UserName($cgiparams{'userid'})
211             }
212              
213             sub Password {
214             return unless $tvars{'loggedin'};
215              
216             $cgiparams{'userid'} = $tvars{'loginid'} unless(Authorised(ADMIN) && $cgiparams{'userid'});
217             $tvars{data}->{name} = UserName($cgiparams{userid});
218              
219             my @manfields = qw(userid effect2 effect3);
220             push @manfields, 'effect1' if($cgiparams{'userid'} == $tvars{'loginid'} || $tvars{user}{access} < ADMIN);
221              
222             if(FieldCheck(\@manfields,\@manfields)) {
223             $tvars{errmess} = 'All fields must be complete, please try again.';
224             $tvars{errcode} = 'ERROR';
225             return;
226             }
227              
228             my $who = $cgiparams{'userid'};
229             $who = $tvars{'loginid'} if(Authorised(ADMIN));
230              
231             if($cgiparams{'userid'} == $tvars{'loginid'} || $tvars{user}{access} < ADMIN) {
232             my @rows = $dbi->GetQuery('hash','ValidUser',$who,$cgiparams{'effect1'});
233             unless(@rows) {
234             $tvars{errmess} = 'Current password is invalid, please try again.';
235             $tvars{errcode} = 'ERROR';
236             return;
237             }
238             }
239              
240             if($cgiparams{effect2} ne $cgiparams{effect3}) {
241             $tvars{errmess} = 'New & verify passwords don\'t match, please try again.';
242             $tvars{errcode} = 'ERROR';
243             return;
244             }
245              
246             my %passerrors = (
247             1 => "Password too short, length should be $settings{minpasslen}-$settings{maxpasslen} characters.",
248             2 => "Password too long, length should be $settings{minpasslen}-$settings{maxpasslen} characters.",
249             3 => 'Password not cyptic enough, please enter as per password rules.',
250             4 => 'Password contains spaces or tabs.',
251             5 => 'Password should contain 3 or more unique characters.',
252             );
253              
254             my $invalid = PasswordCheck($cgiparams{effect2});
255             if($invalid) {
256             $tvars{errmess} = $passerrors{$invalid};
257             $tvars{errcode} = 'ERROR';
258             return;
259             }
260              
261             $dbi->DoQuery('ChangePassword',$cgiparams{effect2},$cgiparams{'userid'});
262             $tvars{thanks} = 2;
263              
264             if($cgiparams{mailuser}) {
265             my @rows = $dbi->GetQuery('hash','GetUserByID',$cgiparams{'userid'});
266             MailSend( template => 'mailer/reset.eml',
267             name => $rows[0]->{realname},
268             password => $cgiparams{effect2},
269             recipient_email => $rows[0]->{email}
270             );
271             }
272              
273             SetCommand('user-adminedit') if(Authorised(ADMIN) && $cgiparams{'userid'} != $tvars{'loginid'});
274             }
275              
276             sub Register {
277             my %data = (
278             'link' => 'images/blank.png',
279             'tag' => '[No Image]',
280             'admin' => Authorised(ADMIN),
281             );
282              
283             $tvars{data}{$_} = $data{$_} for(keys %data);
284             $tvars{userid} = 0;
285             $tvars{newuser} = 1;
286             $tvars{htmltags} = LegalTags();
287             }
288              
289             sub Registered {
290             $cgiparams{cause} = $cgiparams{email};
291             }
292              
293             =head1 ADMIN INTERFACE METHODS
294              
295             =over 4
296              
297             =item Login
298              
299             Action the login functionality to the site.
300              
301             =item Logout
302              
303             Action the logout functionality to the site.
304              
305             =item Store
306              
307             =item Retrieve
308              
309             =item LoggedIn
310              
311             Check with the current user is logged in.
312              
313             =item ImageCheck
314              
315             Check whether images uploaded for the user profile are still being used. Used
316             to allow the images plugin to delete unused images.
317              
318             =item Admin
319              
320             List current users.
321              
322             =item Add
323              
324             Provide the template variable hash to create a new user.
325              
326             =item Edit
327              
328             Edit the given user.
329              
330             =item Save
331              
332             Save the given user. For use by the currently logged in user.
333              
334             =item AdminSave
335              
336             Save the given user. For use by admin user to update any non-system user.
337              
338             =item Delete
339              
340             Delete the specified user account
341              
342             =item Ban
343              
344             Ban the specified user account. Account can be reactivated or deleted.
345              
346             Banned users should receive a message at login, explain who they need to
347             contact to be reinstated.
348              
349             =item Disable
350              
351             Disable the specified user account. This different from a banned user, in that
352             disabled accounts cannot be reactivated or deleted. This is to prevent reuse of
353             an old account.
354              
355             =item AdminPass
356              
357             Allow the admin user to create a new password of a given user.
358              
359             Note passwords are store in an encrypted format, so cannot be viewed.
360              
361             =item AdminChng
362              
363             Allow the admin user to change the password of a given user.
364              
365             =cut
366              
367             sub Login { Labyrinth::Session::Login() }
368             sub Logout { Labyrinth::Session::Logout() }
369             sub Store { Labyrinth::Session::Store() }
370             sub Retrieve { Labyrinth::Session::Retrieve() }
371              
372             sub LoggedIn {
373             $tvars{errcode} = 'ERROR' if(!$tvars{loggedin});
374             }
375              
376             sub ImageCheck {
377             my @rows = $dbi->GetQuery('array','UsersImageCheck',$_[0]);
378             @rows ? 1 : 0;
379             }
380              
381             sub Admin {
382             return unless AccessUser($LEVEL);
383              
384             # note: cannot alter the guest & master users
385             if(my $ids = join(",",grep {$_ > 2} CGIArray('LISTED'))) {
386             $dbi->DoQuery('SetUserSearch',{ids=>$ids},1) if($cgiparams{doaction} eq 'Show');
387             $dbi->DoQuery('SetUserSearch',{ids=>$ids},0) if($cgiparams{doaction} eq 'Hide');
388             Ban($ids) if($cgiparams{doaction} eq 'Ban');
389             Disable($ids) if($cgiparams{doaction} eq 'Disable');
390             Delete($ids) if($cgiparams{doaction} eq 'Delete');
391             }
392              
393             UserLists();
394             }
395              
396             sub Add {
397             return unless AccessUser($LEVEL);
398              
399             my %data = (
400             'link' => 'images/blank.png',
401             'tag' => '[No Image]',
402             ddrealms => RealmSelect(0),
403             ddaccess => AccessSelect(0),
404             ddgroups => 'no groups assigned',
405             member => 'no group assigned',
406             );
407              
408             $tvars{users}{data} = \%data;
409             $tvars{userid} = 0;
410             }
411              
412             sub Edit {
413             $cgiparams{userid} ||= $tvars{'loginid'};
414             return unless MasterCheck();
415             return unless AuthorCheck('GetUserByID','userid',$LEVEL);
416              
417             $tvars{data}{tag} = '[No Image]' if(!$tvars{data}{link} || $tvars{data}{link} =~ /blank.png/);
418             $tvars{data}{name} = UserName($tvars{data}{userid});
419             $tvars{data}{admin} = Authorised(ADMIN);
420             $tvars{data}{ddrealms} = RealmSelect(RealmID($tvars{data}{realm}));
421             $tvars{data}{ddaccess} = AccessSelect($tvars{data}{accessid});
422              
423             my @grps = $dbi->GetQuery('hash','LinkedUsers',$cgiparams{'userid'});
424             if(@grps) {
425             $tvars{data}{ddgroups} = join(', ',map {$_->{groupname}} @grps);
426             $tvars{data}{member} = $grps[0]->{member};
427             } else {
428             $tvars{data}{ddgroups} = 'no groups assigned';
429             $tvars{data}{member} = 'no group assigned';
430             }
431              
432             $tvars{htmltags} = LegalTags();
433             $tvars{users}{data} = clone($tvars{data}); # data fields need to be editable
434             $tvars{users}{preview} = clone($tvars{data}); # data fields need to be editable
435              
436             for(keys %fields) {
437             if($fields{$_}->{html} == 1) { $tvars{users}{data}{$_} = CleanHTML($tvars{users}{data}{$_});
438             $tvars{users}{preview}{$_} = CleanHTML($tvars{users}{preview}{$_}); }
439             elsif($fields{$_}->{html} == 2) { $tvars{users}{data}{$_} = SafeHTML($tvars{users}{data}{$_}); }
440             }
441              
442             $tvars{users}{preview}{gravatar} = GetGravatar($tvars{users}{preview}{userid},$tvars{users}{preview}{email});
443              
444             $tvars{users}{preview}{link} = undef
445             if($tvars{users}{data}{link} && $tvars{users}{data}{link} =~ /blank.png/);
446             }
447              
448             sub Save {
449             my $newuser = $cgiparams{'userid'} ? 0 : 1;
450             unless($newuser) {
451             return unless MasterCheck();
452             if($cgiparams{userid} != $tvars{'loginid'} && !Authorised($LEVEL)) {
453             $tvars{errcode} = 'BADACCESS';
454             return;
455             }
456             }
457              
458             return unless AuthorCheck('GetUserByID','userid',$LEVEL);
459              
460             $tvars{newuser} = $newuser;
461             for(keys %fields) {
462             if($fields{$_}->{html} == 1) { $cgiparams{$_} = CleanHTML($cgiparams{$_}) }
463             elsif($fields{$_}->{html} == 2) { $cgiparams{$_} = CleanTags($cgiparams{$_}) }
464             elsif($fields{$_}->{html} == 3) { $cgiparams{$_} = CleanLink($cgiparams{$_}) }
465             }
466              
467             my @manfields = @mandatory;
468             push @manfields, 'effect' if($tvars{command} eq 'regsave');
469              
470             return if FieldCheck(\@allfields,\@manfields);
471              
472             # determine realm
473             $tvars{data}{'realm'} = RealmName($tvars{data}{'realmid'});
474             $tvars{data}{'realm'} ||= 'public';
475              
476             ## before continuing we should ensure the IP address has not
477             ## submitted repeated registrations. Though we should be aware
478             ## of Proxy Servers too.
479             my $imageid = $cgiparams{imageid} || 1;
480             ($imageid) = SaveImageFile(
481             param => 'image',
482             stock => 'Users'
483             ) if($cgiparams{image});
484              
485             my @fields = ( $tvars{data}{'nickname'}, $tvars{data}{'realname'},
486             $tvars{data}{'email'}, $imageid,
487             $tvars{data}{'realm'}
488             );
489              
490             if($newuser) {
491             $tvars{data}{'accessid'} = $tvars{data}{'accessid'} || 1;
492             $tvars{data}{'search'} = $tvars{data}{'search'} ? 1 : 0;
493             $tvars{data}{'realm'} = 'public';
494             $cgiparams{'userid'} = $dbi->IDQuery('NewUser', $tvars{data}{'effect'},
495             $tvars{data}{'accessid'},
496             $tvars{data}{'search'},
497             @fields);
498             } else {
499             $dbi->DoQuery('SaveUser',@fields,$cgiparams{'userid'});
500             }
501              
502             $tvars{data}{userid} = $cgiparams{'userid'};
503             $tvars{newuser} = 0;
504             $tvars{thanks} = 1;
505             }
506              
507             sub AdminSave {
508             return unless AccessUser($LEVEL);
509             return unless MasterCheck();
510              
511             my $newuser = $cgiparams{'userid'} ? 0 : 1;
512             return unless AuthorCheck('GetUserByID','userid',$LEVEL);
513              
514             $tvars{newuser} = $newuser;
515              
516             for(keys %fields) {
517             if($fields{$_}->{html} == 1) { $cgiparams{$_} = CleanHTML($cgiparams{$_}) }
518             elsif($fields{$_}->{html} == 2) { $cgiparams{$_} = CleanTags($cgiparams{$_}) }
519             elsif($fields{$_}->{html} == 3) { $cgiparams{$_} = CleanLink($cgiparams{$_}) }
520             }
521              
522             my $realm = $tvars{data}->{realm} || 'public';
523             return if FieldCheck(\@allfields,\@mandatory);
524              
525             ## before continuing we should ensure the IP address has not
526             ## submitted repeated registrations. Though we should be aware
527             ## of Proxy Servers too.
528             my $imageid = $cgiparams{imageid} || 1;
529             ($imageid) = SaveImageFile(
530             param => 'image',
531             stock => 'Users'
532             ) if($cgiparams{image});
533              
534             # in case of a new user
535             $tvars{data}->{'accessid'} = $tvars{data}->{'accessid'} || 1;
536             $tvars{data}->{'search'} = $tvars{data}->{'search'} ? 1 : 0;
537             $tvars{data}->{'realm'} = Authorised(ADMIN) && $tvars{data}->{'realmid'} ? RealmName($tvars{data}->{realmid}) : $realm;
538              
539             my @fields = ( $tvars{data}{'accessid'}, $tvars{data}{'search'},
540             $tvars{data}{'realm'},
541             $tvars{data}{'nickname'}, $tvars{data}{'realname'},
542             $tvars{data}{'email'}, $imageid
543             );
544              
545             if($newuser) {
546             $cgiparams{'userid'} = $dbi->IDQuery('NewUser',$tvars{data}->{'effect'},@fields);
547             } else {
548             $dbi->DoQuery('AdminSaveUser',@fields,$cgiparams{'userid'});
549             }
550              
551             $tvars{data}->{userid} = $cgiparams{'userid'};
552             $tvars{newuser} = 0;
553             $tvars{thanks} = 1;
554             }
555              
556             sub Delete {
557             my $ids = shift;
558             return unless AccessUser($LEVEL);
559             $dbi->DoQuery('DeleteUsers',{ids => $ids});
560             $tvars{thanks} = 'Users Deleted.';
561             }
562              
563             sub Disable {
564             my $ids = shift;
565             return unless AccessUser($LEVEL);
566             $dbi->DoQuery('BanUsers',{ids => $ids},'-deleted-');
567             $tvars{thanks} = 'Users Disabled.';
568             }
569              
570             sub Ban {
571             my $ids = shift;
572             return unless AccessUser($LEVEL);
573             $dbi->DoQuery('BanUsers',{ids => $ids},'-banned-');
574             $tvars{thanks} = 'Users Banned.';
575             }
576              
577             sub AdminPass {
578             return unless($cgiparams{'userid'});
579             return unless MasterCheck();
580             return unless AccessUser($LEVEL);
581             return unless AuthorCheck('GetUserByID','userid',$LEVEL);
582             $tvars{data}{name} = UserName($cgiparams{'userid'});
583             }
584              
585             sub AdminChng {
586             return unless($cgiparams{'userid'});
587             return unless MasterCheck();
588             return unless AccessUser($LEVEL);
589              
590             my @mandatory = qw(userid effect2 effect3);
591             if(FieldCheck(\@mandatory,\@mandatory)) {
592             $tvars{errmess} = 'All fields must be complete, please try again.';
593             $tvars{errcode} = 'ERROR';
594             return;
595             }
596              
597             $tvars{data}{name} = UserName($cgiparams{'userid'});
598              
599             if($cgiparams{effect2} ne $cgiparams{effect3}) {
600             $tvars{errmess} = 'New & verify passwords don\'t match, please try again.';
601             $tvars{errcode} = 'ERROR';
602             return;
603             }
604              
605             my %passerrors = (
606             1 => "Password too short, length should be $settings{minpasslen}-$settings{maxpasslen} characters.",
607             2 => "Password too long, length should be $settings{minpasslen}-$settings{maxpasslen} characters.",
608             3 => 'Password not cyptic enough, please enter as per password rules.',
609             4 => 'Password contains spaces or tabs.',
610             5 => 'Password should contain 3 or more unique characters.',
611             );
612              
613             my $invalid = PasswordCheck($cgiparams{effect2});
614             if($invalid) {
615             $tvars{errmess} = $passerrors{$invalid};
616             $tvars{errcode} = 'ERROR';
617             return;
618             }
619              
620             $dbi->DoQuery('ChangePassword',$cgiparams{effect2},$cgiparams{'userid'});
621             $tvars{thanks} = 'Password Changed.';
622              
623             if($cgiparams{mailuser}) {
624             my @rows = $dbi->GetQuery('hash','GetUserByID',$cgiparams{'userid'});
625             MailSend( template => 'mailer/reset.eml',
626             name => $rows[0]->{realname},
627             password => $cgiparams{effect2},
628             recipient_email => $rows[0]->{email}
629             );
630             }
631             }
632              
633             =item ACL
634              
635             List the current access control levels for the given user.
636              
637             =item ACLAdd1
638              
639             Apply the given profile to the current user's folders.
640              
641             =item ACLAdd2
642              
643             Add permissions for the current user to the given folder.
644              
645             =item ACLSave
646              
647             Save changes to the current access control levels for the given user.
648              
649             =item ACLDelete
650              
651             Delete the specified access control level for the given user.
652              
653             =cut
654              
655             sub ACL {
656             return unless AccessUser($LEVEL);
657             return unless $cgiparams{'userid'};
658              
659             my @rows = $dbi->GetQuery('hash','GetUserByID',$cgiparams{'userid'});
660             $tvars{data}->{$_} = $rows[0]->{$_} for(qw(userid realname accessname accessid));
661              
662             push @{$tvars{data}->{access}}, { folderid => 0, path => 'DEFAULT', accessname => $tvars{data}->{accessname}, ddaccess => AccessSelect($tvars{data}->{accessid},'ACCESS0') };
663              
664             @rows = $dbi->GetQuery('hash','UserACLs',$cgiparams{'userid'});
665             for my $row (@rows) {
666             $row->{ddaccess} = AccessSelect($row->{accessid},'ACCESS' . $row->{aclid});
667             push @{$tvars{data}->{access}}, $row;
668             }
669              
670             $tvars{ddprofile} = ProfileSelect();
671             $tvars{ddfolder} = FolderSelect();
672             $tvars{ddaccess} = AccessSelect();
673             }
674              
675             sub ACLAdd1 {
676             LoadProfiles();
677             if($settings{profiles}{profiles}{$cgiparams{profile}}) {
678             for(keys %{ $settings{profiles}{profiles}{$cgiparams{profile}} }) {
679             my $folderid = FolderID($_);
680             my $accessid = AccessID($settings{profiles}{profiles}{$cgiparams{profile}}{$_});
681              
682             my @rows = $dbi->GetQuery('hash','UserACLCheck1', $cgiparams{'userid'}, $folderid);
683             if(@rows) {
684             $dbi->DoQuery('UserACLUpdate1',$accessid,$cgiparams{'userid'},$folderid)
685             if($rows[0]->{accessid} < $accessid);
686             } else {
687             $dbi->DoQuery('UserACLInsert',$accessid,$cgiparams{'userid'},$folderid);
688             }
689             }
690             }
691             }
692              
693             sub ACLAdd2 {
694             my ($userid,$aclid,$accessid,$folderid) = @_;
695             if($aclid) {
696             my @rows = $dbi->GetQuery('hash','UserACLCheck2', $userid, $aclid);
697             if(@rows) {
698             $dbi->DoQuery('UserACLUpdate2',$accessid,$userid,$aclid)
699             if($rows[0]->{accessid} < $accessid);
700             } else {
701             $dbi->DoQuery('UserACLInsert',$accessid,$userid,$folderid);
702             }
703             } else {
704             $dbi->DoQuery('UserACLDefault',$accessid,$userid);
705             }
706             }
707              
708             sub ACLSave {
709             return unless AccessUser($LEVEL);
710              
711             if($cgiparams{submit} eq 'Apply') {
712             ACLAdd1();
713             } elsif($cgiparams{submit} eq 'Add') {
714             ACLAdd2($cgiparams{userid},0,$cgiparams{accessid},$cgiparams{folderid});
715             } else {
716             my @acls = grep {/ACCESS/} keys %cgiparams;
717             for my $acl ( @acls ) {
718             my ($aclid) = $acl =~ /ACCESS(\d+)/;
719             ACLAdd2($cgiparams{userid},$aclid,$cgiparams{'ACCESS'.$aclid});
720             }
721             }
722              
723             $tvars{thanks} = 'User permissions saved successfully.';
724             }
725              
726             sub ACLDelete {
727             return unless AccessUser($LEVEL);
728              
729             my @manfields = qw(userid accessid folderid);;
730             return if FieldCheck(\@manfields,\@manfields);
731              
732             $dbi->DoQuery('UserACLDelete',
733             $cgiparams{'userid'},
734             $cgiparams{'accessid'},
735             $cgiparams{'folderid'});
736              
737             $tvars{thanks} = 'User access removed successfully.';
738             }
739              
740             1;
741              
742             __END__