--- NodeBase.prod.pm    2005-08-26 10:30:50.181738800 +0200
+++ NodeBase.pm    2005-08-27 15:58:34.775488800 +0200
@@ -1919,7 +1919,7 @@ sub getRef
 sub isNodetype
 {
     my ($this, $NODE) = @_;
-    $this->getRef($NODE);
+    $this->getRef($NODE) if !ref $NODE;
 
     return 0 if (not ref $NODE);
 
@@ -1947,14 +1947,8 @@ sub isNodetype
 sub isGroup
 {
     my ($this, $NODETYPE) = @_;
-    my $groupTable;
-    $this->getRef($NODETYPE);
-
-    $groupTable = $$NODETYPE{grouptable};
-
-    return $groupTable if($groupTable);
-
-    return 0;
+    $this->getRef($NODETYPE) if !ref $NODETYPE;
+    return $NODETYPE->{grouptable} || 0
 }
 
 
@@ -1963,25 +1957,27 @@ sub canCreateNode {
     my( $this, $USER, $TYPE )= @_;
     $TYPE = $this->getType( $TYPE );
 
+    my $writers= $TYPE->{writers_user};
     # The default is that everyone can create
-    return 1   if  ! $TYPE->{writers_user};
-    $this->isApproved( $USER, $TYPE->{writers_user} );
+    return 1   if  ! $writers;
+    return $this->isApproved( $USER, $writers, $TYPE );
 }
 
 
 #####################################################################
+########
 sub canDeleteNode {
     my( $this, $USER, $NODE )= @_;
-    $this->getRef($NODE);
+    $this->getRef($NODE) if !ref $NODE;
 
+    my $deleters= $NODE->{type}{deleters_user};
     # The default is that nobody can delete
-    return 0   if  ! $NODE  ||  ! $NODE->{type}{deleters_user};
+    return 0   if  ! $NODE  ||  ! $deleters;
 
     # -2 means "owner" can delete (anonymous?)
-    return $this->isApproved( $USER, $NODE->{author_user} )
-        if  -2 == $NODE->{type}{deleters_user};
+    return $this->isApproved( $USER, $NODE->{author_user}, $NODE )
+        if -2 == $deleters;
 
-    return $this->isApproved( $USER, $NODE->{type}{deleters_user} );
+    return $this->isApproved( $USER, $deleters, $NODE );
 }
 
 
@@ -2001,7 +1997,7 @@ sub canUpdateNode {
         $updaters = $NODE->{author_user};
     }
 
-    return $this->isApproved( $USER, $updaters );
+    return $this->isApproved( $USER, $updaters, $NODE );
 }
 
 
