[LON-CAPA-cvs] cvs: loncom / Lond.pm lond

droeschl droeschl at source.lon-capa.org
Thu Apr 26 15:51:41 EDT 2012


droeschl		Thu Apr 26 19:51:41 2012 EDT

  Modified files:              
    /loncom	lond Lond.pm 
  Log:
  changes related to BZ 6585
  lond:
  - $clientversion is now also set for clients < 2.9.
    Subroutines can rely on $clientversion instead of checking for empty string
    followed by a look up in %loncaparevs.
  - moved functional body of dump_with_regexp into Lond.pm
  - moved check_homecourses, releasereqd_check and useable_role into Lond.pm
  
  Lond.pm:
  - incorporated changes that have been made to lond 1.491 (removal of $extra 
    parameter)
  - clean up
  
  
-------------- next part --------------
Index: loncom/lond
diff -u loncom/lond:1.491 loncom/lond:1.492
--- loncom/lond:1.491	Wed Apr 25 21:22:28 2012
+++ loncom/lond	Thu Apr 26 19:51:40 2012
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.491 2012/04/25 21:22:28 raeburn Exp $
+# $Id: lond,v 1.492 2012/04/26 19:51:40 droeschl Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -61,7 +61,7 @@
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.491 $'; #' stupid emacs
+my $VERSION='$Revision: 1.492 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -1907,12 +1907,8 @@
                 if (ref($hostedsession) eq 'HASH') {
                     $hosted = $hostedsession->{'hosted'};
                 }
-                my $loncaparev = $clientversion;
-                if ($loncaparev eq '') {
-                    $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
-                }
                 $canhost = &Apache::lonnet::can_host_session($udom,$clientname,
-                                                             $loncaparev,
+                                                             $clientversion,
                                                              $remote,$hosted);
             }
         }
