version 1.172, 2004/08/10 18:28:55
|
version 1.182, 2005/02/05 06:21:57
|
Line 96 Inputs: $what - a parameter spec (inclu
|
Line 96 Inputs: $what - a parameter spec (inclu
|
|
|
Returns: A list, the first item is the index into the remaining list of items of parm valuse that is the active one, the list consists of parm values at the 11 possible levels |
Returns: A list, the first item is the index into the remaining list of items of parm valuse that is the active one, the list consists of parm values at the 11 possible levels |
|
|
11- resource default |
11 - General Course |
10- map default |
10 - Map or Folder level in course |
9 - General Course |
9- resource default |
8 - Map or Folder level in course |
8- map default |
7 - resource level in course |
7 - resource level in course |
6 - General for section |
6 - General for section |
5 - Map or Folder level for section |
5 - Map or Folder level for section |
Line 129 sub parmval {
|
Line 129 sub parmval {
|
my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm; |
my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm; |
my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm; |
my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm; |
|
|
# -------------------------------------------------------- first, check default |
|
|
|
if (defined($def)) { $outpar[11]=$def; $result=11; } |
|
|
|
# ----------------------------------------------------- second, check map parms |
# --------------------------------------------------------- first, check course |
|
|
my $thisparm=$parmhash{$symbparm}; |
|
if (defined($thisparm)) { $outpar[10]=$thisparm; $result=10; } |
|
|
|
# --------------------------------------------------------- third, check course |
|
|
|
if (defined($courseopt{$courselevel})) { |
if (defined($courseopt{$courselevel})) { |
$outpar[9]=$courseopt{$courselevel}; |
$outpar[11]=$courseopt{$courselevel}; |
$result=9; |
$result=11; |
} |
} |
|
|
if (defined($courseopt{$courselevelm})) { |
if (defined($courseopt{$courselevelm})) { |
$outpar[8]=$courseopt{$courselevelm}; |
$outpar[10]=$courseopt{$courselevelm}; |
$result=8; |
$result=10; |
} |
} |
|
|
|
# ------------------------------------------------------- second, check default |
|
|
|
if (defined($def)) { $outpar[9]=$def; $result=9; } |
|
|
|
# ------------------------------------------------------ third, check map parms |
|
|
|
my $thisparm=$parmhash{$symbparm}; |
|
if (defined($thisparm)) { $outpar[8]=$thisparm; $result=8; } |
|
|
if (defined($courseopt{$courselevelr})) { |
if (defined($courseopt{$courselevelr})) { |
$outpar[7]=$courseopt{$courselevelr}; |
$outpar[7]=$courseopt{$courselevelr}; |
$result=7; |
$result=7; |
} |
} |
|
|
|
# ------------------------------------------------------ fourth, back to course |
if (defined($csec)) { |
if (defined($csec)) { |
if (defined($courseopt{$seclevel})) { |
if (defined($courseopt{$seclevel})) { |
$outpar[6]=$courseopt{$seclevel}; |
$outpar[6]=$courseopt{$seclevel}; |
Line 171 sub parmval {
|
Line 174 sub parmval {
|
} |
} |
} |
} |
|
|
# ---------------------------------------------------------- fourth, check user |
# ---------------------------------------------------------- fifth, check user |
|
|
if (defined($uname)) { |
if (defined($uname)) { |
if (defined($useropt{$courselevel})) { |
if (defined($useropt{$courselevel})) { |
Line 419 sub print_row {
|
Line 422 sub print_row {
|
$$name{$which}.'.type', |
$$name{$which}.'.type', |
$rid,$$defaulttype{$which}); |
$rid,$$defaulttype{$which}); |
# cascade down manually |
# cascade down manually |
my $cascadetype=$defaulttype; |
my $cascadetype=$$defaulttype{$which}; |
for (my $i=$#typeoutpar;$i>0;$i--) { |
for (my $i=11;$i>0;$i--) { |
if ($typeoutpar[$i]) { |
if ($typeoutpar[$i]) { |
$cascadetype=$typeoutpar[$i]; |
$cascadetype=$typeoutpar[$i]; |
} else { |
} else { |
$typeoutpar[$i]=$cascadetype; |
$typeoutpar[$i]=$cascadetype; |
} |
} |
} |
} |
|
|
my $parm=$$display{$which}; |
my $parm=$$display{$which}; |
|
|
if ($parmlev eq 'full' || $parmlev eq 'brief') { |
if ($parmlev eq 'full' || $parmlev eq 'brief') { |
Line 450 sub print_row {
|
Line 452 sub print_row {
|
} elsif ($csec) { |
} elsif ($csec) { |
&print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); |
&print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); |
} else { |
} else { |
&print_td($r,9,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); |
&print_td($r,11,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); |
} |
} |
} elsif ($parmlev eq 'map') { |
} elsif ($parmlev eq 'map') { |
|
|
Line 459 sub print_row {
|
Line 461 sub print_row {
|
} elsif ($csec) { |
} elsif ($csec) { |
&print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); |
&print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); |
} else { |
} else { |
&print_td($r,8,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); |
&print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); |
} |
} |
} else { |
} else { |
|
|
&print_td($r,11,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); |
&print_td($r,11,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); |
|
|
if ($parmlev eq 'brief') { |
if ($parmlev eq 'brief') { |
|
|
Line 477 sub print_row {
|
Line 479 sub print_row {
|
} |
} |
} else { |
} else { |
|
|
&print_td($r,10,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); |
&print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); |
&print_td($r,9,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); |
&print_td($r,9,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); |
&print_td($r,8,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); |
&print_td($r,8,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); |
&print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); |
&print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); |
|
|
if ($csec) { |
if ($csec) { |
Line 520 sub print_td {
|
Line 522 sub print_td {
|
my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display)=@_; |
my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display)=@_; |
$r->print('<td bgcolor='.(($result==$which)?'"#AAFFAA"':$defbg). |
$r->print('<td bgcolor='.(($result==$which)?'"#AAFFAA"':$defbg). |
' align="center">'); |
' align="center">'); |
if ($which<10) { |
if ($which<8 || $which > 9) { |
$r->print(&plink($$typeoutpar[$which], |
$r->print(&plink($$typeoutpar[$which], |
$$display{$value},$$outpar[$which], |
$$display{$value},$$outpar[$which], |
$mprefix."$which",'parmform.pres','psub')); |
$mprefix."$which",'parmform.pres','psub')); |
Line 581 sub extractResourceInformation {
|
Line 583 sub extractResourceInformation {
|
|
|
foreach (keys %$bighash) { |
foreach (keys %$bighash) { |
if ($_=~/^src\_(\d+)\.(\d+)$/) { |
if ($_=~/^src\_(\d+)\.(\d+)$/) { |
|
# there are no resources in the 0 level |
|
if ($1 eq '0') { next; } |
my $mapid=$1; |
my $mapid=$1; |
my $resid=$2; |
my $resid=$2; |
my $id=$mapid.'.'.$resid; |
my $id=$mapid.'.'.$resid; |
my $srcf=$$bighash{$_}; |
my $srcf=$$bighash{$_}; |
# if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) { |
|
if (1) { |
if (1) { |
|
$srcf=~/\.(\w+)$/; |
$$ids[$#$ids+1]=$id; |
$$ids[$#$ids+1]=$id; |
$$typep{$id}=$1; |
$$typep{$id}=$1; |
$$keyp{$id}=''; |
$$keyp{$id}=''; |
Line 595 sub extractResourceInformation {
|
Line 599 sub extractResourceInformation {
|
my $key=$_; |
my $key=$_; |
my $allkey=$1; |
my $allkey=$1; |
$allkey=~s/\_/\./g; |
$allkey=~s/\_/\./g; |
|
if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq |
|
'parm') { |
|
next; #hide hidden things |
|
} |
my $display= &Apache::lonnet::metadata($srcf,$key.'.display'); |
my $display= &Apache::lonnet::metadata($srcf,$key.'.display'); |
my $name=&Apache::lonnet::metadata($srcf,$key.'.name'); |
my $name=&Apache::lonnet::metadata($srcf,$key.'.name'); |
my $part= &Apache::lonnet::metadata($srcf,$key.'.part'); |
my $part= &Apache::lonnet::metadata($srcf,$key.'.part'); |
Line 619 sub extractResourceInformation {
|
Line 627 sub extractResourceInformation {
|
&Apache::lonnet::declutter($$bighash{'map_id_'.$mapid}); |
&Apache::lonnet::declutter($$bighash{'map_id_'.$mapid}); |
$$mapp{$mapid}=$$mapp{$id}; |
$$mapp{$mapid}=$$mapp{$id}; |
$$allmaps{$mapid}=$$mapp{$id}; |
$$allmaps{$mapid}=$$mapp{$id}; |
$$maptitles{$mapid}= |
if ($mapid eq '1') { |
$$bighash{'title_'.$$bighash{'ids_'.&Apache::lonnet::clutter($$mapp{$id})}}; |
$$maptitles{$mapid}='Main Course Documents'; |
|
} else { |
|
$$maptitles{$mapid}=&Apache::lonnet::gettitle(&Apache::lonnet::clutter($$mapp{$id})); |
|
} |
$$maptitles{$$mapp{$id}}=$$maptitles{$mapid}; |
$$maptitles{$$mapp{$id}}=$$maptitles{$mapid}; |
$$symbp{$id}=$$mapp{$id}. |
$$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf); |
'___'.$resid.'___'. |
|
&Apache::lonnet::declutter($srcf); |
|
$$symbp{$mapid}=$$mapp{$id}.'___(all)'; |
$$symbp{$mapid}=$$mapp{$id}.'___(all)'; |
} |
} |
} |
} |
Line 821 sub assessparms {
|
Line 830 sub assessparms {
|
my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm; |
my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm; |
|
|
my $storeunder=''; |
my $storeunder=''; |
if (($snum==9) || ($snum==3)) { $storeunder=$courselevel; } |
if (($snum==11) || ($snum==3)) { $storeunder=$courselevel; } |
if (($snum==8) || ($snum==2)) { $storeunder=$courselevelm; } |
if (($snum==10) || ($snum==2)) { $storeunder=$courselevelm; } |
if (($snum==7) || ($snum==1)) { $storeunder=$courselevelr; } |
if (($snum==7) || ($snum==1)) { $storeunder=$courselevelr; } |
if ($snum==6) { $storeunder=$seclevel; } |
if ($snum==6) { $storeunder=$seclevel; } |
if ($snum==5) { $storeunder=$seclevelm; } |
if ($snum==5) { $storeunder=$seclevelm; } |
Line 992 sub assessparms {
|
Line 1001 sub assessparms {
|
|
|
$r->print('<tr><td colspan="3" align="center">'.&mt('Select Parameters to View').'</td></tr>'); |
$r->print('<tr><td colspan="3" align="center">'.&mt('Select Parameters to View').'</td></tr>'); |
|
|
$r->print('<tr><td colspan="2"><table>'); |
$r->print('<tr><td colspan="2"><table><tr>'); |
$r->print('<tr><td><input type="checkbox" name="pscat" value="all"'); |
|
$r->print(' checked') unless (@pscat); |
|
$r->print('>'.&mt('All Parameters').'</td>'); |
|
|
|
my $cnt=0; |
my $cnt=0; |
foreach $tempkey (sort { $allparms{$a} cmp $allparms{$b} } |
foreach $tempkey (sort { $allparms{$a} cmp $allparms{$b} } |
keys %allparms ) { |
keys %allparms ) { |
++$cnt; |
++$cnt; |
$r->print('</tr><tr>') unless ($cnt%2); |
$r->print('</tr><tr>') if ($cnt%2); |
$r->print('<td><input type="checkbox" name="pscat" '); |
$r->print('<td><input type="checkbox" name="pscat" '); |
$r->print('value="'.$tempkey.'"'); |
$r->print('value="'.$tempkey.'"'); |
if ($pscat[0] eq "all" || grep $_ eq $tempkey, @pscat) { |
if ($pscat[0] eq "all" || grep $_ eq $tempkey, @pscat) { |
$r->print(' checked'); |
$r->print(' checked'); |
} |
} |
$r->print('>'.$allparms{$tempkey}.'</td>'); |
$r->print('>'.$allparms{$tempkey}.'</td>'); |
|
} |
|
$r->print(' |
|
</tr><tr><td> |
|
<script type="text/javascript"> |
|
function checkall(value, checkName) { |
|
for (i=0; i<document.forms.parmform.elements.length; i++) { |
|
ele = document.forms.parmform.elements[i]; |
|
if (ele.name == checkName) { |
|
document.forms.parmform.elements[i].checked=value; |
|
} |
} |
} |
|
} |
|
</script> |
|
<input type="button" onclick="checkall(true, \'pscat\')" value="Select All" /> |
|
</td><td> |
|
<input type="button" onclick="checkall(false, \'pscat\')" value="Unselect All" /> |
|
</td> |
|
'); |
$r->print('</tr></table>'); |
$r->print('</tr></table>'); |
|
|
# $r->print('<tr><td>Select Parts</td><td>'); |
# $r->print('<tr><td>Select Parts</td><td>'); |
Line 1124 sub assessparms {
|
Line 1146 sub assessparms {
|
$r->print(<<ENDTABLETWO); |
$r->print(<<ENDTABLETWO); |
<th rowspan=3>$lt{'pie'}</th> |
<th rowspan=3>$lt{'pie'}</th> |
<th rowspan=3>$lt{'csv'}<br>($csuname $lt{'at'} $csudom)</th> |
<th rowspan=3>$lt{'csv'}<br>($csuname $lt{'at'} $csudom)</th> |
</tr><tr><td colspan=5></td><th colspan=2>$lt{'rl'}</th> |
</tr><tr><td colspan=5></td><th colspan=2>$lt{'ic'}</th><th colspan=2>$lt{'rl'}</th> |
<th colspan=3>$lt{'ic'}</th> |
<th colspan=1>$lt{'ic'}</th> |
|
|
ENDTABLETWO |
ENDTABLETWO |
if ($csec) { |
if ($csec) { |
$r->print("<th colspan=3>". |
$r->print("<th colspan=3>". |
Line 1134 ENDTABLETWO
|
Line 1157 ENDTABLETWO
|
$r->print(<<ENDTABLEHEADFOUR); |
$r->print(<<ENDTABLEHEADFOUR); |
</tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th> |
</tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th> |
<th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th> |
<th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th> |
<th>$lt{'def'}</th><th>$lt{'femof'}</th> |
<th>$lt{'gen'}</th><th>$lt{'femof'}</th> |
<th>$lt{'gen'}</th><th>$lt{'foremf'}</th><th>$lt{'fr'}</th> |
<th>$lt{'def'}</th><th>$lt{'foremf'}</th><th>$lt{'fr'}</th> |
ENDTABLEHEADFOUR |
ENDTABLEHEADFOUR |
|
|
if ($csec) { |
if ($csec) { |
Line 1196 ENDTABLEHEADFOUR
|
Line 1219 ENDTABLEHEADFOUR
|
my $totalparms=scalar keys %name; |
my $totalparms=scalar keys %name; |
if ($totalparms>0) { |
if ($totalparms>0) { |
my $firstrow=1; |
my $firstrow=1; |
my $title=$bighash{'title_'.$rid}; |
my $title=&Apache::lonnet::gettitle($uri); |
$title=~s/\:/:/g; |
|
$r->print('<tr><td bgcolor='.$defbgone. |
$r->print('<tr><td bgcolor='.$defbgone. |
' rowspan='.$totalparms. |
' rowspan='.$totalparms. |
'><tt><font size=-1>'. |
'><tt><font size=-1>'. |
Line 1504 sub crsenv {
|
Line 1526 sub crsenv {
|
if ($name =~ /^default_enrollment_(start|end)_date$/) { |
if ($name =~ /^default_enrollment_(start|end)_date$/) { |
$value=&Apache::lonhtmlcommon::get_date_from_form($name.'_value'); |
$value=&Apache::lonhtmlcommon::get_date_from_form($name.'_value'); |
} |
} |
|
# Get existing cloners |
|
my @oldcloner = (); |
|
if ($name eq 'cloners') { |
|
my %clonenames=&Apache::lonnet::dump('environment',$dom,$crs,'cloners'); |
|
if ($clonenames{'cloners'} =~ /,/) { |
|
@oldcloner = split/,/,$clonenames{'cloners'}; |
|
} else { |
|
$oldcloner[0] = $clonenames{'cloners'}; |
|
} |
|
} |
# |
# |
# Let the user know we made the changes |
# Let the user know we made the changes |
if ($name && defined($value)) { |
if ($name && defined($value)) { |
|
if ($name eq 'cloners') { |
|
$value =~ s/^,//; |
|
$value =~ s/,$//; |
|
} |
my $put_result = &Apache::lonnet::put('environment', |
my $put_result = &Apache::lonnet::put('environment', |
{$name=>$value},$dom,$crs); |
{$name=>$value},$dom,$crs); |
if ($put_result eq 'ok') { |
if ($put_result eq 'ok') { |
$setoutput.=&mt('Set').' <b>'.$name.'</b> '.&mt('to').' <b>'.$value.'</b>.<br />'; |
$setoutput.=&mt('Set').' <b>'.$name.'</b> '.&mt('to').' <b>'.$value.'</b>.<br />'; |
|
if ($name eq 'cloners') { |
|
&change_clone($value,\@oldcloner); |
|
} |
|
# Flush the course logs so course description is immediately updated |
|
if ($name eq 'description' && defined($value)) { |
|
&Apache::lonnet::flushcourselogs(); |
|
} |
} else { |
} else { |
$setoutput.=&mt('Unable to set').' <b>'.$name.'</b> '.&mt('to'). |
$setoutput.=&mt('Unable to set').' <b>'.$name.'</b> '.&mt('to'). |
' <b>'.$value.'</b> '.&mt('due to').' '.$put_result.'.<br />'; |
' <b>'.$value.'</b> '.&mt('due to').' '.$put_result.'.<br />'; |
Line 1539 sub crsenv {
|
Line 1582 sub crsenv {
|
'courseid' => '<b>'.&mt('Course ID or number'). |
'courseid' => '<b>'.&mt('Course ID or number'). |
'</b><br />'. |
'</b><br />'. |
'('.&mt('internal').', '.&mt('optional').')', |
'('.&mt('internal').', '.&mt('optional').')', |
|
'cloners' => '<b>'.&mt('Users allowed to clone course').'</b><br /><tt>(user:domain,user:domain)</tt><br />'.&mt('Users with active Course Coordinator role in the course automatically have the right to clone it, and can be omitted from list.'), |
'grading' => '<b>'.&mt('Grading').'</b><br />'. |
'grading' => '<b>'.&mt('Grading').'</b><br />'. |
'<tt>"standard", "external", or "spreadsheet"</tt> '.&Apache::loncommon::help_open_topic('GradingOptions'), |
'<tt>"standard", "external", or "spreadsheet"</tt> '.&Apache::loncommon::help_open_topic('GradingOptions'), |
'default_xml_style' => '<b>'.&mt('Default XML Style File').'</b> '. |
'default_xml_style' => '<b>'.&mt('Default XML Style File').'</b> '. |
Line 1634 sub crsenv {
|
Line 1678 sub crsenv {
|
'tthoptions' |
'tthoptions' |
=> '<b>'.&mt('Default set of options to pass to tth/m when converting tex').'</b>' |
=> '<b>'.&mt('Default set of options to pass to tth/m when converting tex').'</b>' |
); |
); |
my @Display_Order = ('url','description','courseid','grading', |
my @Display_Order = ('url','description','courseid','cloners','grading', |
'default_xml_style','pageseparators', |
'default_xml_style','pageseparators', |
'question.email','comment.email','policy.email', |
'question.email','comment.email','policy.email', |
'student_classlist_view', |
'student_classlist_view', |
Line 1834 ENDOVER
|
Line 1878 ENDOVER
|
$middle=~s/\.$//; |
$middle=~s/\.$//; |
my $realm='<font color="red">'.&mt('All Resources').'</font>'; |
my $realm='<font color="red">'.&mt('All Resources').'</font>'; |
if ($middle=~/^(.+)\_\_\_\(all\)$/) { |
if ($middle=~/^(.+)\_\_\_\(all\)$/) { |
$realm='<font color="green">'.&mt('Folder/Map').': '.&Apache::lonnet::gettitle($1).'</font>'; |
$realm='<font color="green">'.&mt('Folder/Map').': '.&Apache::lonnet::gettitle($1).' <br /><font color="#aaaaaa" size="-2">('.$1.')</font></font>'; |
} elsif ($middle) { |
} elsif ($middle) { |
$realm='<font color="orange">'.&mt('Resource').': '.&Apache::lonnet::gettitle($middle).'</font>'; |
my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle); |
|
$realm='<font color="orange">'.&mt('Resource').': '.&Apache::lonnet::gettitle($middle).' <br /><font color="#aaaaaa" size="-2">('.$url.' in '.$map.' id: '.$id.')</font></font>'; |
} |
} |
if ($section ne $oldsection) { |
if ($section ne $oldsection) { |
$r->print(&tableend()."\n<hr /><h1>$section</h1>"); |
$r->print(&tableend()."\n<hr /><h1>$section</h1>"); |
Line 1883 ENDOVER
|
Line 1928 ENDOVER
|
} |
} |
|
|
################################################## |
################################################## |
|
################################################## |
|
|
|
=pod |
|
|
|
=item change clone |
|
|
|
Modifies the list of courses a user can clone (stored |
|
in the user's environemnt.db file), called when a |
|
change is made to the list of users allowed to clone |
|
a course. |
|
|
|
Inputs: $action,$cloner |
|
where $action is add or drop, and $cloner is identity of |
|
user for whom cloning ability is to be changed in course. |
|
|
|
Returns: |
|
|
|
=cut |
|
|
|
################################################## |
|
################################################## |
|
|
|
|
|
sub change_clone { |
|
my ($clonelist,$oldcloner) = @_; |
|
my ($uname,$udom); |
|
my $cnum = $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; |
|
my $cdom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; |
|
my $clone_crs = $cnum.':'.$cdom; |
|
|
|
if ($cnum && $cdom) { |
|
my @allowclone = (); |
|
if ($clonelist =~ /,/) { |
|
@allowclone = split/,/,$clonelist; |
|
} else { |
|
$allowclone[0] = $clonelist; |
|
} |
|
foreach my $currclone (@allowclone) { |
|
if (!grep/^$currclone$/,@$oldcloner) { |
|
($uname,$udom) = split/:/,$currclone; |
|
if ($uname && $udom) { |
|
unless (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') { |
|
my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable'); |
|
if ($currclonecrs{'cloneable'} !~ /\Q$clone_crs\E/) { |
|
if ($currclonecrs{'cloneable'} eq '') { |
|
$currclonecrs{'cloneable'} = $clone_crs; |
|
} else { |
|
$currclonecrs{'cloneable'} .= ','.$clone_crs; |
|
} |
|
&Apache::lonnet::put('environment',\%currclonecrs,$udom,$uname); |
|
} |
|
} |
|
} |
|
} |
|
} |
|
foreach my $oldclone (@$oldcloner) { |
|
if (!grep/^$oldclone$/,@allowclone) { |
|
($uname,$udom) = split/:/,$oldclone; |
|
if ($uname && $udom) { |
|
unless (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') { |
|
my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable'); |
|
my %newclonecrs = (); |
|
if ($currclonecrs{'cloneable'} =~ /\Q$clone_crs\E/) { |
|
if ($currclonecrs{'cloneable'} =~ /,/) { |
|
my @currclonecrs = split/,/,$currclonecrs{'cloneable'}; |
|
foreach (@currclonecrs) { |
|
unless ($_ eq $clone_crs) { |
|
$newclonecrs{'cloneable'} .= $_.','; |
|
} |
|
} |
|
$newclonecrs{'cloneable'} =~ s/,$//; |
|
} else { |
|
$newclonecrs{'cloneable'} = ''; |
|
} |
|
&Apache::lonnet::put('environment',\%newclonecrs,$udom,$uname); |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
|
|
################################################## |
################################################## |
################################################## |
|
|
=pod |
=pod |