@@ -2009,18 +2005,20 @@ sub canUpdateNode {
 sub canReadNode {
     my( $this, $USER, $NODE )= @_;
 
-    $this->getRef($NODE);
+    $this->getRef($NODE) if !ref($NODE);
 
     return 0   if  ! $NODE;
 
+    my $readers= $NODE->{type}{readers_user};
+
     # the default is that everyone can read
-    return 1   if  ! $NODE->{type}{readers_user};
+    return 1   if  !$readers;
 
     # -2 means only "owner" can read
-    return $this->isApproved( $USER, $NODE->{author_user} )
-        if  -2 == $NODE->{type}{readers_user};
+    return $this->isApproved( $USER, $NODE->{author_user}, $NODE )
+        if -2 == $readers;
 
-    return $this->isApproved( $USER, $$NODE{type}{readers_user} );
+    return $this->isApproved( $USER, $readers, $NODE );
 }
 
 
@@ -2032,38 +2030,128 @@ sub canReadNode {
 #       Checks to see if the given user is approved within a given gr
+oup
 #
 #   Parameters
-#       $user - reference to a user node hash  (-1 if super user)
-#       $NODE - reference to a nodegroup that the user might be in
+#       $USER  - reference to a user node hash  (-1 if super user)
+#       $GROUP - reference to a nodegroup that the user might be in
+#       $NODE  - optional reference to the item being tested against.
+#                its prescence allows rules to be applied against the
+#                the item.
+#       $NotGod - If the last parameter is the string 'notgod'
+#                 then isApproved will not consider gods to
+#                 to be automatically approved.
 #
 #   Returns
 #       true if the user is authorized, false otherwise
 #
+#   Uses %Everything::HTML::HTMLVARS as a per-session cache
+#   of the results as well as populating
+#      $Everything::HTML::HTMLVARS{isApproved}
+#   with a hash of the results. This hash should be treated
+#   as read only, and may contain the following keys:
+#       group => the last $GROUP checked
+#       user  => the last $USER checked
+#       node  => the last $NODE
+#       rule  => if a rule was responsible for a failure
+#                it will be provided here
+#       error => if an error occured during processing
+#                a rule the value will be here
+#       ret   => the actual return value (0/1)
+#
+#   Note this cache is per session, which means on average
+#   it will be for one $USER and most likely three or four
+#   groups. It wont be large.
+
 sub isApproved
 {
-    my( $this, $USER, $NODE )= @_;
+    my( $this, $USER, $GROUP, $NODE, $notgod )= @_;
+
+    ($notgod,$NODE)=($NODE,$notgod)
+        if $NODE eq 'notgod';
 
-    return 0   if  ! $USER  ||  ! $NODE;
+    my $vars=\%Everything::HTML::HTMLVARS;
+    #$vars->{isApproved_calls}++;
 
-    return 1   if  $this->isGod($USER);
+    my $cachekey = join "|",
+        map { ref $_ ? $_->{node_id} : $_ }
+        $USER,$GROUP,$NODE?$NODE:0,$notgod?1:0
+    ;
+
+    if (my $hash=$vars->{'isApproved.Lookup'}{$cachekey}) {
+        #$vars->{isApproved_calls_cachedret}++;
+        $vars->{isApproved}=$hash;
+        return $hash->{ret};
+    } else {
+        $vars =
+        $vars->{'isApproved.Lookup'}{$cachekey} =
+        $vars->{isApproved} = {};
+    }
+    $vars->{user}=$USER;
+    $vars->{group}=$GROUP;
+    $vars->{node}=$NODE;
+    $vars->{notgod}=$notgod;
+
+    return $vars->{isApproved}=0
+        if  ! $USER  ||  ! $GROUP;
+
+    if ( !ref $GROUP ) {
+        if ($GROUP=~/^\d+$/) {
+            $GROUP=$this->getNodeById( $GROUP );
+        } else {
+            my ($name,$type)=split /\s*\|\s*/,$GROUP;
+            return $vars->{isApproved}=0
+                if ! $name;
+            if ($type) {
+                $GROUP=$this->getNode($name,$type);
+            } else {
+                $GROUP=undef;
+            }
+            $GROUP||=$this->getNode($name,'usergroup');
+            $GROUP||=$this->getNode($name,'accessrule');
+        }
+    }
+
+    return $vars->{isApproved}=0
+        if  ! $GROUP;
+
+    # We always say that gods are approved,
+    # regardless of their true membership.
+    # Is this really the right thing to do?
+    # It maintains legacy behaviour, but its unclear
+    # if this really is the best idea. (demerphq)
+    return $vars->{ret}=1
+        if  !$notgod && $this->isGod($USER);
 
     my $user_id = $this->getId($USER);
-    #you're always approved if it's yourself...
-    return 1   if  $user_id == $this->getId($NODE);
 
-    foreach my $node (  @{ $this->selectNodegroupFlat($NODE) }  ) {
-        return 1   if  $user_id == $this->getId($node);
+    #You're always approved if it's yourself...
+    return $vars->{ret} = 1
+        if  $user_id == $this->getId($GROUP);
+
+    foreach my $node (  @{ $this->selectNodegroupFlat($GROUP) }  ) {
+
+        return $vars->{ret} = 1
+            if  $user_id == $this->getId($node);
+
         if(  $node->{type}{title} =~ /accessrule$/i  ) {
-            my $res= eval $node->{code};
+            my $RULE= $node;
+            my $res= do {
+                package Everything::HTML;
+                eval $node->{code};
+            };
+            if ($@ or (!$res and defined $res)) {
+                $vars->{isApproved}{rule} = $node;
+            }
             if( $@ ) {
                 Everything::printLog(
                     "Access Rule eval error in $node->{node_id}\n"
                   . "$@\n$node->{code}" );
-                return 0;
+                $vars->{error}=$@;
+                return $vars->{ret} = 0;
             }
-            return $res   if  defined $res;
+            return $vars->{ret}= $res
+                if  defined $res;
         }
     }
-    return 0;
+    return $vars->{ret} = 0;
 }
 
 
@@ -2082,6 +2170,9 @@ #       and '-1' as gods.  This also che
 #   Returns
 #       1 if the user is a god, 0 otherwise
 #
+#   Uses %Everything::HTML::HTMLVARS as a per-session cache
+#
+
 sub isGod
 {
     my ($this, $USER) = @_;
@@ -2095,17 +2186,30 @@ sub isGod
 
     $this->getRef($USER);
 
+    my $vars=\%Everything::HTML::HTMLVARS;
+    #$vars->{isGod_calls}++;
+    if (defined $vars->{'isGod.Lookup'}{$USER->{node_id}}) {
+        #$vars->{isGod_calls_cachedret}++;
+        return $vars->{'isGod.Lookup'}{$USER->{node_id}}
+    }
+
+
     $user_id = $this->getId($USER);
     $usergroup = $this->getType("usergroup");
     ($GODS) = $this->getNode("gods", $usergroup);
     $godsgroup = $$GODS{group}; #$this->selectNodegroupFlat($GODS);
 
+    my $is_god=0;
     foreach $god (@$godsgroup)
     {
-        return 1 if ($user_id == $this->getId($god));
+        if ($user_id == $this->getId($god)) {
+            $is_god=1;
+            last;
+        }
     }
 
-    return 0;
+    $vars->{'isGod.Lookup'}{$USER->{node_id}}=$is_god;
+    return $is_god;
 }
 
 
@@ -2127,7 +2231,7 @@ sub selectNodegroupFlat
 {
     my ($this, $NODE) = @_;
 
-    return $this->flattenNodegroup($NODE);
+    return $this->flattenNodegroup($NODE,{},[]);
 }
 
 
@@ -2141,48 +2245,51 @@ sub selectNodegroupFlat
 #       a single node is in its own "group".
 #
 #   Parameters
-#       $NODE - the node (preferably a group node) in which to get th
+e
-#           nodes that are within its group.
+#       $NODE  - the node (preferably a group node) in which to get t
+he
+#              nodes that are within its group.
+#       $seen  - hash of id's already seen during traverse. This can 
+be used
+#              to filter the result set and is used internally for pr
+eventing
+#              infinite recursion.
+#       $array - container for the result set. This can be used to "p
+restuff"
+#              the array, and is used internally to avoid repeatedly 
+passing the
+#              results up the stack.
 #
 #   Returns
 #       An array of node hashrefs of all of the nodes in this group.
 #
 sub flattenNodegroup
 {
-    my ($this, $NODE, $groupsTraversed) = @_;
-    my @listref;
-    my $group;
-
-    return undef if (not defined $NODE);
-
-    # If groupsTraversed is not defined, initialize it to an empty
-    # hash reference.
-    $groupsTraversed ||= {};  # anonymous empty hash
+    my ( $this, $GROUP, $seen, $array ) = @_;
 
-    $this->getRef($NODE);
+    return if !$GROUP;
 
-    if ($this->isGroup($$NODE{type}))
-    {
-        # return if we have already been through this group.  Otherwi
+se,
-        # we will get stuck in infinite recursion.
-        return undef if($$groupsTraversed{$$NODE{node_id}});
-        $$groupsTraversed{$$NODE{node_id}} = $$NODE{node_id};
+    $seen||= {};
+    $array||= [];
 
-        foreach my $groupref (@{ $$NODE{group} })
-        {
-            $group = $this->flattenNodegroup($groupref);
-            push(@listref, @$group) if(defined $group);
-        }
+    $this->getRef($GROUP);
 
-        return \@listref;
+    if ( $this->isGroup($GROUP->{type}) ) {
+        my @items= @{ $GROUP->{group} };
+        $this->getRef(@items);
+        foreach my $item (@items) {
+            if ( !$seen->{$item->{node_id}}++ ) {
+                if ( $this->isGroup($item->{type}) ) {
+                    $this->flattenNodegroup($item,$seen,$array);
+                }
+                else {
+                    push @$array,$item;
+                }
+            }
+        }
     }
-    else
-    {
-        return [$NODE];
+    elsif ( !$seen->{$GROUP->{node_id}}++ ) {
+        push @$array,$GROUP;
     }
+    return $array;
 }
 
 
+
 #####################################################################
+########
 #   Sub
 #       insertIntoNodegroup
[download]