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

[raeburn]

raeburn		Sun Sep 26 01:50:34 2010 EDT

  Modified files:              
    /loncom	lond 
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - lond
     - skip server side checking of roles looks for item named skipcheck
       instead of clientcheckrole.
  - lonnet.pm
     - Additional arg in &dump() is hashref to allow flexibility for future
       changes in key => value passed to dump_with_regexp in lond.
     - skipcheck for dump of roles for other cases besides &rolesinit. 
  
  
Index: loncom/lond
diff -u loncom/lond:1.455 loncom/lond:1.456
--- loncom/lond:1.455	Mon Aug 30 13:24:20 2010
+++ loncom/lond	Sun Sep 26 01:50:28 2010
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.455 2010/08/30 13:24:20 www Exp $
+# $Id: lond,v 1.456 2010/09/26 01:50:28 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -58,7 +58,7 @@
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.455 $'; #' stupid emacs
+my $VERSION='$Revision: 1.456 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -3171,17 +3171,17 @@
     }
     my $hashref = &tie_user_hash($udom, $uname, $namespace,
 				 &GDBM_READER());
-    my $clientcheckrole;
+    my $skipcheck;
     if ($hashref) {
         my $qresult='';
 	my $count=0;
         if ($extra ne '') {
             $extra = &Apache::lonnet::thaw_unescape($extra);
-            $clientcheckrole = $extra->{'clientcheckrole'};
+            $skipcheck = $extra->{'skipcheck'};
         }
         my @ids = &Apache::lonnet::current_machine_ids();
         my (%homecourses,$major,$minor,$now);
-        if (($namespace eq 'roles') && (!$clientcheckrole)) {
+        if (($namespace eq 'roles') && (!$skipcheck)) {
             my $loncaparev = $clientversion;
             if ($loncaparev eq '') {
                 $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
@@ -3197,7 +3197,7 @@
                 if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) {
                     my $cdom = $1;
                     my $cnum = $2;
-                    unless ($clientcheckrole) {
+                    unless ($skipcheck) {
                         next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,$minor,
                                                         $now,\%homecourses,\@ids));
                     }
@@ -3219,7 +3219,7 @@
 	    }
 	}
 	if (&untie_user_hash($hashref)) {
-            if (($namespace eq 'roles') && (!$clientcheckrole)) {
+            if (($namespace eq 'roles') && (!$skipcheck)) {
                 if (keys(%homecourses) > 0) {
                     $qresult .= &check_homecourses(\%homecourses,$udom,$regexp,$count,
                                                    $range,$start,$end,$major,$minor);
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1085 loncom/lonnet/perl/lonnet.pm:1.1086
--- loncom/lonnet/perl/lonnet.pm:1.1085	Fri Sep 24 13:15:47 2010
+++ loncom/lonnet/perl/lonnet.pm	Sun Sep 26 01:50:33 2010
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1085 2010/09/24 13:15:47 raeburn Exp $
+# $Id: lonnet.pm,v 1.1086 2010/09/26 01:50:33 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1733,7 +1733,8 @@
     # If there is a role which has expired, return it.
     #
     $courseid = &courseid_to_courseurl($courseid);
-    my %roleshash = &dump('roles',$udom,$unam,$courseid);
+    my $extra = &freeze_escape({'skipcheck' => 1});
+    my %roleshash = &dump('roles',$udom,$unam,$courseid,undef,$extra);
     foreach my $key (keys(%roleshash)) {
         next if ($key !~/^\Q$courseid\E(?:\/)*(\w+)*\_st$/);
         my $section=$1;
@@ -3035,8 +3036,9 @@
     unless (defined($uname)) { $uname=$env{'user.name'}; }
     unless (defined($udom)) { $udom=$env{'user.domain'}; }
     my (%dumphash,%nothide);
-    if ($context eq 'userroles') { 
-        %dumphash = &dump('roles',$udom,$uname);
+    if ($context eq 'userroles') {
+        my $extra = &freeze_escape({'skipcheck' => 1});
+        %dumphash = &dump('roles',$udom,$uname,'.',undef,$extra);
     } else {
         %dumphash=
             &dump('nohist_userroles',$udom,$uname);
@@ -4015,7 +4017,7 @@
     my ($domain,$username,$authhost)=@_;
     my $now=time;
     my %userroles = ('user.login.time' => $now);
-    my $extra = &freeze_escape({'clientcheckrole' => 1});
+    my $extra = &freeze_escape({'skipcheck' => 1});
     my $rolesdump=reply("dump:$domain:$username:roles:.::$extra",$authhost);
     if (($rolesdump eq 'con_lost') || ($rolesdump eq '') || 
         ($rolesdump =~ /^error:/)) {
@@ -4366,7 +4368,7 @@
 # -------------------------------------------------------------- dump interface
 
 sub dump {
-    my ($namespace,$udomain,$uname,$regexp,$range)=@_;
+    my ($namespace,$udomain,$uname,$regexp,$range,$extra)=@_;
     if (!$udomain) { $udomain=$env{'user.domain'}; }
     if (!$uname) { $uname=$env{'user.name'}; }
     my $uhome=&homeserver($uname,$udomain);
@@ -4375,7 +4377,7 @@
     } else {
 	$regexp='.';
     }
-    my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);
+    my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range:$extra",$uhome);
     my @pairs=split(/\&/,$rep);
     my %returnhash=();
     foreach my $item (@pairs) {
@@ -6355,7 +6357,8 @@
     } else {  
         $grouplist = '';
         my $courseurl = &courseid_to_courseurl($courseid);
-        my %roleshash = &dump('roles',$udom,$uname,$courseurl);
+        my $extra = &freeze_escape({'skipcheck' => 1});
+        my %roleshash = &dump('roles',$udom,$uname,$courseurl,undef,$extra);
         my $access_end = $env{'course.'.$courseid.
                               '.default_enrollment_end_date'};
         my $now = time;