--- loncom/lonnet/perl/lonnet.pm 2008/02/24 22:59:17 1.943 +++ loncom/lonnet/perl/lonnet.pm 2008/03/10 23:26:28 1.948 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.943 2008/02/24 22:59:17 raeburn Exp $ +# $Id: lonnet.pm,v 1.948 2008/03/10 23:26:28 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1064,8 +1064,8 @@ sub inst_rulecheck { $response=&unescape(&reply('instidrulecheck:'.&escape($udom). ':'.&escape($id).':'.$rulestr, $homeserver)); - } elsif ($item eq 'selfenroll') { - $response=&unescape(&reply('instselfenrollcheck:'. + } elsif ($item eq 'selfcreate') { + $response=&unescape(&reply('instselfcreatecheck:'. &escape($udom).':'.&escape($uname). ':'.$rulestr,$homeserver)); } @@ -1692,15 +1692,17 @@ sub absolute_url { # fn Possibly encrypted resource name/id. # form Hash that describes how the rendering should be done # and other things. -# r Optional reference that will be given the response. -# This is mostly provided so that the caller can implement -# error detection, recovery and retry policies. +# Returns: +# Scalar context: The content of the reply. +# Array context: 2 element list of the content and the full response variable. # # Returns: # The content of the response. sub ssi { - my ($fn,%form, $r)=@_; + my ($fn,%form)=@_; + my $count = scalar(@_); + my $ua=new LWP::UserAgent; @@ -1717,12 +1719,13 @@ sub ssi { $request->header(Cookie => $ENV{'HTTP_COOKIE'}); my $response=$ua->request($request); + my $status = $response->code; - if ($r) { - $$r = $response; + if (wantarray) { + return ($response->content, $response); + } else { + return $response->content; } - - return $response->content; } sub externalssi { @@ -2446,7 +2449,7 @@ sub userrolelog { } sub get_course_adv_roles { - my $cid=shift; + my ($cid,$codes) = @_; $cid=$env{'request.course.id'} unless (defined($cid)); my %coursehash=&coursedescription($cid); my %nothide=(); @@ -2471,14 +2474,23 @@ sub get_course_adv_roles { if ((&privileged($username,$domain)) && (!$nothide{$username.':'.$domain})) { next; } if ($role eq 'cr') { next; } - my $key=&plaintext($role); - if ($section) { $key.=' (Sec/Grp '.$section.')'; } - if ($returnhash{$key}) { - $returnhash{$key}.=','.$username.':'.$domain; + if ($codes) { + if ($section) { $role .= ':'.$section; } + if ($returnhash{$role}) { + $returnhash{$role}.=','.$username.':'.$domain; + } else { + $returnhash{$role}=$username.':'.$domain; + } } else { - $returnhash{$key}=$username.':'.$domain; + my $key=&plaintext($role); + if ($section) { $key.=' (Section '.$section.')'; } + if ($returnhash{$key}) { + $returnhash{$key}.=','.$username.':'.$domain; + } else { + $returnhash{$key}=$username.':'.$domain; + } } - } + } return %returnhash; } @@ -2640,7 +2652,8 @@ sub courseidput { 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=''; } @@ -2657,7 +2670,8 @@ sub courseiddump { $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); @@ -5309,7 +5323,7 @@ sub plaintext { # ----------------------------------------------------------------- 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; @@ -5343,11 +5357,15 @@ sub assignrole { } 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; @@ -5541,7 +5559,7 @@ sub modifystudent { } 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'}) { @@ -5599,7 +5617,7 @@ sub modify_student_enrollment { 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 { @@ -5718,7 +5736,7 @@ ENDINITMAP sub is_course { my ($cdom,$cnum) = @_; my %courses = &courseiddump($cdom,'.',1,'.','.',$cnum,undef, - undef,'.',undef,1); + undef,'.'); if (exists($courses{$cdom.'_'.$cnum})) { return 1; }