@@ -3258,130 +3254,13 @@
 sub dump_with_regexp {
     my ($cmd, $tail, $client) = @_;
 
-    #TODO encapsulate $clientname and $clientversion in a object.
-    my $res = LONCAPA::Lond::dump_with_regexp($cmd, $tail, $clientname, $clientversion);
+    my $res = LONCAPA::Lond::dump_with_regexp($tail, $clientname, $clientversion);
     
     if ($res =~ /^error:/) {
         Failure($client, \$res, "$cmd:$tail");
     } else {
         Reply($client, \$res, "$cmd:$tail");
     }
-    return 1;
-
-    my $userinput = "$cmd:$tail";
-
-    my ($udom,$uname,$namespace,$regexp,$range)=split(/:/,$tail);
-    if (defined($regexp)) {
-	$regexp=&unescape($regexp);
-    } else {
-	$regexp='.';
-    }
-    my ($start,$end);
-    if (defined($range)) {
-	if ($range =~/^(\d+)\-(\d+)$/) {
-	    ($start,$end) = ($1,$2);
-	} elsif ($range =~/^(\d+)$/) {
-	    ($start,$end) = (0,$1);
-	} else {
-	    undef($range);
-	}
-    }
-    my $hashref = &tie_user_hash($udom, $uname, $namespace,
-				 &GDBM_READER());
-    if ($hashref) {
-        my $qresult='';
-	my $count=0;
-#
-# When dump is for roles.db, determine if LON-CAPA version checking is needed.
-# Sessions on 2.10 and later do not require version checking, as that occurs
-# on the server hosting the user session, when constructing the roles/courses 
-# screen).
-#
-        my $skipcheck;
-        my @ids = &Apache::lonnet::current_machine_ids();
-        my (%homecourses,$major,$minor,$now);
-# 
-# If dump is for roles.db from a pre-2.10 server, determine the LON-CAPA   
-# version on the server which requested the data. For LON-CAPA 2.9, the  
-# client session will have sent its LON-CAPA version when initiating the
-# connection. For LON-CAPA 2.8 and older, the version is retrieved from
-# the global %loncaparevs in lonnet.pm.
-# 
-        if ($namespace eq 'roles') {
-            my $loncaparev = $clientversion;
-            if ($loncaparev eq '') {
-                $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
-            }
-            if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
-                $major = $1;
-                $minor = $2;
-            }
-            if (($major > 2) || (($major == 2) && ($minor > 9))) {
-                $skipcheck = 1;
-            }
-            $now = time;
-        }
-	while (my ($key,$value) = each(%$hashref)) {
-            if (($namespace eq 'roles') && (!$skipcheck)) {
-                if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) {
-                    my $cdom = $1;
-                    my $cnum = $2;
-                    my ($role,$roleend,$rolestart) = split(/\_/,$value);
-                    if (!$roleend || $roleend > $now) {
-#
-# For active course roles, check that requesting server is running a LON-CAPA
-# version which meets any version requirements for the course. Do not include
-# the role amongst the results returned if the requesting server's version is
-# too old.
-#
-# This determination is handled differently depending on whether the course's 
-# homeserver is the current server, or whether it is a different server.
-# In both cases, the course's version requirement needs to be retrieved.
-# 
-                        next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
-                                                        $minor,\%homecourses,\@ids));
-                    }
-                }
-            }
-	    if ($regexp eq '.') {
-		$count++;
-		if (defined($range) && $count >= $end)   { last; }
-		if (defined($range) && $count <  $start) { next; }
-		$qresult.=$key.'='.$value.'&';
-	    } else {
-		my $unescapeKey = &unescape($key);
-		if (eval('$unescapeKey=~/$regexp/')) {
-		    $count++;
-		    if (defined($range) && $count >= $end)   { last; }
-		    if (defined($range) && $count <  $start) { next; }
-		    $qresult.="$key=$value&";
-		}
-	    }
-	}
-	if (&untie_user_hash($hashref)) {
-#
-# If dump is for roles.db from a pre-2.10 server, check if the LON-CAPA
-# version requirements for courses for which the current server is the home
-# server permit course roles to be usable on the client server hosting the
-# user's session. If so, include those role results in the data returned to  
-# the client server.
-#
-            if (($namespace eq 'roles') && (!$skipcheck)) {
-                if (keys(%homecourses) > 0) {
-                    $qresult .= &check_homecourses(\%homecourses,$regexp,$count,
-                                                   $range,$start,$end,$major,$minor);
-                }
-            }
-	    chop($qresult);
-	    &Reply($client, \$qresult, $userinput);
-	} else {
-	    &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
-		     "while attempting dump\n", $userinput);
-	}
-    } else {
-	&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
-		"while attempting dump\n", $userinput);
-    }
 
     return 1;
 }
@@ -6617,6 +6496,10 @@
 		#  If the remote is attempting a local init... give that a try:
 		#
 		(my $i, my $inittype, $clientversion) = split(/:/, $remotereq);
+        # For LON-CAPA 2.9, the  client session will have sent its LON-CAPA
+        # version when initiating the connection. For LON-CAPA 2.8 and older,
+        # the version is retrieved from the global %loncaparevs in lonnet.pm.            
+        $clientversion ||= $Apache::lonnet::loncaparevs{$clientname};
 
 		# If the connection type is ssl, but I didn't get my
 		# certificate files yet, then I'll drop  back to 
@@ -7480,78 +7363,6 @@
     return;
 }
 
