--- loncom/interface/loncommon.pm 2006/04/14 20:16:02 1.337 +++ loncom/interface/loncommon.pm 2006/06/02 13:58:31 1.378 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.337 2006/04/14 20:16:02 albertel Exp $ +# $Id: loncommon.pm,v 1.378 2006/06/02 13:58:31 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -63,6 +63,8 @@ use Apache::lonlocal; use HTML::Entities; use Apache::lonhtmlcommon(); use Apache::loncoursedata(); +use Apache::lontexconvert(); +use LONCAPA; my $readit; @@ -75,7 +77,7 @@ my %language; my %supported_language; my %cprtag; my %scprtag; -my %fe; my %fd; +my %fe; my %fd; my %fm; my %category_extensions; # ---------------------------------------------- Designs @@ -106,10 +108,10 @@ BEGIN { my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/language.tab'; if ( open(my $fh,"<$langtabfile") ) { - while (<$fh>) { - next if /^\#/; - chomp; - my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_)); + while (my $line = <$fh>) { + next if ($line=~/^\#/); + chomp($line); + my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line)); $language{$key}=$val.' - '.$enc; if ($sup) { $supported_language{$key}=$sup; @@ -123,24 +125,24 @@ BEGIN { my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. '/copyright.tab'; if ( open (my $fh,"<$copyrightfile") ) { - while (<$fh>) { - next if /^\#/; - chomp; - my ($key,$val)=(split(/\s+/,$_,2)); + while (my $line = <$fh>) { + next if ($line=~/^\#/); + chomp($line); + my ($key,$val)=(split(/\s+/,$line,2)); $cprtag{$key}=$val; } close($fh); } } -# ------------------------------------------------------------------ source copyrights +# ----------------------------------------------------------- source copyrights { my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. '/source_copyright.tab'; if ( open (my $fh,"<$sourcecopyrightfile") ) { - while (<$fh>) { - next if /^\#/; - chomp; - my ($key,$val)=(split(/\s+/,$_,2)); + while (my $line = <$fh>) { + next if ($line =~ /^\#/); + chomp($line); + my ($key,$val)=(split(/\s+/,$line,2)); $scprtag{$key}=$val; } close($fh); @@ -158,10 +160,10 @@ BEGIN { { my $designfile = $designdir.'/'.$filename; if ( open (my $fh,"<$designfile") ) { - while (<$fh>) { - next if /^\#/; - chomp; - my ($key,$val)=(split(/\=/,$_)); + while (my $line = <$fh>) { + next if ($line =~ /^\#/); + chomp($line); + my ($key,$val)=(split(/\=/,$line)); if ($val) { $designhash{$domain.'.'.$key}=$val; } } close($fh); @@ -177,10 +179,10 @@ BEGIN { my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/filecategories.tab'; if ( open (my $fh,"<$categoryfile") ) { - while (<$fh>) { - next if /^\#/; - chomp; - my ($extension,$category)=(split(/\s+/,$_,2)); + while (my $line = <$fh>) { + next if ($line =~ /^\#/); + chomp($line); + my ($extension,$category)=(split(/\s+/,$line,2)); push @{$category_extensions{lc($category)}},$extension; } close($fh); @@ -192,13 +194,14 @@ BEGIN { my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/filetypes.tab'; if ( open (my $fh,"<$typesfile") ) { - while (<$fh>) { - next if (/^\#/); - chomp; - my ($ending,$emb,$descr)=split(/\s+/,$_,3); + while (my $line = <$fh>) { + next if ($line =~ /^\#/); + chomp($line); + my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4); if ($descr ne '') { $fe{$ending}=lc($emb); $fd{$ending}=$descr; + if ($mime ne 'unk') { $fm{$ending}=$mime; } } } close($fh); @@ -383,10 +386,11 @@ sub selectstudent_link { sub coursebrowser_javascript { my ($domainfilter)=@_; + my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Group - for which you wish to add/modify a user role'); return (< var stdeditbrowser; - function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag) { + function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,crstype) { var url = '/adm/pickcourse?'; var filter; if (filter != null) { @@ -412,6 +416,18 @@ sub coursebrowser_javascript { if (multflag !=null && multflag != '') { url += '&multiple='+multflag; } + if (crstype == 'Course/Group') { + if (formname == 'cu') { + crstype = document.cu.crstype.options[document.cu.crstype.selectedIndex].value; + if (crstype == "") { + alert("$crs_or_grp_alert"); + return; + } + } + } + if (crstype !=null && crstype != '') { + url += '&type='+crstype; + } var title = 'Course_Browser'; var options = 'scrollbars=1,resizable=1,menubar=0'; options += ',width=700,height=600'; @@ -423,9 +439,9 @@ ENDSTDBRW } sub selectcourse_link { - my ($form,$unameele,$udomele,$desc,$extra_element,$multflag)=@_; + my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_; return "".&mt('Select Course').""; + '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select [_1]',$selecttype).""; } sub check_uncheck_jscript { @@ -705,8 +721,9 @@ sub help_open_menu { my $origurl = $ENV{'REQUEST_URI'}; $origurl=~s|^/~|/priv/|; my $timestamp = time; - foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) { - $$_ = &Apache::lonnet::escape($$_); + foreach my $datum (\$color,\$function,\$topic,\$component_help,\$faq, + \$bug,\$origurl) { + $$datum = &escape($$datum); } if (!$stayOnPage) { $link = "javascript:helpMenu('open')"; @@ -772,7 +789,7 @@ ENDTEMPLATE $width,$height).' '.$template; } else { my $help_text; - $help_text=&Apache::lonnet::unescape($topic); + $help_text=&unescape($topic); $template=' ENDROLE - my $titleinfo = ''.$title.''; - if ($customtitle) { - $titleinfo = $customtitle; - } + my $titleinfo = ''.$title.''; + if ($customtitle) { + $titleinfo = $customtitle; + } + # + # Extra info if you are the DC + my $dc_info = ''; + if ($env{'user.adv'} && exists($env{'user.role.dc./'. + $env{'course.'.$env{'request.course.id'}. + '.domain'}.'/'})) { + my $cid = $env{'request.course.id'}; + $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'}; + $dc_info = '('.$dc_info.')'; + } + + if ($env{'environment.remote'} eq 'off') { + # No Remote if ($env{'request.state'} eq 'construct') { + $forcereg=1; + } + + if (!$customtitle && $env{'request.state'} eq 'construct') { + # this is for resources; directories have customtitle, and crumbs + # and select recent are created in lonpubdir.pm my ($uname,$thisdisfn)= ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|); my $formaction='/priv/'.$uname.'/'.$thisdisfn; $formaction=~s/\/+/\//g; - unless ($customtitle) { #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm - my $parentpath = ''; - my $lastitem = ''; - if ($thisdisfn =~ m-(.+/)([^/]*)$-) { - $parentpath = $1; - $lastitem = $2; - } else { - $lastitem = $thisdisfn; - } - $titleinfo = &Apache::loncommon::help_open_menu('','','','',3,'Authoring'). - 'Construction Space: '. - '' - .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."$lastitem
" - .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()') - .'' - .&Apache::lonmenu::constspaceform(); - } - $forcereg=1; + my $parentpath = ''; + my $lastitem = ''; + if ($thisdisfn =~ m-(.+/)([^/]*)$-) { + $parentpath = $1; + $lastitem = $2; + } else { + $lastitem = $thisdisfn; + } + $titleinfo = + &Apache::loncommon::help_open_menu('','','','',3,'Authoring'). + 'Construction Space: '. + '' + .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."$lastitem
" + .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()') + .'' + .&Apache::lonmenu::constspaceform(); } + my $titletable; - if (!$hidetitle) { + if (!$notitle) { $titletable = - '
'. &help_open_topic($component_help,$help_text,$stayOnPage, $width,$height).''.$template. @@ -800,7 +817,7 @@ sub help_open_bug { my $link=''; my $template=''; my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='. - &Apache::lonnet::escape($ENV{'REQUEST_URI'}).'&component='.$topic; + &escape($ENV{'REQUEST_URI'}).'&component='.$topic; if (!$stayOnPage) { $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))"; @@ -1151,8 +1168,8 @@ sub get_domains { # The code below was stolen from "The Perl Cookbook", p 102, 1st ed. my @domains; my %seen; - foreach (sort values(%Apache::lonnet::hostdom)) { - push (@domains,$_) unless $seen{$_}++; + foreach my $dom (sort(values(%Apache::lonnet::hostdom))) { + push(@domains,$dom) unless $seen{$dom}++; } return @domains; } @@ -1206,7 +1223,7 @@ sub multiple_select_form { my @order = ref($order) ? @$order : sort(keys(%$hash)); foreach my $key (@order) { - $output.='\n"; } @@ -1236,10 +1253,11 @@ sub select_form { } else { @keys=sort(keys(%hash)); } - foreach (@keys) { - $selectform.="\n"; + foreach my $key (@keys) { + $selectform.= + '\n"; } $selectform.=""; return $selectform; @@ -1303,10 +1321,10 @@ sub select_dom_form { my @domains = get_domains(); if ($includeempty) { @domains=('',@domains); } my $selectdomain = ""; return $selectdomain; @@ -1328,9 +1346,9 @@ given $domain. sub get_library_servers { my $domain = shift; my %library_servers; - foreach (keys(%Apache::lonnet::libserv)) { - if ($Apache::lonnet::hostdom{$_} eq $domain) { - $library_servers{$_} = $Apache::lonnet::hostname{$_}; + foreach my $hostid (keys(%Apache::lonnet::libserv)) { + if ($Apache::lonnet::hostdom{$hostid} eq $domain) { + $library_servers{$hostid} = $Apache::lonnet::hostname{$hostid}; } } return %library_servers; @@ -1352,9 +1370,10 @@ sub home_server_option_list { my $domain = shift; my %servers = &get_library_servers($domain); my $result = ''; - foreach (sort keys(%servers)) { + foreach my $hostid (sort(keys(%servers))) { $result.= - '\n"; + '\n"; } return $result; } @@ -1844,8 +1863,8 @@ sub initialize_keywords { } untie %thesaurus_db; # Remove special values from %Keywords. - foreach ('total.count','average.count') { - delete($Keywords{$_}) if (exists($Keywords{$_})); + foreach my $value ('total.count','average.count') { + delete($Keywords{$value}) if (exists($Keywords{$value})); } return 1; } @@ -1901,11 +1920,11 @@ sub get_related_words { } my @Words=(); if (exists($thesaurus_db{$keyword})) { - $_ = $thesaurus_db{$keyword}; - (undef,@Words) = split/:/; # The first element is the number of times - # the word appears. We do not need it now. + # The first element is the number of times + # the word appears. We do not need it now. + (undef,@Words) = (split(/:/,$thesaurus_db{$keyword})); for (my $i=0;$i<=$#Words;$i++) { - ($Words[$i],undef)= split/\,/,$Words[$i]; + ($Words[$i],undef)= split(/\,/,$Words[$i]); } } untie %thesaurus_db; @@ -1946,7 +1965,7 @@ sub plainname { $name=~s/^\s+//; $name=~s/\s+$//; $name=~s/\s+/ /g; - if ($name !~ /\S/) { $name=$uname.'@'.$udom; } + if ($name !~ /\S/) { $name=$uname.':'.$udom; } return $name; } @@ -2019,10 +2038,11 @@ sub screenname { # ------------------------------------------------------------- Message Wrapper sub messagewrapper { - my ($link,$username,$domain)=@_; + my ($link,$username,$domain,$subject,$text)=@_; return ''.$link.''; } # --------------------------------------------------------------- Notes Wrapper @@ -2182,7 +2202,8 @@ category =cut sub filecategorytypes { - return @{$category_extensions{lc($_[0])}}; + my ($cat) = @_; + return @{$category_extensions{lc($cat)}}; } =pod @@ -2197,6 +2218,10 @@ sub fileembstyle { return $fe{lc(shift(@_))}; } +sub filemimetype { + return $fm{lc(shift(@_))}; +} + sub filecategoryselect { my ($name,$value)=@_; @@ -2253,13 +2278,13 @@ sub fileextensions { sub display_languages { my %languages=(); - foreach (&preferred_languages()) { - $languages{$_}=1; + foreach my $lang (&preferred_languages()) { + $languages{$lang}=1; } &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']); if ($env{'form.displaylanguage'}) { - foreach (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) { - $languages{$_}=1; + foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) { + $languages{$lang}=1; } } return %languages; @@ -2294,11 +2319,11 @@ sub preferred_languages { } # turn "en-ca" into "en-ca,en" my @genlanguages; - foreach (@languages) { - unless ($_=~/\w/) { next; } - push (@genlanguages,$_); - if ($_=~/(\-|\_)/) { - push (@genlanguages,(split(/(\-|\_)/,$_))[0]); + foreach my $lang (@languages) { + unless ($lang=~/\w/) { next; } + push (@genlanguages,$lang); + if ($lang=~/(\-|\_)/) { + push(@genlanguages,(split(/(\-|\_)/,$lang))[0]); } } return @genlanguages; @@ -2354,14 +2379,14 @@ sub get_previous_attempt { my %lasthash=(); my $version; for ($version=1;$version<=$returnhash{'version'};$version++) { - foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) { - $lasthash{$_}=$returnhash{$version.':'.$_}; + foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) { + $lasthash{$key}=$returnhash{$version.':'.$key}; } } $prevattempts='
'; $prevattempts.=''; - foreach (sort(keys %lasthash)) { - my ($ign,@parts) = split(/\./,$_); + foreach my $key (sort(keys(%lasthash))) { + my ($ign,@parts) = split(/\./,$key); if ($#parts > 0) { my $data=$parts[-1]; pop(@parts); @@ -2377,27 +2402,27 @@ sub get_previous_attempt { if ($getattempt eq '') { for ($version=1;$version<=$returnhash{'version'};$version++) { $prevattempts.=''; - foreach (sort(keys %lasthash)) { + foreach my $key (sort(keys(%lasthash))) { my $value; - if ($_ =~ /timestamp/) { - $value=scalar(localtime($returnhash{$version.':'.$_})); + if ($key =~ /timestamp/) { + $value=scalar(localtime($returnhash{$version.':'.$key})); } else { - $value=$returnhash{$version.':'.$_}; + $value=$returnhash{$version.':'.$key}; } - $prevattempts.=''; + $prevattempts.=''; } } } $prevattempts.=''; - foreach (sort(keys %lasthash)) { + foreach my $key (sort(keys(%lasthash))) { my $value; - if ($_ =~ /timestamp/) { - $value=scalar(localtime($lasthash{$_})); + if ($key =~ /timestamp/) { + $value=scalar(localtime($lasthash{$key})); } else { - $value=$lasthash{$_}; + $value=$lasthash{$key}; } - $value=&Apache::lonnet::unescape($value); - if ($_ =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)} + $value=&unescape($value); + if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)} $prevattempts.=''; } $prevattempts.='
History
Transaction '.$version.''.&Apache::lonnet::unescape($value).' '.&unescape($value).' 
Current'.$value.' 
'; @@ -2429,14 +2454,14 @@ sub relative_to_absolute { } } $thisdir=~s-/[^/]*$--; - foreach (@rlinks) { - unless (($_=~/^http:\/\//i) || - ($_=~/^\//) || - ($_=~/^javascript:/i) || - ($_=~/^mailto:/i) || - ($_=~/^\#/)) { - my $newlocation=&Apache::lonnet::hreflocation($thisdir,$_); - $output=~s/(\"|\'|\=\s*)$_(\"|\'|\s|\>)/$1$newlocation$2/; + foreach my $link (@rlinks) { + unless (($link=~/^http:\/\//i) || + ($link=~/^\//) || + ($link=~/^javascript:/i) || + ($link=~/^mailto:/i) || + ($link=~/^\#/)) { + my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link); + $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/; } } # -------------------------------------------------- Deal with Applet codebases @@ -2518,7 +2543,7 @@ sub submlink { if (!$symb) { $symb=$cursymb; } } if (!$symb) { $symb=&Apache::lonnet::symbread(); } - $symb=&Apache::lonnet::escape($symb); + $symb=&escape($symb); if ($target) { $target="target=\"$target\""; } return ' 1 } @{$roles}; } + my %courses; my $now=time; - foreach (keys %env) { - if ($_=~/^user\.role\.\w+\.\/(\w+)\/(\w+)/) { - my ($starttime,$endtime)=$env{$_}; + foreach my $key (keys(%env)) { + if ( $key=~m{^user\.role\.(\w+)\./(\w+)/(\w+)} ) { + my ($role,$domain,$id) = ($1,$2,$3); + next if ($role eq 'ca' || $role eq 'aa'); + next if (%roles && !exists($roles{$role})); + my ($starttime,$endtime)=split(/\./,$env{$key}); my $active=1; if ($starttime) { if ($now<$starttime) { $active=0; } @@ -2616,10 +2652,10 @@ sub findallcourses { if ($endtime) { if ($now>$endtime) { $active=0; } } - if ($active) { $courses{$1.'_'.$2}=1; } + if ($active) { $courses{$domain.'_'.$id}=1; } } } - return keys %courses; + return keys(%courses); } ############################################### @@ -2753,7 +2789,13 @@ Inputs: =item * $notopbar, if true, keep the 'what is this' info but remove the navigational links -=item * $bgcolor, used to override the bg coor on a webpage to a specific value +=item * $bgcolor, used to override the bgcolor on a webpage to a specific value + +=item * $notitle, if true keep the nav controls, but remove the title bar + +=item * $no_inline_link, if true and in remote mode, don't show the + 'Switch To Inline Menu' link + =back @@ -2766,31 +2808,39 @@ other decorations will be returned. sub bodytag { my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle, - $notopbar,$bgcolor,$hidetitle)=@_; + $notopbar,$bgcolor,$notitle,$no_inline_link)=@_; + $title=&mt($title); + $function = &get_users_function() if (!$function); - my $img=&designparm($function.'.img',$domain); - my $pgbg= $bgcolor || &designparm($function.'.pgbg',$domain); - my $tabbg=&designparm($function.'.tabbg',$domain); - my $font=&designparm($function.'.font',$domain); - my $link=&designparm($function.'.link',$domain); - my $alink=&designparm($function.'.alink',$domain); - my $vlink=&designparm($function.'.vlink',$domain); - my $sidebg=&designparm($function.'.sidebg',$domain); -# Accessibility font enhance - my $addstyle=''; - if ($env{'browser.fontenhance'} eq 'on') { - $addstyle=' font-size: x-large;'; - } + my $img = &designparm($function.'.img',$domain); + my $font = &designparm($function.'.font',$domain); + my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain); + + my %design = ( 'style' => 'margin-top: 0px', + 'bgcolor' => $pgbg, + 'text' => $font, + 'alink' => &designparm($function.'.alink',$domain), + 'vlink' => &designparm($function.'.vlink',$domain), + 'link' => &designparm($function.'.link',$domain),); + @$addentries{keys(%design)} = @design{keys(%design)}; + # role and realm - my ($role,$realm) - =&Apache::lonnet::plaintext((split(/\./,$env{'request.role'}))[0]); + my ($role,$realm) = split(/\./,$env{'request.role'},2); + if ($role eq 'ca') { + my ($rdom,$rname) = ($realm =~ m-^/(\w+)/(\w+)$-); + $realm = &plainname($rname,$rdom).':'.$rdom; + } # realm if ($env{'request.course.id'}) { - $realm= - $env{'course.'.$env{'request.course.id'}.'.description'}; + if ($env{'request.role'} !~ /^cr/) { + $role = &Apache::lonnet::plaintext($role,&course_type()); + } + $realm = $env{'course.'.$env{'request.course.id'}.'.description'}; + } else { + $role = &Apache::lonnet::plaintext($role); } - unless ($realm) { $realm=' '; } + if (!$realm) { $realm=' '; } # Set messages my $messages=&domainlogo($domain); # Port for miniserver @@ -2800,24 +2850,9 @@ sub bodytag { my $extra_body_attr = &make_attr_string($forcereg,$addentries); # construct main body tag - my $bodytag = < -h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif } -a:focus { color: red; background: yellow } -table.thinborder { border-collapse: collapse; } -table.thinborder tr th, table.thinborder tr td { border-style: solid; border-width: 1px} -form, .inline { display: inline; } -.center { text-align: center; } -.filename {font-family: monospace;} - - -END + my $bodytag = "". + &Apache::lontexconvert::init_math_support(); - $bodytag .= &Apache::lontexconvert::init_math_support(); - - my $upperleft=''.$function.''; if ($bodyonly || ($env{'request.state'} eq 'construct' && $env{'environment.remote'} ne 'off' )) { @@ -2826,79 +2861,96 @@ END # Accessibility $bodytag.=&Apache::lonmenu::menubuttons($forcereg,$forcereg); - if (!$hidetitle) { + if (!$notitle) { $bodytag.='

LON-CAPA: '.$title.'

'; } return $bodytag; - } elsif ($env{'environment.remote'} eq 'off') { -# No Remote - my $roleinfo=(< - + } + + + + my $roleinfo=(< +
$env{'environment.firstname'} $env{'environment.middlename'} $env{'environment.lastname'} $env{'environment.generation'} -   -
-$role  -
-$realm  +   +
+
+$role  +
+
+$realm  +
'. - ''.$roleinfo.'
'. - $titleinfo.'
'; + ''. + "".$roleinfo. + '
$titleinfo $dc_info
'; } - if ($env{'request.state'} eq 'construct') { - if ($notopbar) { - $bodytag .= $titletable; - } else { + if ($notopbar) { + $bodytag .= $titletable; + } else { + if ($env{'request.state'} eq 'construct') { $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg, $titletable); - } - } else { - if ($notopbar) { - $bodytag .= $titletable; } else { $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg). - $titletable; + $titletable; } } return $bodytag; @@ -2907,51 +2959,27 @@ ENDROLE # # Top frame rendering, Remote is up # - my $titleinfo = ' '.$title.''; - if ($customtitle) { - $titleinfo = $customtitle; - } - # - # Extra info if you are the DC - my $dc_info = ''; - if ($env{'user.adv'} && exists($env{'user.role.dc./'. - $env{'course.'.$env{'request.course.id'}. - '.domain'}.'/'})) { - my $cid = $env{'request.course.id'}; - $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'}; - $dc_info = '('.$dc_info.')'; - } + + my $upperleft=''.$function.''; + # Explicit link to get inline menu - my $menu='
 '.&mt('Switch to Inline Menu Mode').''; + my $menu= ($no_inline_link?'' + :'
'.&mt('Switch to Inline Menu Mode').''); # - if ($hidetitle) { + if ($notitle) { return $bodytag; } return(< - -$upperleft -$messages  + + + - - + +$roleinfo - - - -
-$titleinfo $dc_info $menu - - - $env{'environment.firstname'} - $env{'environment.middlename'} - $env{'environment.lastname'} - $env{'environment.generation'} -   -
$titleinfo $dc_info $menu
-$role  -
$realm 

+ ENDBODY } @@ -2965,11 +2993,44 @@ sub make_attr_string { } if ($register) { - $attr_ref->{'onload'} = &Apache::lonmenu::loadevents(). - $attr_ref->{'onload'}; - $attr_ref->{'onunload'} = &Apache::lonmenu::unloadevents(). - $attr_ref->{'onunload'}; + my ($on_load,$on_unload); + foreach my $key (keys(%{$attr_ref})) { + if (lc($key) eq 'onload') { + $on_load.=$attr_ref->{$key}.';'; + delete($attr_ref->{$key}); + + } elsif (lc($key) eq 'onunload') { + $on_unload.=$attr_ref->{$key}.';'; + delete($attr_ref->{$key}); + } + } + $attr_ref->{'onload'} = + &Apache::lonmenu::loadevents(). $on_load; + $attr_ref->{'onunload'}= + &Apache::lonmenu::unloadevents().$on_unload; + } + +# Accessibility font enhance + if ($env{'browser.fontenhance'} eq 'on') { + my $style; + foreach my $key (keys(%{$attr_ref})) { + if (lc($key) eq 'style') { + $style.=$attr_ref->{$key}.';'; + delete($attr_ref->{$key}); + } + } + $attr_ref->{'style'}=$style.'; font-size: x-large;'; } + + if ($env{'browser.blackwhite'} eq 'on') { + delete($attr_ref->{'font'}); + delete($attr_ref->{'link'}); + delete($attr_ref->{'alink'}); + delete($attr_ref->{'vlink'}); + delete($attr_ref->{'bgcolor'}); + delete($attr_ref->{'background'}); + } + my $attr_string; foreach my $attr (keys(%$attr_ref)) { $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" '; @@ -3015,6 +3076,236 @@ sub endbodytag { =over 4 +=item * &standard_css() + +Returns a style sheet + +Inputs: (all optional) + domain -> force to color decorate a page for a specific + domain + function -> force usage of a specific rolish color scheme + bgcolor -> override the default page bgcolor + +=back + +=cut + +sub standard_css { + my ($function,$domain,$bgcolor) = @_; + $function = &get_users_function() if (!$function); + my $img = &designparm($function.'.img', $domain); + my $tabbg = &designparm($function.'.tabbg', $domain); + my $font = &designparm($function.'.font', $domain); + my $sidebg = &designparm($function.'.sidebg',$domain); + my $pgbg = $bgcolor || + &designparm($function.'.pgbg', $domain); + my $alink = &designparm($function.'.alink', $domain); + my $vlink = &designparm($function.'.vlink', $domain); + my $link = &designparm($function.'.link', $domain); + + my $sans = 'Arial,Helvetica,sans-serif'; + my $data_table_head = $tabbg; + my $data_table_light = '#EEEEEE'; + my $data_table_dark = '#DDD'; + my $data_table_highlight = '#FFFF00'; + my $mail_new = '#FFBB77'; + my $mail_new_hover = '#DD9955'; + my $mail_read = '#BBBB77'; + my $mail_read_hover = '#999944'; + my $mail_replied = '#AAAA88'; + my $mail_replied_hover = '#888855'; + my $mail_other = '#99BBBB'; + my $mail_other_hover = '#669999'; + + return < array ref of seconds before redirect occurs url to redirect to (side effect of setting $env{'internal.head.redirect'} to the url redirected too) + domain -> force to color decorate a page for a specific + domain + function -> force usage of a specific rolish color scheme + bgcolor -> override the default page bgcolor + =back =cut @@ -3036,9 +3332,19 @@ Inputs: $title - optional title for the sub headtag { my ($title,$head_extra,$args) = @_; + my $function = $args->{'function'} || &get_users_function(); + my $domain = $args->{'domain'} || &determinedomain(); + my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain); + my $url = join(':',$env{'user.name'},$env{'user.domain'}, + $env{'environment.color.timestamp'}, + $function,$domain,$bgcolor); + + $url = '/adm/css/'.&escape($url).'.css'; + my $result = ''. - &Apache::lonxml::fontsettings(). + ''. + &font_settings(). &Apache::lonhtmlcommon::htmlareaheaders(); if ($args->{'force_register'}) { @@ -3051,7 +3357,7 @@ sub headtag { $env{'internal.head.redirect'} = $url; $result.=< - + ADDMETA } if (!defined($title)) { @@ -3066,6 +3372,66 @@ ADDMETA =over 4 +=item * &font_settings() + +Returns neccessary to set the proper encoding + +Inputs: none + +=back + +=cut + +sub font_settings { + my $headerstring=''; + if (($env{'browser.os'} eq 'mac') && (!$env{'browser.mathml'})) { + $headerstring.= + ''; + } elsif (!$env{'browser.mathml'} && $env{'browser.unicode'}) { + $headerstring.= + ''; + } + return $headerstring; +} + +=pod + +=over 4 + +=item * &xml_begin() + +Returns the needed doctype and + +Inputs: none + +=back + +=cut + +sub xml_begin { + my $output=''; + + &Apache::lonhtmlcommon::init_htmlareafields(); + + if ($env{'browser.mathml'}) { + $output='' + #.''."\n" +# .'] >' + .'' + .''; + } else { + $output=''; + } + return $output; +} + +=pod + +=over 4 + =item * &endheadtag() Returns a uniform for LON-CAPA web pages. @@ -3131,6 +3497,13 @@ Inputs: $title - optional title for the is not auto translated like the $title is frameset -> if true will start with a rather than + no_title -> if true the title bar won't be shown + skip_phases -> hash ref of + head -> skip the generation + body -> skip all generation + + no_inline_link -> if true and in remote mode, don't show the + 'Switch To Inline Menu' link =back @@ -3140,28 +3513,37 @@ sub start_page { my ($title,$head_extra,$args) = @_; #&Apache::lonnet::logthis("start_page ".join(':',caller(0))); my %head_args; - foreach my $arg ('redirect','force_register') { + foreach my $arg ('redirect','force_register','domain','function', + 'bgcolor') { if (defined($args->{$arg})) { $head_args{$arg} = $args->{$arg}; } } $env{'internal.start_page'}++; - my $result = - &Apache::lonxml::xmlbegin(). - &headtag($title,$head_extra,\%head_args).&endheadtag(); - if ($args->{'frameset'}) { - my $attr_string = &make_attr_string($args->{'force_register'}, - $args->{'add_entries'}); - $result .= "\n\n"; - } else { - $result .= - &bodytag($title, - $args->{'function'}, $args->{'add_entries'}, - $args->{'only_body'}, $args->{'domain'}, - $args->{'force_register'}, $args->{'body_title'}, - $args->{'no_nav_bar'}, $args->{'bgcolor'}); + my $result; + if (! exists($args->{'skip_phases'}{'head'}) ) { + $result.= + &xml_begin(). + &headtag($title,$head_extra,\%head_args).&endheadtag(); + } + + if (! exists($args->{'skip_phases'}{'body'}) ) { + if ($args->{'frameset'}) { + my $attr_string = &make_attr_string($args->{'force_register'}, + $args->{'add_entries'}); + $result .= "\n\n"; + } else { + $result .= + &bodytag($title, + $args->{'function'}, $args->{'add_entries'}, + $args->{'only_body'}, $args->{'domain'}, + $args->{'force_register'}, $args->{'body_title'}, + $args->{'no_nav_bar'}, $args->{'bgcolor'}, + $args->{'no_title'}, $args->{'no_inline_link'}); + } } + if ($args->{'js_ready'}) { $result = &js_ready($result); } @@ -3193,7 +3575,6 @@ Inputs: $args - additional optio sub end_page { my ($args) = @_; - #&Apache::lonnet::logthis("end_page ".join(':',caller(0))); $env{'internal.end_page'}++; my $result; if ($args->{'discussion'}) { @@ -3236,7 +3617,7 @@ sub js_ready { $result =~ s/[\n\r]/ /xmsg; $result =~ s/\\/\\\\/xmsg; $result =~ s/'/\\'/xmsg; - $result =~ s{}{}xmsg; + $result =~ s{'; + } + + sub end_data_table { + undef($row_count); + return ''; + } + + sub start_data_table_row { + $row_count++; + return ''; + } + + sub end_data_table_row { + return ''; + } + + sub start_data_table_header_row { + return ''; + } + + sub end_data_table_header_row { + return ''; + } +} + ############################################### =pod @@ -3318,7 +3730,7 @@ specific user. Roles can be active, prev Inputs: user's domain, user's username, course's domain, -course's number, optional section/group. +course's number, optional section ID. Outputs: role status: active, previous or future. @@ -3369,32 +3781,40 @@ sub check_user_status { Determines all the sections for a course including sections with students and sections containing other roles. -Incoming parameters: domain, course number, reference to -section hash (keys to be section/group IDs), reference to -array containing roles for which sections should be gathered -(optional). If the fourth argument is undefined, sections -are gathered for any role. +Incoming parameters: domain, course number, +reference to array containing roles for which sections should +be gathered (optional). If the third argument is undefined, +sections are gathered for any role. -Returns number of sections. +Returns section hash (keys are section IDs, values are +number of users in each section), subject to the +optional roles filter. =cut ############################################### sub get_sections { - my ($cdom,$cnum,$sectioncount,$possible_roles) = @_; - if (!($cdom && $cnum)) { return 0; } - my $numsections = 0; + my ($cdom,$cnum,$possible_roles) = @_; + if (!defined($cdom) || !defined($cnum)) { + my $cid = $env{'request.course.id'}; + + return if (!defined($cid)); - if (!defined($possible_roles) || (grep/^st$/,@$possible_roles)) { + $cdom = $env{'course.'.$cid.'.domain'}; + $cnum = $env{'course.'.$cid.'.num'}; + } + + my %sectioncount; + + if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) { my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum); my $sec_index = &Apache::loncoursedata::CL_SECTION(); my $status_index = &Apache::loncoursedata::CL_STATUS(); - while (my ($student,$data) = each %$classlist) { + while (my ($student,$data) = each(%$classlist)) { my ($section,$status) = ($data->[$sec_index], $data->[$status_index]); unless ($section eq '-1' || $section =~ /^\s*$/) { - if (!defined($$sectioncount{$section})) { $numsections++; } - $$sectioncount{$section}++; + $sectioncount{$section}++; } } } @@ -3410,157 +3830,9 @@ sub get_sections { } if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; } if (!defined($section) || $section eq '-1') { next; } - if (!defined($$sectioncount{$section})) { $numsections++; } - $$sectioncount{$section}++; - } - return $numsections; -} - -############################################### - -=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}); + $sectioncount{$section}++; } - 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; + return %sectioncount; } ############################################### @@ -3714,9 +3986,9 @@ will result in $env{'form.uname'} and $e sub get_unprocessed_cgi { my ($query,$possible_names)= @_; # $Apache::lonxml::debug=1; - foreach (split(/&/,$query)) { - my ($name, $value) = split(/=/,$_); - $name = &Apache::lonnet::unescape($name); + foreach my $pair (split(/&/,$query)) { + my ($name, $value) = split(/=/,$pair); + $name = &unescape($name); if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) { $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; @@ -3932,8 +4204,7 @@ sub record_sep { if ($env{'form.upfiletype'} eq 'xml') { } elsif ($env{'form.upfiletype'} eq 'space') { my $i=0; - foreach (split(/\s+/,$record)) { - my $field=$_; + foreach my $field (split(/\s+/,$record)) { $field=~s/^(\"|\')//; $field=~s/(\"|\')$//; $components{&takeleft($i)}=$field; @@ -3941,8 +4212,7 @@ sub record_sep { } } elsif ($env{'form.upfiletype'} eq 'tab') { my $i=0; - foreach (split(/\t/,$record)) { - my $field=$_; + foreach my $field (split(/\t/,$record)) { $field=~s/^(\"|\')//; $field=~s/(\"|\')$//; $components{&takeleft($i)}=$field; @@ -4036,14 +4306,14 @@ sub csv_print_samples { my $samples = &get_samples($records,3); $r->print(&mt('Samples').'
'); - foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) { - $r->print(''); } + foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { + $r->print(''); } $r->print(''); foreach my $hash (@$samples) { $r->print(''); - foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) { + foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { $r->print(''); } $r->print(''); @@ -4076,17 +4346,17 @@ sub csv_print_select_table { '
'.&mt('Column [_1]',($_+1)).''.&mt('Column [_1]',($sample+1)).'
'); - if (defined($$hash{$_})) { $r->print($$hash{$_}); } + if (defined($$hash{$sample})) { $r->print($$hash{$sample}); } $r->print('
'. ''. ''."\n"); - foreach (@$d) { - my ($value,$display,$defaultcol)=@{ $_ }; + foreach my $array_ref (@$d) { + my ($value,$display,$defaultcol)=@{ $array_ref }; $r->print(''); $r->print(''."\n"); $i++; @@ -4347,9 +4617,9 @@ sub DrawBarGraph { $Title = '' if (! defined($Title)); $xlabel = '' if (! defined($xlabel)); $ylabel = '' if (! defined($ylabel)); - $ValuesHash{$id.'.title'} = &Apache::lonnet::escape($Title); - $ValuesHash{$id.'.xlabel'} = &Apache::lonnet::escape($xlabel); - $ValuesHash{$id.'.ylabel'} = &Apache::lonnet::escape($ylabel); + $ValuesHash{$id.'.title'} = &escape($Title); + $ValuesHash{$id.'.xlabel'} = &escape($xlabel); + $ValuesHash{$id.'.ylabel'} = &escape($ylabel); $ValuesHash{$id.'.y_max_value'} = $Max; $ValuesHash{$id.'.NumBars'} = $NumBars; $ValuesHash{$id.'.NumSets'} = $NumSets; @@ -4429,9 +4699,9 @@ sub DrawXYGraph { $ylabel = '' if (! defined($ylabel)); my %ValuesHash = ( - $id.'.title' => &Apache::lonnet::escape($Title), - $id.'.xlabel' => &Apache::lonnet::escape($xlabel), - $id.'.ylabel' => &Apache::lonnet::escape($ylabel), + $id.'.title' => &escape($Title), + $id.'.xlabel' => &escape($xlabel), + $id.'.ylabel' => &escape($ylabel), $id.'.y_max_value'=> $Max, $id.'.labels' => join(',',@$Xlabels), $id.'.PlotType' => 'XY', @@ -4526,9 +4796,9 @@ sub DrawXYYGraph { $ylabel = '' if (! defined($ylabel)); my %ValuesHash = ( - $id.'.title' => &Apache::lonnet::escape($Title), - $id.'.xlabel' => &Apache::lonnet::escape($xlabel), - $id.'.ylabel' => &Apache::lonnet::escape($ylabel), + $id.'.title' => &escape($Title), + $id.'.xlabel' => &escape($xlabel), + $id.'.ylabel' => &escape($ylabel), $id.'.labels' => join(',',@$Xlabels), $id.'.PlotType' => 'XY', $id.'.NumSets' => 2, @@ -4600,7 +4870,7 @@ Inputs: sub chartlink { my ($linktext, $sname, $sdomain) = @_; my $link = ''.$linktext.''; } @@ -4630,6 +4900,7 @@ a hash ref describing the data to be sto 'chartoutputmode' => 'scalar', 'chartoutputdata' => 'scalar', 'Section' => 'array', + 'Group' => 'array', 'StudentData' => 'array', 'Maps' => 'array'); @@ -4663,11 +4934,11 @@ sub store_course_settings { if (ref($env{'form.'.$setting})) { $stored_form = join(',', map { - &Apache::lonnet::escape($_); + &escape($_); } sort(@{$env{'form.'.$setting}})); } else { $stored_form = - &Apache::lonnet::escape($env{'form.'.$setting}); + &escape($env{'form.'.$setting}); } # Determine if the array contents are the same. if ($stored_form ne $env{$envname}) { @@ -4701,7 +4972,7 @@ sub restore_course_settings { } elsif ($type eq 'array') { $env{'form.'.$setting} = [ map { - &Apache::lonnet::unescape($_); + &unescape($_); } split(',',$env{$envname}) ]; } @@ -4712,15 +4983,17 @@ sub restore_course_settings { ############################################################ ############################################################ -sub propath { - my ($udom,$uname)=@_; - $udom=~s/\W//g; - $uname=~s/\W//g; - my $subdir=$uname.'__'; - $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; - my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; - return $proname; -} +sub course_type { + my ($cid) = @_; + if (!defined($cid)) { + $cid = $env{'request.course.id'}; + } + if (defined($env{'course.'.$cid.'type'})) { + return $env{'course.'.$cid.'type'}; + } else { + return 'Course'; + } +} sub icon { my ($file)=@_; @@ -4774,7 +5047,7 @@ sub escape_double { sub escape_url { my ($url) = @_; my @urlslices = split(/\//, $url,-1); - my $lastitem = &Apache::lonnet::escape(pop(@urlslices)); + my $lastitem = &escape(pop(@urlslices)); return join('/',@urlslices).'/'.$lastitem; } =pod
'.&mt('Attribute').''.&mt('Column').'
'.$display.'