--- loncom/interface/lonparmset.pm 2005/06/28 16:28:16 1.237
+++ loncom/interface/lonparmset.pm 2005/09/02 22:40:07 1.239.2.1
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set parameters for assessments
#
-# $Id: lonparmset.pm,v 1.237 2005/06/28 16:28:16 albertel Exp $
+# $Id: lonparmset.pm,v 1.239.2.1 2005/09/02 22:40:07 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1330,7 +1330,9 @@ sub assessparms {
} else {
my ($map,$id,$resource)=&Apache::lonnet::decode_symb($pssymb);
$r->print(&mt('Specific Resource').": ".$resource.
- '
');
+ ''.
+ '
');
}
&usermenu($r,$uname,$id,$udom,$csec);
@@ -1475,12 +1477,7 @@ ENDTABLEHEADFOUR
$r->print('');
-
- $r->print(' / res / ');
- $r->print(join(' / ', split(/\//,$mapp{$rid})));
-
- $r->print(' | ');
+ '>'.$maptitles{$mapp{$rid}}.'');
foreach (&keysinorder_bytype(\%name,\%keyorder)) {
unless ($firstrow) {
@@ -1772,9 +1769,13 @@ sub crsenv {
#
# Let the user know we made the changes
if ($name && defined($value)) {
+ my $failed_cloners;
if ($name eq 'cloners') {
+ $value =~ s/\s//g;
$value =~ s/^,//;
$value =~ s/,$//;
+ # check requested clones are valid users.
+ $failed_cloners = &check_cloners(\$value,\@oldcloner);
}
my $put_result = &Apache::lonnet::put('environment',
{$name=>$value},$dom,$crs);
@@ -1791,6 +1792,18 @@ sub crsenv {
$setoutput.=&mt('Unable to set').' '.$name.' '.&mt('to').
' '.$value.' '.&mt('due to').' '.$put_result.'.
';
}
+ if (($name eq 'cloners') && ($failed_cloners)) {
+ $setoutput.= &mt('Unable to include').' - '.$failed_cloners.', '.
+ &mt('reason').' - '.&mt('LON-CAPA user(s) do(es) not exist').
+ '.
'.&mt('Please ').
+ ' '.
+ &mt('add the user(s)').', '.
+ &mt('and then return to the ').
+ ''.
+ &mt('Course Parameters page').' '.
+ &mt('to add the new user(s) to the list of possible cloners').
+ '.
';
+ }
}
}
# ------------------------- Re-init course environment entries for this session
@@ -2176,20 +2189,41 @@ sub listdata {
my $pointer=0;
$tableopen=0;
my $foundkeys=0;
+ my %keyorder=&standardkeyorder();
foreach my $thiskey (sort {
if ($sortorder eq 'realmstudent') {
- my ($astudent,$arealm)=($a=~/^$env{'request.course.id'}\.([^\.]+)\.(.+)\.[^\.]+$/);
- my ($bstudent,$brealm)=($b=~/^$env{'request.course.id'}\.([^\.]+)\.(.+)\.[^\.]+$/);
- if (!defined($astudent) && !defined($bstudent) &&
- !defined($arealm) && !defined($brealm)) {
- ($arealm)=($a=~/^$env{'request.course.id'}\.(.+)\.[^\.]+$/);
- ($brealm)=($b=~/^$env{'request.course.id'}\.(.+)\.[^\.]+$/);
+ my ($astudent,$arealm)=($a=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)\.[^\.]+$/);
+ my ($bstudent,$brealm)=($b=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)\.[^\.]+$/);
+ if (!defined($astudent)) {
+ ($arealm)=($a=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
+ }
+ if (!defined($bstudent)) {
+ ($brealm)=($b=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
+ }
+ $arealm=~s/\.type//;
+ my ($ares, $aparm) = ($arealm=~/^(.*)\.(.*)$/);
+ $aparm=$keyorder{'parameter_0_'.$aparm};
+ $brealm=~s/\.type//;
+ my ($bres, $bparm) = ($brealm=~/^(.*)\.(.*)$/);
+ $bparm=$keyorder{'parameter_0_'.$bparm};
+ if ($ares eq $bres) {
+ if (defined($aparm) && defined($bparm)) {
+ ($aparm <=> $bparm);
+ } elsif (defined($aparm)) {
+ -1;
+ } elsif (defined($bparm)) {
+ 1;
+ } else {
+ ($arealm cmp $brealm) || ($astudent cmp $bstudent);
+ }
+ } else {
+ ($arealm cmp $brealm) || ($astudent cmp $bstudent);
}
- ($arealm cmp $brealm) || ($astudent cmp $bstudent);
} else {
$a cmp $b;
}
} keys %{$listdata}) {
+
if ($$listdata{$thiskey.'.type'}) {
my $thistype=$$listdata{$thiskey.'.type'};
if ($$resourcedata{$thiskey.'.type'}) {
@@ -2493,25 +2527,76 @@ ENDOVER
##################################################
=pod
-
-=item change clone
-
+
+=item check_cloners
+
+Checks if new users included in list of allowed cloners
+are valid users. Replaces supplied list with
+cleaned list containing only users with valid usernames
+and domains.
+
+Inputs: $clonelist, $oldcloner
+where $clonelist is ref to array of requested cloners,
+and $oldcloner is ref to array of currently allowed
+cloners.
+
+Returns: string - comma separated list of requested
+cloners (username:domain) who do not exist in system.
+
+=item change_clone
+
Modifies the list of courses a user can clone (stored
-in the user's environemnt.db file), called when a
+in the user's environment.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 extract_cloners {
+ my ($clonelist,$allowclone) = @_;
+ if ($clonelist =~ /,/) {
+ @{$allowclone} = split/,/,$clonelist;
+ } else {
+ $$allowclone[0] = $clonelist;
+ }
+}
+
+
+sub check_cloners {
+ my ($clonelist,$oldcloner) = @_;
+ my ($clean_clonelist,$disallowed);
+ my @allowclone = ();
+ &extract_cloners($$clonelist,\@allowclone);
+ foreach my $currclone (@allowclone) {
+ if (!grep/^$currclone$/,@$oldcloner) {
+ my ($uname,$udom) = split/:/,$currclone;
+ if ($uname && $udom) {
+ if (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
+ $disallowed .= $currclone.',';
+ } else {
+ $clean_clonelist .= $currclone.',';
+ }
+ }
+ } else {
+ $clean_clonelist .= $currclone.',';
+ }
+ }
+ if ($disallowed) {
+ $disallowed =~ s/,$//;
+ }
+ if ($clean_clonelist) {
+ $clean_clonelist =~ s/,$//;
+ }
+ $$clonelist = $clean_clonelist;
+ return $disallowed;
+}
sub change_clone {
my ($clonelist,$oldcloner) = @_;
@@ -2521,12 +2606,8 @@ sub change_clone {
my $clone_crs = $cnum.':'.$cdom;
if ($cnum && $cdom) {
- my @allowclone = ();
- if ($clonelist =~ /,/) {
- @allowclone = split/,/,$clonelist;
- } else {
- $allowclone[0] = $clonelist;
- }
+ my @allowclone;
+ &extract_cloners($clonelist,\@allowclone);
foreach my $currclone (@allowclone) {
if (!grep/^$currclone$/,@$oldcloner) {
($uname,$udom) = split/:/,$currclone;