-#
-# releasereqd_check() will determine if a LON-CAPA version (defined in the
-# $major,$minor args passed) is not too old to allow use of a role in a 
-# course ($cnum,$cdom args passed), if at least one of the following applies: 
-# (a) the course is a Community, (b) the course's home server is *not* the
-# current server, or (c) cached course information is not stale. 
-#
-# For the case where none of these apply, the course is added to the 
-# $homecourse hash ref (keys = courseIDs, values = array of a hash of roles).
-# The $homecourse hash ref is for courses for which the current server is the 
-# home server.  LON-CAPA version requirements are checked elsewhere for the
-# items in $homecourse.
-#
-
-sub releasereqd_check {
-    my ($cnum,$cdom,$key,$value,$major,$minor,$homecourses,$ids) = @_;
-    my $home = &Apache::lonnet::homeserver($cnum,$cdom);
-    return if ($home eq 'no_host');
-    my ($reqdmajor,$reqdminor,$displayrole);
-    if ($cnum =~ /$LONCAPA::match_community/) {
-        if ($major eq '' && $minor eq '') {
-            return unless ((ref($ids) eq 'ARRAY') && 
-                           (grep(/^\Q$home\E$/,@{$ids})));
-        } else {
-            $reqdmajor = 2;
-            $reqdminor = 9;
-            return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
-        }
-    }
-    my $hashid = $cdom.':'.$cnum;
-    my ($courseinfo,$cached) =
-        &Apache::lonnet::is_cached_new('courseinfo',$hashid);
-    if (defined($cached)) {
-        if (ref($courseinfo) eq 'HASH') {
-            if (exists($courseinfo->{'releaserequired'})) {
-                my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
-                return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
-            }
-        }
-    } else {
-        if (ref($ids) eq 'ARRAY') {
-            if (grep(/^\Q$home\E$/,@{$ids})) {
-                if (ref($homecourses) eq 'HASH') {
-                    if (ref($homecourses->{$cdom}) eq 'HASH') {
-                        if (ref($homecourses->{$cdom}{$cnum}) eq 'HASH') {
-                            if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
-                                push(@{$homecourses->{$cdom}{$cnum}},{$key=>$value});
-                            } else {
-                                $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
-                            }
-                        } else {
-                            $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
-                        }
-                    } else {
-                        $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
-                    }
-                }
-                return;
-            }
-        }
-        my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);
-        if (ref($courseinfo) eq 'HASH') {
-            if (exists($courseinfo->{'releaserequired'})) {
-                my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
-                return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
-            }
-        } else {
-            return;
-        }
-    }
-    return 1;
-}
 
 # 
 # get_courseinfo_hash() is used to retrieve course information from the db
@@ -7589,125 +7400,6 @@
     return;
 }
 
