--- loncom/interface/lonparmset.pm 2010/02/15 01:20:08 1.413.4.6 +++ loncom/interface/lonparmset.pm 2010/02/21 01:15:49 1.413.4.7 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set parameters for assessments # -# $Id: lonparmset.pm,v 1.413.4.6 2010/02/15 01:20:08 raeburn Exp $ +# $Id: lonparmset.pm,v 1.413.4.7 2010/02/21 01:15:49 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -247,37 +247,6 @@ Variables used (guessed by Jeremy): =item parse_key() -=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 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. - - -=item check_cloners() - -=item change_clone() - =item header() Output html header for page @@ -3051,121 +3020,6 @@ sub parse_key { return %data; } -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(/^\Q$currclone\E$/,@$oldcloner)) { - if ($currclone eq '*') { - $clean_clonelist .= $currclone.','; - } else { - my ($uname,$udom) = split(/:/,$currclone); - if ($uname eq '*') { - if ($udom =~ /^$match_domain$/) { - if (!&Apache::lonnet::domain($udom)) { - $disallowed{'domain'} .= $currclone.','; - } else { - $clean_clonelist .= $currclone.','; - } - } else { - $disallowed{'format'} .= $currclone.','; - } - } elsif ($currclone !~/^($match_username)\:($match_domain)$/) { - $disallowed{'format'} .= $currclone.','; - } else { - if (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') { - $disallowed{'newuser'} .= $currclone.','; - } else { - $clean_clonelist .= $currclone.','; - } - } - } - } else { - $clean_clonelist .= $currclone.','; - } - } - foreach my $key (keys(%disallowed)) { - $disallowed{$key} =~ s/,$//; - } - if ($clean_clonelist) { - $clean_clonelist =~ s/,$//; - } - $$clonelist = $clean_clonelist; - return %disallowed; -} - -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; - &extract_cloners($clonelist,\@allowclone); - foreach my $currclone (@allowclone) { - if (!grep(/^$currclone$/,@$oldcloner)) { - if ($currclone ne '*') { - ($uname,$udom) = split(/:/,$currclone); - if ($uname && $udom && $uname ne '*') { - if (&Apache::lonnet::homeserver($uname,$udom) ne '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(/^\Q$oldclone\E$/,@allowclone)) { - if ($oldclone ne '*') { - ($uname,$udom) = split(/:/,$oldclone); - if ($uname && $udom && $uname ne '*' ) { - if (&Apache::lonnet::homeserver($uname,$udom) ne '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 my $crs (@currclonecrs) { - if ($crs ne $clone_crs) { - $newclonecrs{'cloneable'} .= $crs.','; - } - } - $newclonecrs{'cloneable'} =~ s/,$//; - } else { - $newclonecrs{'cloneable'} = ''; - } - &Apache::lonnet::put('environment',\%newclonecrs,$udom,$uname); - } - } - } - } - } - } - } -} - - sub header { return &Apache::loncommon::start_page('Parameter Manager'); }