--- loncom/interface/loncommon.pm 2005/11/15 22:03:05 1.294 +++ loncom/interface/loncommon.pm 2005/12/01 23:04:08 1.300 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.294 2005/11/15 22:03:05 raeburn Exp $ +# $Id: loncommon.pm,v 1.300 2005/12/01 23:04:08 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1920,12 +1920,11 @@ if $first is set to 'lastname' then it r =cut + ############################################################### sub plainname { my ($uname,$udom,$first)=@_; - my %names=&Apache::lonnet::get('environment', - ['firstname','middlename','lastname','generation'], - $udom,$uname); + my %names=&getnames($uname,$udom); my $name=&Apache::lonnet::format_name($names{'firstname'}, $names{'middlename'}, $names{'lastname'}, @@ -1956,19 +1955,7 @@ if the user does not sub nickname { my ($uname,$udom)=@_; - my %names; - if ($uname eq $env{'user.name'} && - $udom eq $env{'user.domain'}) { - %names=('nickname' => $env{'environment.nickname'} , - 'firstname' => $env{'environment.firstname'} , - 'middlename' => $env{'environment.middlename'}, - 'lastname' => $env{'environment.lastname'} , - 'generation' => $env{'environment.generation'}); - } else { - %names=&Apache::lonnet::get('environment', - ['nickname','firstname','middlename', - 'lastname','generation'],$udom,$uname); - } + my %names=&getnames($uname,$udom); my $name=$names{'nickname'}; if ($name) { $name='"'.$name.'"'; @@ -1981,6 +1968,20 @@ sub nickname { return $name; } +sub getnames { + my ($uname,$udom)=@_; + my $id=$uname.':'.$udom; + my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id); + if ($cached) { + return %{$names}; + } else { + my %loadnames=&Apache::lonnet::get('environment', + ['firstname','middlename','lastname','generation','nickname'], + $udom,$uname); + &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames); + return %loadnames; + } +} # ------------------------------------------------------------------ Screenname @@ -2889,7 +2890,7 @@ ENDROLE # return(< + @@ -3083,6 +3084,61 @@ sub get_sections { } ############################################### + +=pod + +=item coursegroups + +Retrieve information about groups in a course, + +Input: +1. Reference to hash to populate with group information. +2. Optional course domain +3. Optional course number +4. Optional group name + +Course domain and number will be taken from user's +environment if not supplied. Optional group name will' +be passed to lonnet::get_coursegroups() as a regexp to +use in the call to the dump function. + +Output +Returns number of groups in the course (subject to the +optional group name filter). + +Side effects: +Populates the referenced curr_groups hash, with key, +value pairs. Keys are group names, corresponding values +are scalars containing group information in XML. This +can be sent to &get_group_settings() to be parsed. + +=cut + +############################################### + +sub coursegroups { + my ($curr_groups,$cdom,$cnum,$group) = @_; + my $numgroups; + if (!defined($cdom) || !defined($cnum)) { + my $cid = $env{'request.course.id'}; + $cdom = $env{'course.'.$cid.'.domain'}; + $cnum = $env{'course.'.$cid.'.num'}; + } + %{$curr_groups} = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group); + my ($tmp) = keys(%{$curr_groups}); + if ($tmp=~/^error:/) { + unless ($tmp eq 'error: 2 tie(GDBM) Failed while attempting dump') { + &logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'. + $cdom); + } + $numgroups = 0; + } else { + $numgroups = keys(%{$curr_groups}); + } + return $numgroups; +} + +############################################### =pod @@ -3092,7 +3148,7 @@ Uses TokeParser to extract group informa XML used to describe course groups. Input: -Scalar containing XML (as retrieved from &lonnet::get_coursegroups). +Scalar containing XML - as retrieved from &coursegroups(). Output: Hash containing group information as key=values for (a), and @@ -3288,7 +3344,7 @@ sub get_user_info { $$userdata{$uname.':'.$udom}[$$idx{fullname}] = &plainname($uname,$udom,'lastname'); $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname; - $$userdata{$uname.':'.$udom}[$$idx{uname}] = $udom; + $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom; return; } @@ -3430,7 +3486,10 @@ sub no_cache { sub content_type { my ($r,$type,$charset) = @_; - &no_cache($r); + if ($r) { + # Note that printout.pl calls this with undef for $r. + &no_cache($r); + } if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; } unless ($charset) { $charset=&Apache::lonlocal::current_encoding; @@ -4296,13 +4355,14 @@ sub store_course_settings { # save to the environment # appenv the same items, just to be safe my $courseid = $env{'request.course.id'}; - my $coursedom = $env{'course.'.$courseid.'.domain'}; + my $udom = $env{'user.domain'}; + my $uname = $env{'user.name'}; my ($prefix,$Settings) = @_; my %SaveHash; my %AppHash; while (my ($setting,$type) = each(%$Settings)) { - my $basename = 'internal.'.$prefix.'.'.$setting; - my $envname = 'course.'.$courseid.'.'.$basename; + my $basename = join('.','internal',$courseid,$prefix,$setting); + my $envname = 'environment.'.$basename; if (exists($env{'form.'.$setting})) { # Save this value away if ($type eq 'scalar' && @@ -4330,8 +4390,7 @@ sub store_course_settings { } } my $put_result = &Apache::lonnet::put('environment',\%SaveHash, - $coursedom, - $env{'course.'.$courseid.'.num'}); + $udom,$uname); if ($put_result !~ /^(ok|delayed)/) { &Apache::lonnet::logthis('unable to save form parameters, '. 'got error:'.$put_result); @@ -4346,7 +4405,7 @@ sub restore_course_settings { my ($prefix,$Settings) = @_; while (my ($setting,$type) = each(%$Settings)) { next if (exists($env{'form.'.$setting})); - my $envname = 'course.'.$courseid.'.internal.'.$prefix. + my $envname = 'environment.internal.'.$courseid.'.'.$prefix. '.'.$setting; if (exists($env{$envname})) { if ($type eq 'scalar') {
$upperleft $messages