-#
-# check_homecourses() will retrieve course information for those courses which
-# are keys of the $homecourses hash ref (first arg). The nohist_courseids.db 
-# GDBM file is tied and course information for each course retrieved. Last   
-# visit (lasttime key) is also retrieved for each, and cached values updated  
-# for any courses last visited less than 24 hours ago. Cached values are also
-# updated for any courses included in the $homecourses hash ref.
-#
-# The reason for the 24 hours constraint is that the cron entry in 
-# /etc/cron.d/loncapa for /home/httpd/perl/refresh_courseids_db.pl causes 
-# cached course information to be updated nightly for courses with activity
-# within the past 24 hours.
-#
-# Role information for the user (included in a ref to an array of hashes as the
-# value for each key in $homecourses) is appended to the result returned by the
-# routine, which will in turn be appended to the string returned to the client
-# hosting the user's session.
-# 
-
-sub check_homecourses {
-    my ($homecourses,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
-    my ($result,%addtocache);
-    my $yesterday = time - 24*3600; 
-    if (ref($homecourses) eq 'HASH') {
-        my (%okcourses,%courseinfo,%recent);
-        foreach my $domain (keys(%{$homecourses})) {
-            my $hashref = 
-                &tie_domain_hash($domain, "nohist_courseids", &GDBM_WRCREAT());
-            if (ref($hashref) eq 'HASH') {
-                while (my ($key,$value) = each(%$hashref)) {
-                    my $unesc_key = &unescape($key);
-                    if ($unesc_key =~ /^lasttime:(\w+)$/) {
-                        my $cid = $1;
-                        $cid =~ s/_/:/;
-                        if ($value > $yesterday ) {
-                            $recent{$cid} = 1;
-                        }
-                        next;
-                    }
-                    my $items = &Apache::lonnet::thaw_unescape($value);
-                    if (ref($items) eq 'HASH') {
-                        my ($cdom,$cnum) = split(/_/,$unesc_key);
-                        my $hashid = $cdom.':'.$cnum; 
-                        $courseinfo{$hashid} = $items;
-                        if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
-                            my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});
-                            if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {
-                               $okcourses{$hashid} = 1;
-                            }
-                        }
-                    }
-                }
-                unless (&untie_domain_hash($hashref)) {
-                    &logthis("Failed to untie tied hash for nohist_courseids.db for $domain");
-                }
-            } else {
-                &logthis("Failed to tie hash for nohist_courseids.db for $domain");
-            }
-        }
-        foreach my $hashid (keys(%recent)) {
-            my ($result,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid);
-            unless ($cached) {
-                &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
-            }
-        }
-        foreach my $cdom (keys(%{$homecourses})) {
-            if (ref($homecourses->{$cdom}) eq 'HASH') {
-                foreach my $cnum (keys(%{$homecourses->{$cdom}})) {
-                    my $hashid = $cdom.':'.$cnum;
-                    next if ($recent{$hashid});
-                    &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
-                }
-            }
-        }
-        foreach my $hashid (keys(%okcourses)) {
-            my ($cdom,$cnum) = split(/:/,$hashid);
-            if ((ref($homecourses->{$cdom}) eq 'HASH') &&  
-                (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY')) {
-                foreach my $role (@{$homecourses->{$cdom}{$cnum}}) {
-                    if (ref($role) eq 'HASH') {
-                        while (my ($key,$value) = each(%{$role})) {
-                            if ($regexp eq '.') {
-                                $count++;
-                                if (defined($range) && $count >= $end)   { last; }
-                                if (defined($range) && $count <  $start) { next; }
-                                $result.=$key.'='.$value.'&';
-                            } else {
-                                my $unescapeKey = &unescape($key);
-                                if (eval('$unescapeKey=~/$regexp/')) {
-                                    $count++;
-                                    if (defined($range) && $count >= $end)   { last; }
-                                    if (defined($range) && $count <  $start) { next; }
-                                    $result.="$key=$value&";
-                                }
-                            }
-                        }
-                    }
-                }
-            }
-        }
-    }
-    return $result;
-}
-
-#
-# useable_role() will compare the LON-CAPA version required by a course with 
-# the version available on the client server.  If the client server's version
-# is compatible, 1 will be returned.
-#
-
-sub useable_role {
-    my ($reqdmajor,$reqdminor,$major,$minor) = @_; 
-    if ($reqdmajor ne '' && $reqdminor ne '') {
-        return if (($major eq '' && $minor eq '') ||
-                   ($major < $reqdmajor) ||
-                   (($major == $reqdmajor) && ($minor < $reqdminor)));
-    }
-    return 1;
-}
 
 sub distro_and_arch {
     return $dist.':'.$arch;
Index: loncom/Lond.pm
diff -u loncom/Lond.pm:1.1 loncom/Lond.pm:1.2
--- loncom/Lond.pm:1.1	Wed Apr 11 21:32:28 2012
+++ loncom/Lond.pm	Thu Apr 26 19:51:40 2012
@@ -1,6 +1,6 @@
 # The LearningOnline Network
 #
-# $Id: Lond.pm,v 1.1 2012/04/11 21:32:28 droeschl Exp $
+# $Id: Lond.pm,v 1.2 2012/04/26 19:51:40 droeschl Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -39,73 +39,59 @@
 
 
 sub dump_with_regexp {
-    #TODO encapsulate $clientname and $clientversion in a object.
-    my ( $cmd, $tail, $clientname, $clientversion ) = @_;
+    my ( $tail, $clientname, $clientversion ) = @_;
+    my ( $udom, $uname, $namespace, $regexp, $range ) = 
+        split /:/, $tail;
 
-    my $userinput = "$cmd:$tail";
+    $regexp = defined $regexp ? unescape($regexp) : '.';
 
-    my ($udom,$uname,$namespace,$regexp,$range,$extra)=split(/:/,$tail);
-    if (defined($regexp)) {
-	$regexp=&unescape($regexp);
-    } else {
-	$regexp='.';
-    }
     my ($start,$end);
+
     if (defined($range)) {
-	if ($range =~/^(\d+)\-(\d+)$/) {
-	    ($start,$end) = ($1,$2);
-	} elsif ($range =~/^(\d+)$/) {
-	    ($start,$end) = (0,$1);
-	} else {
-	    undef($range);
-	}
-    }
-    Apache::lonnet::logthis("Lond.pm: udom:[$udom] uname:[$uname] namespace:[$namespace]");
-    my $hashref = &tie_user_hash($udom, $uname, $namespace,
-				 &GDBM_READER());
-    my $skipcheck;
-    if ($hashref) {
-        my $qresult='';
-	my $count=0;
+        if ($range =~ /^(\d+)\-(\d+)$/) {
+            ($start,$end) = ($1,$2);
+        } elsif ($range =~/^(\d+)$/) {
+            ($start,$end) = (0,$1);
+        } else {
+            undef($range);
+        }
+    }
+
+    my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER()) or 
+        return "error: ".($!+0)." tie(GDBM) Failed while attempting dump";
+
+    my $qresult = '';
+    my $count = 0;
 #
 # When dump is for roles.db, determine if LON-CAPA version checking is needed.
-# Sessions on 2.10 and later will include skipcheck => 1 in extra args ref,
-# to indicate no version checking is needed (in this case, checking occurs
+# Sessions on 2.10 and later do not require version checking, as that occurs
 # on the server hosting the user session, when constructing the roles/courses 
 # screen).
 # 
-        if ($extra ne '') {
-            $extra = &Apache::lonnet::thaw_unescape($extra);
-            $skipcheck = $extra->{'skipcheck'};
-        }
-        my @ids = &Apache::lonnet::current_machine_ids();
-        my (%homecourses,$major,$minor,$now);
+    my $skipcheck;
+    my @ids = &Apache::lonnet::current_machine_ids();
+    my (%homecourses, $major, $minor, $now);
 # 
 # If dump is for roles.db from a pre-2.10 server, determine the LON-CAPA   
-# version on the server which requested the data. For LON-CAPA 2.9, the  
-# client session will have sent its LON-CAPA version when initiating the
-# connection. For LON-CAPA 2.8 and older, the version is retrieved from
-# the global %loncaparevs in lonnet.pm.
+# version on the server which requested the data. 
 # 
-        if (($namespace eq 'roles') && (!$skipcheck)) {
-            my $loncaparev = $clientversion;
-            if ($loncaparev eq '') {
-                $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
-            }
-            if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
-                $major = $1;
-                $minor = $2;
-            }
-            $now = time;
+    if ($namespace eq 'roles') {
+        if ($clientversion =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
+            $major = $1;
+            $minor = $2;
+        }
+        if (($major > 2) || (($major == 2) && ($minor > 9))) {
+            $skipcheck = 1;
         }
-	while (my ($key,$value) = each(%$hashref)) {
-            if ($namespace eq 'roles') {
+        $now = time;
+    }
+    while (my ($key,$value) = each(%$hashref)) {
+            if ($namespace eq 'roles' && (!$skipcheck)) {
                 if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) {
                     my $cdom = $1;
                     my $cnum = $2;
-                    unless ($skipcheck) {
-                        my ($role,$roleend,$rolestart) = split(/\_/,$value);
-                        if (!$roleend || $roleend > $now) {
+                    my ($role,$roleend,$rolestart) = split(/\_/,$value);
+                    if (!$roleend || $roleend > $now) {
 #
 # For active course roles, check that requesting server is running a LON-CAPA
 # version which meets any version requirements for the course. Do not include
@@ -116,28 +102,29 @@
 # homeserver is the current server, or whether it is a different server.
 # In both cases, the course's version requirement needs to be retrieved.
 # 
-                            next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
-                                                            $minor,\%homecourses,\@ids));
-                        }
+                        next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
+                                                        $minor,\%homecourses,\@ids));
                     }
                 }
             }
