--- loncom/interface/loncommon.pm 2005/11/01 20:47:15 1.281 +++ loncom/interface/loncommon.pm 2005/11/15 15:14:17 1.288 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.281 2005/11/01 20:47:15 albertel Exp $ +# $Id: loncommon.pm,v 1.288 2005/11/15 15:14:17 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1149,27 +1149,49 @@ sub domain_select { } &get_domains; if ($multiple) { $domains{''}=&mt('Any domain'); - return &multiple_select_form($name,$value,4,%domains); + return &multiple_select_form($name,$value,4,\%domains); } else { return &select_form($name,$value,%domains); } } +#------------------------------------------- + +=pod + +=item * multiple_select_form($name,$value,$size,$hash,$order) + +Returns a string containing a element + $value - sclara or array ref of values that should already be selected + $size - number of rows long the select element is + $hash - the elements should be 'option' => 'shown text' + (shown text should already have been &mt()) + $order - (optional) array ref of the order to show the elments in + +=cut + +#------------------------------------------- sub multiple_select_form { - my ($name,$value,$size,%hash)=@_; + my ($name,$value,$size,$hash,$order)=@_; my %selected = map { $_ => 1 } ref($value)?@{$value}:($value); my $output=''; if (! defined($size)) { $size = 4; - if (scalar(keys(%hash))<4) { - $size = scalar(keys(%hash)); + if (scalar(keys(%$hash))<4) { + $size = scalar(keys(%$hash)); } } $output.="\n\n"; return $output; @@ -2511,7 +2533,7 @@ sub pgrdlink { Inputs: $text $uname $udom $symb $target Returns: A link to parmset.pm such as to see the PPRM view of a -student andn resource +student and a specific resource =cut @@ -2752,6 +2774,10 @@ sub bodytag { @@ -2860,7 +2886,7 @@ ENDROLE # return(< + @@ -3068,53 +3094,98 @@ Incoming parameters: 3. access status: users must have - either active, previous, future, or all. 4. reference to array of permissible roles -5. reference to results object (hash of hashes). +5. reference to array of section restrictions (optional) +6. reference to results object (hash of hashes). +7. reference to optional userdata hash Keys of top level hash are roles. Keys of inner hashes are username:domain, with values set to access type. - +Optional userdata hash returns an array with arguments in the +same order as loncoursedata::get_classlist() for student data. + +Entries for end, start, section and status are blank because +of the possibility of multiple values for non-student roles. + =cut ############################################### sub get_course_users { - my ($cdom,$cnum,$types,$roles,$users) = @_; + my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata) = @_; + my %idx = (); + + $idx{udom} = &Apache::loncoursedata::CL_SDOM(); + $idx{uname} = &Apache::loncoursedata::CL_SNAME(); + $idx{end} = &Apache::loncoursedata::CL_END(); + $idx{start} = &Apache::loncoursedata::CL_START(); + $idx{id} = &Apache::loncoursedata::CL_ID(); + $idx{section} = &Apache::loncoursedata::CL_SECTION(); + $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME(); + $idx{status} = &Apache::loncoursedata::CL_STATUS(); + if (grep/^st$/,@{$roles}) { - my $statusidx = &Apache::loncoursedata::CL_STATUS(); - my $startidx = &Apache::loncoursedata::CL_START(); - my $endidx = &Apache::loncoursedata::CL_END(); my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum); my $now = time; foreach my $student (keys(%{$classlist})) { + my $match = 0; + if (defined($sections) && (ref($sections) eq 'ARRAY')) { + if (@{$sections} > 0) { + unless(grep/^$$classlist{$student}[$idx{section}]$/,@{$sections}) { + next; + } + } + } if (defined($$types{'active'})) { - if ($$classlist{$student}[$statusidx] eq 'Active') { + if ($$classlist{$student}[$idx{status}] eq 'Active') { push(@{$$users{st}{$student}},'active'); + $match = 1; } } if (defined($$types{'previous'})) { - if ($$classlist{$student}[$endidx] <= $now) { + if ($$classlist{$student}[$idx{end}] <= $now) { push(@{$$users{st}{$student}},'previous'); + $match = 1; } } if (defined($$types{'future'})) { - if (($$classlist{$student}[$startidx] > $now) && ($$classlist{$student}[$endidx] > $now) || ($$classlist{$student}[$endidx] == 0) || ($$classlist{$student}[$endidx] eq '')) { + if (($$classlist{$student}[$idx{start}] > $now) && ($$classlist{$student}[$idx{end}] > $now) || ($$classlist{$student}[$idx{end}] == 0) || ($$classlist{$student}[$idx{end}] eq '')) { push(@{$$users{st}{$student}},'future'); + $match = 1; } } + if ($match && defined($userdata)) { + $$userdata{$student} = $$classlist{$student}; + } } } if ((@{$roles} > 0) && (@{$roles} ne "st")) { my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum); foreach my $person (@coursepersonnel) { + my $match = 0; my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/); $user =~ s/:$//; if (($role) && (grep(/^$role$/,@{$roles}))) { - my ($uname,$udom) = split(/:/,$user); + my ($uname,$udom,$usec) = split(/:/,$user); + unless ($usec eq '') { + if (defined($sections) && (ref($sections) eq 'ARRAY')) { + if (@{$sections} > 0) { + unless(grep/^$usec$/,@{$sections}) { + next; + } + } + } + } if ($uname ne '' && $udom ne '') { my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role); foreach my $type (keys(%{$types})) { if ($status eq $type) { - $$users{$role}{$user} = $type; + @{$$users{$role}{$user}} = $type; + $match = 1; + } + } + if ($match && defined($userdata)) { + unless(exists($$userdata{$uname.':'.$udom})) { + &get_user_info($udom,$uname,\%idx,$userdata); } } } @@ -3125,7 +3196,12 @@ sub get_course_users { my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum); if ( defined($csettings{'internal.courseowner'}) ) { my $owner = $csettings{'internal.courseowner'}; - $$users{'ow'}{$owner.':'.$cdom} = 'any'; + @{$$users{'ow'}{$owner.':'.$cdom}} = 'any'; + if (defined($userdata)) { + unless(exists($$userdata{$owner.':'.$cdom})) { + &get_user_info($cdom,$owner,\%idx,$userdata); + } + } } } } @@ -3133,7 +3209,23 @@ sub get_course_users { return; } - +sub get_user_info { + my ($udom,$uname,$idx,$userdata) = @_; + my %userinfo = &Apache::lonnet::get('environment',['firstname','middlename','lastname','generation','id'],$udom,$uname); + if (grep/^(con_lost|error|no_such_host)/,keys(%userinfo)) { + &Apache::lonnet::logthis('get_user_info error for '.$uname.':'.$udom); + $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom; + $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname; + } else { + $userinfo{fullname} = &Apache::lonnet::format_name(@userinfo{qw/firstname middlename lastname generation/},'lastname'); + $userinfo{uname} = $uname; + $userinfo{udom} = $udom; + foreach my $item (qw/uname udom id fullname/) { + $$userdata{$uname.':'.$udom}[$$idx{$item}] = $userinfo{$item}; + } + } + return; +} ###############################################
$upperleft $messages