group() function Survey::ExpressionEngine that returns 1/0 depending …

…on whether the current user is in a group

docs/changelog/7.x.x.txt

@@ -1,4 +1,5 @@
 7.10.25
+ - added: group() function for Survey::ExpressionEngine to test group membership
  - added: give WebGUI::PseudoRequest a hostname method
  - fixed: don't clobber the request handler if WebGUI::Test was loaded inside of mod_perl
  - fixed #12365: editing a metadata may cause a fatal error (Arjan Widlak / United Knowledge)

lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm

@@ -36,6 +36,7 @@ my $validate;
 my $validTargets;
 my $otherInstances;
 my $tags;
+my $groups;
 
 =head2 value
 
@@ -352,6 +353,24 @@ sub avg {
     return sum(@vals) / @vals;
 }
 
+=head2 group ($name)
+
+Utility sub that returns a boolean indicating whether the user taking the survey is a member of a specified group, by name
+
+=head3 $name
+
+The name of the group
+
+=cut
+
+sub group {
+    my ($name) = @_;
+    my $value = grep( $_ eq $name, @$groups ) ? 1 : 0;
+    # warn "group($name) resolves to [$value]; groups = " . join( " ", map ">>$_<<", @$groups ) . " for userId " . $session->user->getId;
+    $session->log->debug("group($name) resolves to [$value]; groups = @$groups");
+    return $value;
+}
+
 =head2 round
 
 Utility sub shared with Safe compartment to allows expressions to easily round numbers
@@ -442,6 +461,15 @@ sub run {
     $validTargets = $opts->{validTargets};
     $tags = $opts->{tags} || {};
     $otherInstances = {};
+    $groups = $session->db->buildArrayRef( qq{
+        select groupName 
+        from groupings 
+        join groups using (groupId) 
+        where groupings.userId = ?
+        and expireDate > now()
+    }, [
+        $session->user->getId,
+    ] );
 
     if ( !$session->config->get('enableSurveyExpressionEngine') ) {
         $session->log->debug('enableSurveyExpressionEngine config option disabled, skipping');
@@ -469,6 +497,7 @@ sub run {
         $compartment->share('&restart');
         $compartment->share('&avg');
         $compartment->share('&round');
+        $compartment->share('&group');
 
         # Give them all of List::Util too
         $compartment->share_from( 'List::Util',

t/Asset/Wobject/Survey/ExpressionEngine.t

@@ -22,7 +22,7 @@ my $session = WebGUI::Test->session;
 
 #----------------------------------------------------------------------------
 # Tests
-my $tests = 60;
+my $tests = 62;
 plan tests => $tests + 1;
 
 #----------------------------------------------------------------------------
@@ -237,6 +237,13 @@ cmp_deeply( $e->run( $session, qq{jump {scoreX('$url', ext_s0) == 200} target},
 cmp_deeply( $e->run( $session, qq{jump {taggedX('$url', ext_tag) == 199} target}, {userId => $user->userId} ),
     { jump => 'target', tags => {} }, 'external tag lookups work too' );
 
+# group() utility function
+$session->user( { userId => 3 });
+cmp_deeply( $e->run( $session, qq{jump { group('Admins') } target},  ),
+    { jump => 'target', tags => { }, }, 'group() function recognizes us as Admins' );
+cmp_deeply( $e->run( $session, qq{jump { group('Space Aliens') } target}, ),
+    { jump => undef, tags => { }, }, 'group() function recognizes that we are not Space Aliens' );
+
 # Test for nasty bugs caused by file-scoped lexicals not being properly initialised in L<ExpressionEngine::run>
 {
     # Create a second test user