-	    if ($regexp eq '.') {
-		$count++;
-		if (defined($range) && $count >= $end)   { last; }
-		if (defined($range) && $count <  $start) { next; }
-		$qresult.=$key.'='.$value.'&';
-	    } else {
-		my $unescapeKey = &unescape($key);
-		if (eval('$unescapeKey=~/$regexp/')) {
-		    $count++;
-		    if (defined($range) && $count >= $end)   { last; }
-		    if (defined($range) && $count <  $start) { next; }
-		    $qresult.="$key=$value&";
-		}
-	    }
-	}
-	if (&untie_user_hash($hashref)) {
+        if ($regexp eq '.') {
+            $count++;
+            if (defined($range) && $count >= $end)   { last; }
+            if (defined($range) && $count <  $start) { next; }
+            $qresult.=$key.'='.$value.'&';
+        } else {
+            my $unescapeKey = &unescape($key);
+            if (eval('$unescapeKey=~/$regexp/')) {
+                $count++;
+                if (defined($range) && $count >= $end)   { last; }
+                if (defined($range) && $count <  $start) { next; }
+                $qresult.="$key=$value&";
+            }
+        }
+    }
+
+    &untie_user_hash($hashref) or 
+        return "error: ".($!+0)." untie(GDBM) Failed while attempting dump";
 #
 # If dump is for roles.db from a pre-2.10 server, check if the LON-CAPA
 # version requirements for courses for which the current server is the home
