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

raeburn lon-capa-cvs-allow@mail.lon-capa.org
Sun, 09 Mar 2008 17:22:22 -0000


raeburn		Sun Mar  9 13:22:22 2008 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  Allow a user to selfenroll with a student role. 
  - Added additional argument to &modify_student_enrollment() - selfenroll flag.
  - Additional argumnet added to &assignrole() - selfenroll flag
  - If $selfenrollflag evaluates to true, and role being added is a student role for the current user, a response from the &allowed() check is reset to ''.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.946 loncom/lonnet/perl/lonnet.pm:1.947
--- loncom/lonnet/perl/lonnet.pm:1.946	Sun Mar  9 12:57:26 2008
+++ loncom/lonnet/perl/lonnet.pm	Sun Mar  9 13:22:21 2008
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.946 2008/03/09 16:57:26 raeburn Exp $
+# $Id: lonnet.pm,v 1.947 2008/03/09 17:22:21 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -2643,7 +2643,8 @@
 
 sub courseiddump {
     my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,
-        $coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_;
+        $coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok,
+        $selfenrollonly)=@_;
     my $as_hash = 1;
     my %returnhash;
     if (!$domfilter) { $domfilter=''; }
@@ -2660,7 +2661,8 @@
                          $sincefilter.':'.&escape($descfilter).':'.
                          &escape($instcodefilter).':'.&escape($ownerfilter).
                          ':'.&escape($coursefilter).':'.&escape($typefilter).
-                         ':'.&escape($regexp_ok).':'.$as_hash,$tryserver);
+                         ':'.&escape($regexp_ok).':'.$as_hash.':'.
+                         &escape($selfenrollonly),$tryserver);
                 my @pairs=split(/\&/,$rep);
                 foreach my $item (@pairs) {
                     my ($key,$value)=split(/\=/,$item,2);
@@ -5312,7 +5314,7 @@
 # ----------------------------------------------------------------- Assign Role
 
 sub assignrole {
-    my ($udom,$uname,$url,$role,$end,$start,$deleteflag)=@_;
+    my ($udom,$uname,$url,$role,$end,$start,$deleteflag,$selfenroll)=@_;
     my $mrole;
     if ($role =~ /^cr\//) {
         my $cwosec=$url;
@@ -5346,11 +5348,15 @@
             } else {
                 $refused = 1;
             }
-            if ($refused) { 
-                &logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url.
-                         ' '.$role.' '.$end.' '.$start.' by '.
-	  	         $env{'user.name'}.' at '.$env{'user.domain'});
-                return 'refused';
+            if ($refused) {
+                if (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
+                    $refused = '';
+                } else {
+                    &logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url.
+                             ' '.$role.' '.$end.' '.$start.' by '.
+	  	             $env{'user.name'}.' at '.$env{'user.domain'});
+                    return 'refused';
+                }
             }
         }
         $mrole=$role;
@@ -5544,7 +5550,7 @@
 }
 
 sub modify_student_enrollment {
-    my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,$locktype,$cid) = @_;
+    my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,$locktype,$cid,$selfenroll) = @_;
     my ($cdom,$cnum,$chome);
     if (!$cid) {
 	unless ($cid=$env{'request.course.id'}) {
@@ -5602,7 +5608,7 @@
     if ($usec) {
 	$uurl.='/'.$usec;
     }
-    return &assignrole($udom,$uname,$uurl,'st',$end,$start);
+    return &assignrole($udom,$uname,$uurl,'st',$end,$start,undef,$selfenroll);
 }
 
 sub format_name {