--- loncom/interface/loncommon.pm 2005/11/15 15:14:17 1.288 +++ loncom/interface/loncommon.pm 2006/04/13 21:02:25 1.335 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.288 2005/11/15 15:14:17 raeburn Exp $ +# $Id: loncommon.pm,v 1.335 2006/04/13 21:02:25 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -58,10 +58,11 @@ use strict; use Apache::lonnet; use GDBM_File; use POSIX qw(strftime mktime); -use Apache::Constants qw(:common :http :methods); use Apache::lonmenu(); use Apache::lonlocal; use HTML::Entities; +use Apache::lonhtmlcommon(); +use Apache::loncoursedata(); my $readit; @@ -331,7 +332,10 @@ sub storeresurl { sub studentbrowser_javascript { unless ( (($env{'request.course.id'}) && - (&Apache::lonnet::allowed('srm',$env{'request.course.id'}))) + (&Apache::lonnet::allowed('srm',$env{'request.course.id'}) + || &Apache::lonnet::allowed('srm',$env{'request.course.id'}. + '/'.$env{'request.course.sec'}) + )) || ($env{'request.role'}=~/^(au|dc|su)/) ) { return ''; } return (<<'ENDSTDBRW'); @@ -362,7 +366,9 @@ ENDSTDBRW sub selectstudent_link { my ($form,$unameele,$udomele)=@_; if ($env{'request.course.id'}) { - unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) { + if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'}) + && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}. + '/'.$env{'request.course.sec'})) { return ''; } return " var stdeditbrowser; - function opencrsbrowser(formname,uname,udom,desc,extra_element) { + function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag) { var url = '/adm/pickcourse?'; var filter; if (filter != null) { @@ -403,6 +409,9 @@ sub coursebrowser_javascript { url += '&domainfilter='+extra_element; } } + if (multflag !=null && multflag != '') { + url += '&multiple='+multflag; + } var title = 'Course_Browser'; var options = 'scrollbars=1,resizable=1,menubar=0'; options += ',width=700,height=600'; @@ -414,9 +423,9 @@ ENDSTDBRW } sub selectcourse_link { - my ($form,$unameele,$udomele,$desc,$extra_element)=@_; + my ($form,$unameele,$udomele,$desc,$extra_element,$multflag)=@_; return "".&mt('Select Course').""; + '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'");'."'>".&mt('Select Course').""; } sub check_uncheck_jscript { @@ -713,8 +722,18 @@ sub help_open_menu { "$text"; } my $nothing=&Apache::lonhtmlcommon::javascript_nothing(); - my $html=&Apache::lonxml::xmlbegin(); my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif"); + my $start_page = + &Apache::loncommon::start_page('Help Menu', undef, + {'frameset' => 1, + 'js_ready' => 1, + 'add_entries' => { + 'border' => '0', + 'rows' => "105,*",},}); + my $end_page = + &Apache::loncommon::end_page({'frameset' => 1, + 'js_ready' => 1,}); + $template .= <<"ENDTEMPLATE"; }{}xmsg; + + return $result; +} + +sub validate_page { + if ( exists($env{'internal.start_page'}) + && $env{'internal.start_page'} > 1) { + &Apache::lonnet::logthis('start_page called multiple times '. + $env{'internal.start_page'}.' '. + $ENV{'request.filename'}); + } + if ( exists($env{'internal.end_page'}) + && $env{'internal.end_page'} > 1) { + &Apache::lonnet::logthis('end_page called multiple times '. + $env{'internal.end_page'}.' '. + $env{'request.filename'}); + } + if ( exists($env{'internal.start_page'}) + && ! exists($env{'internal.end_page'})) { + &Apache::lonnet::logthis('start_page called without end_page '. + $env{'request.filename'}); + } + if ( ! exists($env{'internal.start_page'}) + && exists($env{'internal.end_page'})) { + &Apache::lonnet::logthis('end_page called without start_page'. + $env{'request.filename'}); + } +} + +sub simple_error_page { + my ($r,$title,$msg) = @_; + my $page = + &Apache::loncommon::start_page($title). + &mt($msg). + &Apache::loncommon::end_page(); + if (ref($r)) { + $r->print($page); + return; + } + return $page; +} ############################################### =pod +=over 4 + =item get_users_function Used by &bodytag to determine the current users primary role. @@ -3080,6 +3407,153 @@ 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 + +=item get_group_settings + +Uses TokeParser to extract group information from the +XML used to describe course groups. + +Input: +Scalar containing XML - as retrieved from &coursegroups(). + +Output: +Hash containing group information as key=values for (a), and +hash of hashes for (b) + +Keys (in two categories): +(a) groupname, creator, creation, modified, startdate,enddate. +Corresponding values are name of the group, creator of the group +(username:domain), UNIX time for date group was created, and +settings were last modified, and default start and end access +times for group members. + +(b) functions returned in hash of hashes. +Outer hash key is functions. +Inner hash keys are chat,discussion,email,files,homepage,roster. +Corresponding values are either on or off, depending on +whether this type of functionality is available for the group. + +=cut + +############################################### + +sub get_group_settings { + my ($groupinfo)=@_; + my $parser=HTML::TokeParser->new(\$groupinfo); + my $token; + my $tool = ''; + my $role = ''; + my %content=(); + while ($token=$parser->get_token) { + if ($token->[0] eq 'S') { + my $entry=$token->[1]; + if ($entry eq 'functions' || $entry eq 'autosec') { + %{$content{$entry}} = (); + $tool = $entry; + } elsif ($entry eq 'role') { + if ($tool eq 'autosec') { + $role = $token->[2]{id}; + } + } else { + my $value=$parser->get_text('/'.$entry); + if ($entry eq 'name') { + if ($tool eq 'functions') { + my $function = $token->[2]{id}; + $content{$tool}{$function} = $value; + } + } elsif ($entry eq 'groupname') { + $content{$entry}=&Apache::lonnet::unescape($value); + } elsif (($entry eq 'roles') || ($entry eq 'types') || + ($entry eq 'sectionpick') || ($entry eq 'defpriv')) { + push(@{$content{$entry}},$value); + } elsif ($entry eq 'section') { + if ($tool eq 'autosec' && $role ne '') { + push(@{$content{$tool}{$role}},$value); + } + } else { + $content{$entry}=$value; + } + } + } elsif ($token->[0] eq 'E') { + if ($token->[1] eq 'functions' || $token->[1] eq 'autosec') { + $tool = ''; + } elsif ($token->[1] eq 'role') { + $role = ''; + } + + } + } + return %content; +} + +sub check_group_access { + my ($group) = @_; + my $access = 1; + my $now = time; + my ($start,$end) = split(/\./,$env{'user.role.gr/'.$env{'request.course,id'}.'/'.$group}); + if (($end!=0) && ($end<$now)) { $access = 0; } + if (($start!=0) && ($start>$now)) { $access=0; } + return $access; +} + +############################################### =pod @@ -3123,17 +3597,16 @@ sub get_course_users { $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME(); $idx{status} = &Apache::loncoursedata::CL_STATUS(); - if (grep/^st$/,@{$roles}) { + if (grep(/^st$/,@{$roles})) { 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 ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) { + unless(grep(/^\Q$$classlist{$student}[$idx{section}]\E$/, + @{$sections})) { + next; + } } if (defined($$types{'active'})) { if ($$classlist{$student}[$idx{status}] eq 'Active') { @@ -3164,16 +3637,13 @@ sub get_course_users { my $match = 0; my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/); $user =~ s/:$//; - if (($role) && (grep(/^$role$/,@{$roles}))) { + if (($role) && (grep(/^\Q$role\E$/,@{$roles}))) { 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 ($usec ne '' && (ref($sections) eq 'ARRAY') && + @{$sections} > 0) { + unless(grep(/^\Q$usec\E$/,@{$sections})) { + next; + } } if ($uname ne '' && $udom ne '') { my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role); @@ -3183,25 +3653,23 @@ sub get_course_users { $match = 1; } } - if ($match && defined($userdata)) { - unless(exists($$userdata{$uname.':'.$udom})) { - &get_user_info($udom,$uname,\%idx,$userdata); - } + if ($match && defined($userdata) && + !exists($$userdata{$uname.':'.$udom})) { + &get_user_info($udom,$uname,\%idx,$userdata); } } } } - if (grep/^ow$/,@{$roles}) { + if (grep(/^ow$/,@{$roles})) { if ((defined($cdom)) && (defined($cnum))) { 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'; - if (defined($userdata)) { - unless(exists($$userdata{$owner.':'.$cdom})) { - &get_user_info($cdom,$owner,\%idx,$userdata); - } - } + if (defined($userdata) && + !exists($$userdata{$owner.':'.$cdom})) { + &get_user_info($cdom,$owner,\%idx,$userdata); + } } } } @@ -3211,94 +3679,13 @@ sub get_course_users { 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}; - } - } + $$userdata{$uname.':'.$udom}[$$idx{fullname}] = + &plainname($uname,$udom,'lastname'); + $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname; + $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom; return; } -############################################### - -sub get_posted_cgi { - my $r=shift; - - my $buffer; - if ($r->header_in('Content-length')) { - $r->read($buffer,$r->header_in('Content-length'),0); - } - unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) { - my @pairs=split(/&/,$buffer); - my $pair; - foreach $pair (@pairs) { - my ($name,$value) = split(/=/,$pair); - $value =~ tr/+/ /; - $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; - $name =~ tr/+/ /; - $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; - &add_to_env("form.$name",$value); - } - } else { - my $contentsep=$1; - my @lines = split (/\n/,$buffer); - my $name=''; - my $value=''; - my $fname=''; - my $fmime=''; - my $i; - for ($i=0;$i<=$#lines;$i++) { - if ($lines[$i]=~/^$contentsep/) { - if ($name) { - chomp($value); - if ($fname) { - $env{"form.$name.filename"}=$fname; - $env{"form.$name.mimetype"}=$fmime; - } else { - $value=~s/\s+$//s; - } - &add_to_env("form.$name",$value); - } - if ($i<$#lines) { - $i++; - $lines[$i]=~ - /Content\-Disposition\:\s*form\-data\;\s*name\=\"([^\"]+)\"/i; - $name=$1; - $value=''; - if ($lines[$i]=~/filename\=\"([^\"]+)\"/i) { - $fname=$1; - if - ($lines[$i+1]=~/Content\-Type\:\s*([\w\-\/]+)/i) { - $fmime=$1; - $i++; - } else { - $fmime=''; - } - } else { - $fname=''; - $fmime=''; - } - $i++; - } - } else { - $value.=$lines[$i]."\n"; - } - } - } - $env{'request.method'}=$ENV{'REQUEST_METHOD'}; - $r->method_number(M_GET); - $r->method('GET'); - $r->headers_in->unset('Content-length'); -} - =pod =item * get_unprocessed_cgi($query,$possible_names) @@ -3365,6 +3752,10 @@ sub no_cache { sub content_type { my ($r,$type,$charset) = @_; + 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; @@ -3599,6 +3990,22 @@ sub upfile_select_html { return $Str; } +sub get_samples { + my ($records,$toget) = @_; + my @samples=({}); + my $got=0; + foreach my $rec (@$records) { + my %temp = &record_sep($rec); + if (! grep(/\S/, values(%temp))) { next; } + if (%temp) { + $samples[$got]=\%temp; + $got++; + if ($got == $toget) { last; } + } + } + return \@samples; +} + ###################################################### ###################################################### @@ -3616,18 +4023,15 @@ Apache Request ref, $records is an array ###################################################### sub csv_print_samples { my ($r,$records) = @_; - my (%sone,%stwo,%sthree); - %sone=&record_sep($$records[0]); - if (defined($$records[1])) {%stwo=&record_sep($$records[1]);} - if (defined($$records[2])) {%sthree=&record_sep($$records[2]);} - # + my $samples = &get_samples($records,3); + $r->print(&mt('Samples').'
'); - foreach (sort({$a <=> $b} keys(%sone))) { + foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) { $r->print(''); } $r->print(''); - foreach my $hash (\%sone,\%stwo,\%sthree) { + foreach my $hash (@$samples) { $r->print(''); - foreach (sort({$a <=> $b} keys(%sone))) { + foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) { $r->print(''); @@ -3656,8 +4060,8 @@ $d is an array of 2 element arrays (inte ###################################################### sub csv_print_select_table { my ($r,$records,$d) = @_; - my $i=0;my %sone; - %sone=&record_sep($$records[0]); + my $i=0; + my $samples = &get_samples($records,1); $r->print(&mt('Associate columns with student attributes.')."\n". '

'.&mt('Column [_1]',($_+1)).'
'); if (defined($$hash{$_})) { $r->print($$hash{$_}); } $r->print('

'. ''. @@ -3669,7 +4073,7 @@ sub csv_print_select_table { $r->print('

'.&mt('Attribute').'

'); - %sone=&record_sep($$records[0]); - if (defined($$records[1])) {%stwo=&record_sep($$records[1]);} - if (defined($$records[2])) {%sthree=&record_sep($$records[2]);} - # - foreach (sort keys %sone) { + + foreach my $key (sort(keys(%{ $samples->[0] }))) { $r->print(''); $i++; } @@ -4230,13 +4633,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' && @@ -4264,8 +4668,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); @@ -4280,7 +4683,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') {

'. &mt('Field').'	'.&mt('Samples').'
	'); - if (defined($sone{$_})) { $r->print($sone{$_}." \n"); } - if (defined($stwo{$_})) { $r->print($stwo{$_}." \n"); } - if (defined($sthree{$_})) { $r->print($sthree{$_}." \n"); } + foreach my $line (0..2) { + if (defined($samples->[$line]{$key})) { + $r->print($samples->[$line]{$key}." \n"); + } + } $r->print('