@@ -145,32 +132,178 @@
 # user's session. If so, include those role results in the data returned to  
 # the client server.
 #
-            if (($namespace eq 'roles') && (!$skipcheck)) {
-                if (keys(%homecourses) > 0) {
-                    $qresult .= &check_homecourses(\%homecourses,$regexp,$count,
-                                                   $range,$start,$end,$major,$minor);
-                }
+    if (($namespace eq 'roles') && (!$skipcheck)) {
+        if (keys(%homecourses) > 0) {
+            $qresult .= &check_homecourses(\%homecourses,$regexp,$count,
+                                           $range,$start,$end,$major,$minor);
+        }
+    }
+    chop($qresult);
+    return $qresult;
+}
+
+
+sub releasereqd_check {
+    my ($cnum,$cdom,$key,$value,$major,$minor,$homecourses,$ids) = @_;
+    my $home = &Apache::lonnet::homeserver($cnum,$cdom);
+    return if ($home eq 'no_host');
+    my ($reqdmajor,$reqdminor,$displayrole);
+    if ($cnum =~ /$LONCAPA::match_community/) {
+        if ($major eq '' && $minor eq '') {
+            return unless ((ref($ids) eq 'ARRAY') && 
+                           (grep(/^\Q$home\E$/,@{$ids})));
+        } else {
+            $reqdmajor = 2;
+            $reqdminor = 9;
+            return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
+        }
+    }
+    my $hashid = $cdom.':'.$cnum;
+    my ($courseinfo,$cached) =
+        &Apache::lonnet::is_cached_new('courseinfo',$hashid);
+    if (defined($cached)) {
+        if (ref($courseinfo) eq 'HASH') {
+            if (exists($courseinfo->{'releaserequired'})) {
+                my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
+                return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
             }
-	    chop($qresult);
-        Apache::lonnet::logthis("Lond.pm: qresult:[$qresult]");
-        return $qresult;
-        #&Reply($client, \$qresult, $userinput);
-	} else {
-	    return "error: ".($!+0)." untie(GDBM) Failed while attempting dump";
-         #&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
-		 #     "while attempting dump\n", $userinput);
-	}
+        }
     } else {
-	    return "error: ".($!+0)." tie(GDBM) Failed while attempting dump";
-    #&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
-	#	"while attempting dump\n", $userinput);
+        if (ref($ids) eq 'ARRAY') {
+            if (grep(/^\Q$home\E$/,@{$ids})) {
+                if (ref($homecourses) eq 'HASH') {
+                    if (ref($homecourses->{$cdom}) eq 'HASH') {
+                        if (ref($homecourses->{$cdom}{$cnum}) eq 'HASH') {
+                            if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
+                                push(@{$homecourses->{$cdom}{$cnum}},{$key=>$value});
+                            } else {
+                                $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
+                            }
+                        } else {
+                            $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
+                        }
+                    } else {
+                        $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
+                    }
+                }
+                return;
+            }
+        }
+        my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);
+        if (ref($courseinfo) eq 'HASH') {
+            if (exists($courseinfo->{'releaserequired'})) {
+                my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
+                return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
+            }
+        } else {
+            return;
+        }
+    }
+    return 1;
+}
+
+
+sub check_homecourses {
+    my ($homecourses,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
+    my ($result,%addtocache);
+    my $yesterday = time - 24*3600; 
+    if (ref($homecourses) eq 'HASH') {
+        my (%okcourses,%courseinfo,%recent);
+        foreach my $domain (keys(%{$homecourses})) {
+            my $hashref = 
+                &tie_domain_hash($domain, "nohist_courseids", &GDBM_WRCREAT());
+            if (ref($hashref) eq 'HASH') {
+                while (my ($key,$value) = each(%$hashref)) {
+                    my $unesc_key = &unescape($key);
+                    if ($unesc_key =~ /^lasttime:(\w+)$/) {
+                        my $cid = $1;
+                        $cid =~ s/_/:/;
+                        if ($value > $yesterday ) {
+                            $recent{$cid} = 1;
+                        }
+                        next;
+                    }
+                    my $items = &Apache::lonnet::thaw_unescape($value);
+                    if (ref($items) eq 'HASH') {
+                        my ($cdom,$cnum) = split(/_/,$unesc_key);
+                        my $hashid = $cdom.':'.$cnum; 
+                        $courseinfo{$hashid} = $items;
+                        if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
+                            my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});
+                            if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {
+                               $okcourses{$hashid} = 1;
+                            }
+                        }
+                    }
+                }
+                unless (&untie_domain_hash($hashref)) {
+                    &logthis("Failed to untie tied hash for nohist_courseids.db for $domain");
+                }
+            } else {
+                &logthis("Failed to tie hash for nohist_courseids.db for $domain");
+            }
+        }
+        foreach my $hashid (keys(%recent)) {
+            my ($result,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid);
+            unless ($cached) {
+                &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
+            }
+        }
+        foreach my $cdom (keys(%{$homecourses})) {
+            if (ref($homecourses->{$cdom}) eq 'HASH') {
+                foreach my $cnum (keys(%{$homecourses->{$cdom}})) {
+                    my $hashid = $cdom.':'.$cnum;
+                    next if ($recent{$hashid});
+                    &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
+                }
+            }
+        }
+        foreach my $hashid (keys(%okcourses)) {
+            my ($cdom,$cnum) = split(/:/,$hashid);
+            if ((ref($homecourses->{$cdom}) eq 'HASH') &&  
+                (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY')) {
+                foreach my $role (@{$homecourses->{$cdom}{$cnum}}) {
+                    if (ref($role) eq 'HASH') {
+                        while (my ($key,$value) = each(%{$role})) {
+                            if ($regexp eq '.') {
+                                $count++;
+                                if (defined($range) && $count >= $end)   { last; }
+                                if (defined($range) && $count <  $start) { next; }
+                                $result.=$key.'='.$value.'&';
+                            } else {
+                                my $unescapeKey = &unescape($key);
+                                if (eval('$unescapeKey=~/$regexp/')) {
+                                    $count++;
+                                    if (defined($range) && $count >= $end)   { last; }
+                                    if (defined($range) && $count <  $start) { next; }
+                                    $result.="$key=$value&";
+                                }
+                            }
+                        }
+                    }
+                }
+            }
+        }
     }
