File Coverage

blib/lib/Labyrinth/Groups.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Labyrinth::Groups;
2              
3 3     3   6115 use warnings;
  3         4  
  3         108  
4 3     3   13 use strict;
  3         3  
  3         90  
5              
6 3     3   11 use vars qw($VERSION @ISA %EXPORT_TAGS @EXPORT @EXPORT_OK);
  3         4  
  3         355  
7             $VERSION = '5.30';
8              
9             =head1 NAME
10              
11             Labyrinth::Groups - User Group Manager for Labyrinth
12              
13             =head1 DESCRIPTION
14              
15             This package provides group management for user access. Groups can be used to
16             set permissions for a set of users, without setting individual user
17             permissions.
18              
19             =cut
20              
21             # -------------------------------------
22             # Export Details
23              
24             require Exporter;
25             @ISA = qw(Exporter);
26              
27             %EXPORT_TAGS = (
28             'all' => [ qw( GetGroupID UserInGroup UserGroups GroupSelect GroupSelectMulti ) ]
29             );
30              
31             @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
32             @EXPORT = ( @{ $EXPORT_TAGS{'all'} } );
33              
34             # -------------------------------------
35             # Library Modules
36              
37 3     3   40 use Labyrinth::Audit;
  3         4  
  3         429  
38 3     3   424 use Labyrinth::Globals;
  0            
  0            
39             use Labyrinth::DBUtils;
40             use Labyrinth::MLUtils;
41             use Labyrinth::Session;
42             use Labyrinth::Support;
43             use Labyrinth::Variables;
44              
45             # -------------------------------------
46             # Variables
47              
48             my %InGroup;
49              
50             # -------------------------------------
51             # The Subs
52              
53             =head1 FUNCTIONS
54              
55             =over 4
56              
57             =item GetGroupID
58              
59             Returns the ID of the specific group.
60              
61             =item UserInGroup
62              
63             Checks whether the specified user (or current user) is in the specified group
64             Returns 1 if true, otherwise 0 for false.
65              
66             =item UserGroups()
67              
68             For the current user login, return the list of groups they are associated with.
69              
70             =item GroupSelect([$opt])
71              
72             Provides the XHTML code for a single select dropdown box. Pass the id of a
73             group to pre-select that group.
74              
75             =item GroupSelectMulti([$opt[,$rows]])
76              
77             Provides the XHTML code for a multiple select dropdown box. Pass the group id
78             or an arrayref to a list of group ids to pre-select those groups. By default
79             the number of rows displayed is 5, although this can be changed by passing the
80             number of rows you require.
81              
82             =cut
83              
84             sub GetGroupID {
85             my $name = shift || return;
86             my @rows = $dbi->GetQuery('array','GetGroupID',$name);
87             return unless(@rows);
88             return $rows[0]->[0];
89             }
90              
91             sub UserInGroup {
92             my $groupid = shift || return;
93             my $userid = shift || $tvars{loginid};
94             return 0 unless($groupid && $userid);
95              
96             $InGroup{$userid} ||= do { UserGroups($userid) };
97             return 1 if($InGroup{$userid} =~ /\b$groupid\b/);
98             return 0;
99             }
100              
101             sub UserGroups {
102             my $userid = shift || $tvars{loginid};
103             my (%groups,@grps);
104             my @rows = $dbi->GetQuery('hash','AllGroupIndex');
105             foreach (@rows) {
106             # a user link, but not our user
107             next if($_->{type} == 1 && $_->{linkid} ne $userid);
108            
109             if($_->{type} == 1) {
110             push @grps, $_->{groupid};
111             } else {
112             push @{$groups{$_->{linkid}}}, $_->{groupid};
113             }
114             }
115             my @list = ();
116             while(@grps) {
117             my $g = shift @grps;
118             push @list, $g;
119             next unless($groups{$g});
120             push @grps, @{$groups{$g}};
121             delete $groups{$g};
122             }
123             my %hash = map {$_ => 1} @list;
124             my $grps = join(",",keys %hash);
125             return $grps;
126             }
127              
128             sub GroupSelect {
129             my $opt = shift;
130             my @rows = $dbi->GetQuery('hash','AllGroups');
131             unshift @rows, {groupid => 0, groupname => 'Select A Group' };
132             return DropDownRows($opt,'groups','groupid','groupname',@rows);
133             }
134              
135             sub GroupSelectMulti {
136             my $opt = shift;
137             my $multi = shift || 5;
138             my @rows = $dbi->GetQuery('hash','AllGroups');
139             unshift @rows, {groupid => 0, groupname => 'Select A Group' };
140             return DropDownMultiRows($opt,'groups','groupid','groupname',$multi,@rows);
141             }
142              
143              
144             1;
145              
146             __END__