--- loncom/interface/loncommon.pm 2005/11/15 18:07:46 1.292 +++ loncom/interface/loncommon.pm 2006/04/20 02:24:08 1.344 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.292 2005/11/15 18:07:46 albertel Exp $ +# $Id: loncommon.pm,v 1.344 2006/04/20 02:24:08 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -58,10 +58,12 @@ 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(); +use Apache::lontexconvert(); my $readit; @@ -331,7 +333,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 +367,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 +410,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 +424,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 +723,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 +3534,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 @@ -3208,82 +3809,10 @@ 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; } -############################################### - -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) @@ -3350,7 +3879,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; @@ -3585,6 +4117,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; +} + ###################################################### ###################################################### @@ -3602,18 +4150,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(''); @@ -3642,8 +4187,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('
'. ''. @@ -3655,7 +4200,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++; } @@ -4216,13 +4760,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' && @@ -4250,8 +4795,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); @@ -4266,7 +4810,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('