+    return $result;
+}
+
 
-    #never get here
-    die("SHOULD NOT HAPPEN!");
+sub useable_role {
+    my ($reqdmajor,$reqdminor,$major,$minor) = @_; 
+    if ($reqdmajor ne '' && $reqdminor ne '') {
+        return if (($major eq '' && $minor eq '') ||
+                   ($major < $reqdmajor) ||
+                   (($major == $reqdmajor) && ($minor < $reqdminor)));
+    }
     return 1;
 }
 
+
+
+
+
+
 1;
 
 __END__
@@ -191,7 +324,7 @@
 
 =over 4
 
-=item dump_with_regexp( $cmd, $tail, $client )
+=item dump_with_regexp( $tail, $client )
 
 Dump a profile database with an optional regular expression to match against
 the keys.  In this dump, no effort is made to separate symb from version
@@ -199,8 +332,6 @@
 different structure.  Need to look at this and improve the documentation of
 both this and the currentdump handler.
 
-$cmd is the command keyword.
-
 $tail a colon separated list containing
 
 =over 
@@ -224,10 +355,6 @@
 
 optional range of entries e.g., 10-20 would return the 10th to 19th items, etc.  
 
-=item extra        
-
-optional ref to hash of additional args. currently skipcheck is only key used.   
-
 =back
 
 $client is the channel open on the client.
@@ -236,6 +363,51 @@
 
 Side effects: response is written to $client.  
 
+
+=item releasereqd_check( $cnum, $cdom, $key, $value, $major, $minor, 
+        $homecourses, $ids )
+
+releasereqd_check() will determine if a LON-CAPA version (defined in the
+$major,$minor args passed) is not too old to allow use of a role in a 
+course ($cnum,$cdom args passed), if at least one of the following applies: 
+(a) the course is a Community, (b) the course's home server is *not* the
+current server, or (c) cached course information is not stale. 
+
+For the case where none of these apply, the course is added to the 
+$homecourse hash ref (keys = courseIDs, values = array of a hash of roles).
+The $homecourse hash ref is for courses for which the current server is the 
+home server.  LON-CAPA version requirements are checked elsewhere for the
+items in $homecourse.
+
+
+=item check_homecourses( $homecourses, $regexp, $count, $range, $start, $end, 
+        $major, $minor )
+
+check_homecourses() will retrieve course information for those courses which
+are keys of the $homecourses hash ref (first arg). The nohist_courseids.db 
+GDBM file is tied and course information for each course retrieved. Last   
+visit (lasttime key) is also retrieved for each, and cached values updated  
+for any courses last visited less than 24 hours ago. Cached values are also
+updated for any courses included in the $homecourses hash ref.
+
+The reason for the 24 hours constraint is that the cron entry in 
+/etc/cron.d/loncapa for /home/httpd/perl/refresh_courseids_db.pl causes 
+cached course information to be updated nightly for courses with activity
+within the past 24 hours.
+
+Role information for the user (included in a ref to an array of hashes as the
+value for each key in $homecourses) is appended to the result returned by the
+routine, which will in turn be appended to the string returned to the client
+hosting the user's session.
+
+
+=item useable_role( $reqdmajor, $reqdminor, $major, $minor )
+
+useable_role() will compare the LON-CAPA version required by a course with 
+the version available on the client server.  If the client server's version
+is compatible, 1 will be returned.
+
+
 =back
 
 =head1 BUGS


More information about the LON-CAPA-cvs mailing list