--- loncom/interface/loncommon.pm 2006/09/05 20:42:18 1.449
+++ loncom/interface/loncommon.pm 2007/06/27 22:43:28 1.539
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.449 2006/09/05 20:42:18 albertel Exp $
+# $Id: loncommon.pm,v 1.539 2007/06/27 22:43:28 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -59,16 +59,21 @@ use Apache::lonnet;
use GDBM_File;
use POSIX qw(strftime mktime);
use Apache::lonmenu();
+use Apache::lonenc();
use Apache::lonlocal;
use HTML::Entities;
use Apache::lonhtmlcommon();
use Apache::loncoursedata();
use Apache::lontexconvert();
use Apache::lonclonecourse();
-use LONCAPA;
+use LONCAPA qw(:DEFAULT :match);
+
+# ---------------------------------------------- Designs
+use vars qw(%defaultdesign);
my $readit;
+
##
## Global Variables
##
@@ -81,10 +86,6 @@ my %scprtag;
my %fe; my %fd; my %fm;
my %category_extensions;
-# ---------------------------------------------- Designs
-
-my %designhash;
-
# ---------------------------------------------- Thesaurus variables
#
# %Keywords:
@@ -150,30 +151,18 @@ BEGIN {
}
}
-# -------------------------------------------------------------- domain designs
-
- my $filename;
+# -------------------------------------------------------------- default domain designs
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
- opendir(DIR,$designdir);
- while ($filename=readdir(DIR)) {
- if ($filename!~/\.tab$/) { next; }
- my ($domain)=($filename=~/^(\w+)\./);
- {
- my $designfile = $designdir.'/'.$filename;
- if ( open (my $fh,"<$designfile") ) {
- while (my $line = <$fh>) {
- next if ($line =~ /^\#/);
- chomp($line);
- my ($key,$val)=(split(/\=/,$line));
- if ($val) { $designhash{$domain.'.'.$key}=$val; }
- }
- close($fh);
- }
- }
-
+ my $designfile = $designdir.'/default.tab';
+ if ( open (my $fh,"<$designfile") ) {
+ while (my $line = <$fh>) {
+ next if ($line =~ /^\#/);
+ chomp($line);
+ my ($key,$val)=(split(/\=/,$line));
+ if ($val) { $defaultdesign{$key}=$val; }
+ }
+ close($fh);
}
- closedir(DIR);
-
# ------------------------------------------------------------- file categories
{
@@ -251,13 +240,13 @@ Inputs: formname, elementname
formname and elementname specify the name of the html form and the name
of the element the selection from the search results will be placed in.
-
+=back
=cut
sub browser_and_searcher_javascript {
my ($mode)=@_;
if (!defined($mode)) { $mode='edit'; }
- my $resurl=&lastresurl();
+ my $resurl=&escape_single(&lastresurl());
return <<END;
// <!-- BEGIN LON-CAPA Internal
var editbrowser = null;
@@ -386,20 +375,27 @@ sub selectstudent_link {
}
sub coursebrowser_javascript {
- my ($domainfilter)=@_;
+ my ($domainfilter,$sec_element,$formname)=@_;
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 (<<ENDSTDBRW);
-<script type="text/javascript" language="Javascript" >
- var stdeditbrowser;
+ my $output = '
+<script type="text/javascript">
+ var stdeditbrowser;'."\n";
+ $output .= <<"ENDSTDBRW";
function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,crstype) {
var url = '/adm/pickcourse?';
- var filter;
- if (filter != null) {
- if (filter != '') {
- url += 'filter='+filter+'&';
- }
+ var domainfilter = '';
+ var formid = getFormIdByName(formname);
+ if (formid > -1) {
+ var domid = getIndexByName(formid,udom);
+ if (domid > -1) {
+ if (document.forms[formid].elements[domid].type == 'select-one') {
+ domainfilter=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
+ }
+ if (document.forms[formid].elements[domid].type == 'hidden') {
+ domainfilter=document.forms[formid].elements[domid].value;
+ }
+ }
}
- var domainfilter='$domainfilter';
if (domainfilter != null) {
if (domainfilter != '') {
url += 'domainfilter='+domainfilter+'&';
@@ -408,11 +404,18 @@ sub coursebrowser_javascript {
url += 'form=' + formname + '&cnumelement='+uname+
'&cdomelement='+udom+
'&cnameelement='+desc;
- if (extra_element !=null && extra_element != '' && formname == 'rolechoice') {
- url += '&roleelement='+extra_element;
- if (domainfilter == null || domainfilter == '') {
- url += '&domainfilter='+extra_element;
+ if (extra_element !=null && extra_element != '') {
+ if (formname == 'rolechoice') {
+ url += '&roleelement='+extra_element;
+ if (domainfilter == null || domainfilter == '') {
+ url += '&domainfilter='+extra_element;
+ }
}
+ else {
+ if (formname == 'portform') {
+ url += '&setroles='+extra_element;
+ }
+ }
}
if (multflag !=null && multflag != '') {
url += '&multiple='+multflag;
@@ -435,14 +438,74 @@ sub coursebrowser_javascript {
stdeditbrowser = open(url,title,options,'1');
stdeditbrowser.focus();
}
-</script>
+
+ function getFormIdByName(formname) {
+ for (var i=0;i<document.forms.length;i++) {
+ if (document.forms[i].name == formname) {
+ return i;
+ }
+ }
+ return -1;
+ }
+
+ function getIndexByName(formid,item) {
+ for (var i=0;i<document.forms[formid].elements.length;i++) {
+ if (document.forms[formid].elements[i].name == item) {
+ return i;
+ }
+ }
+ return -1;
+ }
ENDSTDBRW
+ if ($sec_element ne '') {
+ $output .= &setsec_javascript($sec_element,$formname);
+ }
+ $output .= '
+</script>';
+ return $output;
}
+sub setsec_javascript {
+ my ($sec_element,$formname) = @_;
+ my $setsections = qq|
+function setSect(sectionlist) {
+ var sectionsArray = sectionlist.split(",");
+ var numSections = sectionsArray.length;
+ document.$formname.$sec_element.length = 0;
+ if (numSections == 0) {
+ document.$formname.$sec_element.multiple=false;
+ document.$formname.$sec_element.size=1;
+ document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
+ } else {
+ if (numSections == 1) {
+ document.$formname.$sec_element.multiple=false;
+ document.$formname.$sec_element.size=1;
+ document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
+ document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
+ document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
+ } else {
+ for (var i=0; i<numSections; i++) {
+ document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
+ }
+ document.$formname.$sec_element.multiple=true
+ if (numSections < 3) {
+ document.$formname.$sec_element.size=numSections;
+ } else {
+ document.$formname.$sec_element.size=3;
+ }
+ document.$formname.$sec_element.options[0].selected = false
+ }
+ }
+}
+|;
+ return $setsections;
+}
+
+
sub selectcourse_link {
my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_;
- return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
- '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select [_1]',$selecttype)."</a>";
+ return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
+ '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select Course')."</a>";
}
sub check_uncheck_jscript {
@@ -1190,37 +1253,13 @@ sub create_text_file {
## Home server <option> list generating code ##
###############################################################
-=pod
-
-=head1 Home Server option list generating code
-
-=over 4
-
-=item * get_domains()
-
-Returns an array containing each of the domains listed in the hosts.tab
-file.
-
-=cut
-
-#-------------------------------------------
-sub get_domains {
- # The code below was stolen from "The Perl Cookbook", p 102, 1st ed.
- my @domains;
- my %seen;
- foreach my $dom (sort(values(%Apache::lonnet::hostdom))) {
- push(@domains,$dom) unless $seen{$dom}++;
- }
- return @domains;
-}
-
# ------------------------------------------
sub domain_select {
my ($name,$value,$multiple)=@_;
my %domains=map {
- $_ => $_.' '.$Apache::lonnet::domaindescription{$_}
- } &get_domains;
+ $_ => $_.' '. &Apache::lonnet::domain($_,'description')
+ } &Apache::lonnet::all_domains();
if ($multiple) {
$domains{''}=&mt('Any domain');
return &multiple_select_form($name,$value,4,\%domains);
@@ -1233,6 +1272,12 @@ sub domain_select {
=pod
+=head1 Routines for form select boxes
+
+=over 4
+
+=cut
+
=item * multiple_select_form($name,$value,$size,$hash,$order)
Returns a string containing a <select> element int multiple mode
@@ -1240,11 +1285,11 @@ Returns a string containing a <select> e
Args:
$name - name of the <select> element
- $value - sclara or array ref of values that should already be selected
+ $value - scalar 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
+ $order - (optional) array ref of the order to show the elements in
=cut
@@ -1260,8 +1305,16 @@ sub multiple_select_form {
}
}
$output.="\n<select name='$name' size='$size' multiple='1'>";
- my @order = ref($order) ? @$order
- : sort(keys(%$hash));
+ my @order;
+ if (ref($order) eq 'ARRAY') {
+ @order = @{$order};
+ } else {
+ @order = sort(keys(%$hash));
+ }
+ if (exists($$hash{'select_form_order'})) {
+ @order = @{$$hash{'select_form_order'}};
+ }
+
foreach my $key (@order) {
$output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
$output.='selected="selected" ' if ($selected{$key});
@@ -1303,6 +1356,24 @@ sub select_form {
return $selectform;
}
+# For display filters
+
+sub display_filter {
+ if (!$env{'form.show'}) { $env{'form.show'}=10; }
+ if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
+ return '<nobr><label>'.&mt('Records [_1]',
+ &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
+ (&mt('all'),10,20,50,100,1000,10000))).
+ '</label></nobr> <nobr>'.
+ &mt('Filter [_1]',
+ &select_form($env{'form.displayfilter'},
+ 'displayfilter',
+ ('currentfolder' => 'Current folder/page',
+ 'containing' => 'Containing phrase',
+ 'none' => 'None'))).
+ '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></nobr>';
+}
+
sub gradeleveldescription {
my $gradelevel=shift;
my %gradelevels=(0 => 'Not specified',
@@ -1358,7 +1429,7 @@ selected");
#-------------------------------------------
sub select_dom_form {
my ($defdom,$name,$includeempty) = @_;
- my @domains = get_domains();
+ my @domains = sort(&Apache::lonnet::all_domains());
if ($includeempty) { @domains=('',@domains); }
my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
foreach my $dom (@domains) {
@@ -1374,30 +1445,6 @@ sub select_dom_form {
=pod
-=item * get_library_servers($domain)
-
-Returns a hash which contains keys like '103l3' and values like
-'kirk.lite.msu.edu'. All of the keys will be for machines in the
-given $domain.
-
-=cut
-
-#-------------------------------------------
-sub get_library_servers {
- my $domain = shift;
- my %library_servers;
- foreach my $hostid (keys(%Apache::lonnet::libserv)) {
- if ($Apache::lonnet::hostdom{$hostid} eq $domain) {
- $library_servers{$hostid} = $Apache::lonnet::hostname{$hostid};
- }
- }
- return %library_servers;
-}
-
-#-------------------------------------------
-
-=pod
-
=item * home_server_option_list($domain)
returns a string which contains an <option> list to be used in a
@@ -1408,7 +1455,7 @@ returns a string which contains an <opti
#-------------------------------------------
sub home_server_option_list {
my $domain = shift;
- my %servers = &get_library_servers($domain);
+ my %servers = &Apache::lonnet::get_servers($domain,'library');
my $result = '';
foreach my $hostid (sort(keys(%servers))) {
$result.=
@@ -1420,7 +1467,7 @@ sub home_server_option_list {
=pod
-=back
+=back
=cut
@@ -1810,7 +1857,9 @@ If target_domain is not found in domain.
#-------------------------------------------
sub get_auth_defaults {
my $domain=shift;
- return ($Apache::lonnet::domain_auth_def{$domain},$Apache::lonnet::domain_auth_arg_def{$domain});
+ return (&Apache::lonnet::domain($domain,'auth_def'),
+ &Apache::lonnet::domain($domain,'auth_arg_def'));
+
}
###############################################################
## End Get Authentication Defaults for Domain ##
@@ -2005,6 +2054,7 @@ if $first is set to 'lastname' then it r
###############################################################
sub plainname {
my ($uname,$udom,$first)=@_;
+ return if (!defined($uname) || !defined($udom));
my %names=&getnames($uname,$udom);
my $name=&Apache::lonnet::format_name($names{'firstname'},
$names{'middlename'},
@@ -2036,6 +2086,7 @@ if the user does not
sub nickname {
my ($uname,$udom)=@_;
+ return if (!defined($uname) || !defined($udom));
my %names=&getnames($uname,$udom);
my $name=$names{'nickname'};
if ($name) {
@@ -2051,6 +2102,7 @@ sub nickname {
sub getnames {
my ($uname,$udom)=@_;
+ return if (!defined($uname) || !defined($udom));
if ($udom eq 'public' && $uname eq 'public') {
return ('lastname' => &mt('Public'));
}
@@ -2067,6 +2119,27 @@ sub getnames {
}
}
+sub getemails {
+ my ($uname,$udom)=@_;
+ if ($udom eq 'public' && $uname eq 'public') {
+ return;
+ }
+ if (!$udom) { $udom=$env{'user.domain'}; }
+ if (!$uname) { $uname=$env{'user.name'}; }
+ my $id=$uname.':'.$udom;
+ my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
+ if ($cached) {
+ return %{$names};
+ } else {
+ my %loadnames=&Apache::lonnet::get('environment',
+ ['notification','critnotification',
+ 'permanentemail'],
+ $udom,$uname);
+ &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
+ return %loadnames;
+ }
+}
+
# ------------------------------------------------------------------ Screenname
=pod
@@ -2111,7 +2184,7 @@ sub aboutmewrapper {
return;
}
return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
- ($target?' target="$target"':'').' title="'.&mt('View this users personal page').'">'.$link.'</a>';
+ ($target?' target="$target"':'').' title="'.&mt("View this user's personal page").'">'.$link.'</a>';
}
# ------------------------------------------------------------ Syllabus Wrapper
@@ -2145,6 +2218,19 @@ sub track_student_link {
&help_open_topic('View_recent_activity');
}
+# ===================================================== Display a student photo
+
+
+sub student_image_tag {
+ my ($domain,$user)=@_;
+ my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
+ if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
+ return '<img src="'.$imgsrc.'" align="right" />';
+ } else {
+ return '';
+ }
+}
+
=pod
=back
@@ -2353,25 +2439,28 @@ sub preferred_languages {
$env{'course.'.$env{'request.course.id'}.'.languages'}));
}
if ($env{'environment.languages'}) {
- @languages=split(/\s*(\,|\;|\:)\s*/,$env{'environment.languages'});
+ @languages=(@languages,
+ split(/\s*(\,|\;|\:)\s*/,$env{'environment.languages'}));
}
my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0];
if ($browser) {
@languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$browser));
}
- if ($Apache::lonnet::domain_lang_def{$env{'user.domain'}}) {
+ if (&Apache::lonnet::domain($env{'user.domain'},'lang_def')) {
@languages=(@languages,
- $Apache::lonnet::domain_lang_def{$env{'user.domain'}});
+ &Apache::lonnet::domain($env{'user.domain'},
+ 'lang_def'));
}
- if ($Apache::lonnet::domain_lang_def{$env{'request.role.domain'}}) {
+ if (&Apache::lonnet::domain($env{'request.role.domain'},'lang_def')) {
@languages=(@languages,
- $Apache::lonnet::domain_lang_def{$env{'request.role.domain'}});
+ &Apache::lonnet::domain($env{'request.role.domain'},
+ 'lang_def'));
}
- if ($Apache::lonnet::domain_lang_def{
- $Apache::lonnet::perlvar{'lonDefDomain'}}) {
+ if (&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
+ 'lang_def')) {
@languages=(@languages,
- $Apache::lonnet::domain_lang_def{
- $Apache::lonnet::perlvar{'lonDefDomain'}});
+ &Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
+ 'lang_def'));
}
# turn "en-ca" into "en-ca,en"
my @genlanguages;
@@ -2576,7 +2665,9 @@ sub get_student_answers {
}
$moreenv{'grade_target'}='answer';
%moreenv=(%form,%moreenv);
- my $userview=&Apache::lonnet::ssi('/res/'.$feedurl,%moreenv);
+ $feedurl = &Apache::lonnet::clutter($feedurl);
+ &Apache::lonenc::check_encrypt(\$feedurl);
+ my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
return $userview;
}
@@ -2595,7 +2686,7 @@ sub submlink {
my ($text,$uname,$udom,$symb,$target)=@_;
if (!($uname && $udom)) {
(my $cursymb, my $courseid,$udom,$uname)=
- &Apache::lonxml::whichuser($symb);
+ &Apache::lonnet::whichuser($symb);
if (!$symb) { $symb=$cursymb; }
}
if (!$symb) { $symb=&Apache::lonnet::symbread(); }
@@ -2641,7 +2732,7 @@ sub pprmlink {
my ($text,$uname,$udom,$symb,$target)=@_;
if (!($uname && $udom)) {
(my $cursymb, my $courseid,$udom,$uname)=
- &Apache::lonxml::whichuser($symb);
+ &Apache::lonnet::whichuser($symb);
if (!$symb) { $symb=$cursymb; }
}
if (!$symb) { $symb=&Apache::lonnet::symbread(); }
@@ -2690,31 +2781,376 @@ sub maketime {
#########################################
sub findallcourses {
- my ($roles) = @_;
+ my ($roles,$uname,$udom) = @_;
my %roles;
if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
my %courses;
my $now=time;
- 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; }
+ if (!defined($uname)) {
+ $uname = $env{'user.name'};
+ }
+ if (!defined($udom)) {
+ $udom = $env{'user.domain'};
+ }
+ if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
+ my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
+ if (!%roles) {
+ %roles = (
+ cc => 1,
+ in => 1,
+ ep => 1,
+ ta => 1,
+ cr => 1,
+ st => 1,
+ );
+ }
+ foreach my $entry (keys(%roleshash)) {
+ my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
+ if ($trole =~ /^cr/) {
+ next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
+ } else {
+ next if (!exists($roles{$trole}));
+ }
+ if ($tend) {
+ next if ($tend < $now);
+ }
+ if ($tstart) {
+ next if ($tstart > $now);
}
- if ($endtime) {
- if ($now>$endtime) { $active=0; }
+ my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);
+ (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
+ if ($secpart eq '') {
+ ($cnum,$role) = split(/_/,$cnumpart);
+ $sec = 'none';
+ $realsec = '';
+ } else {
+ $cnum = $cnumpart;
+ ($sec,$role) = split(/_/,$secpart);
+ $realsec = $sec;
+ }
+ $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
+ }
+ } else {
+ foreach my $key (keys(%env)) {
+ if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
+ $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
+ my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
+ 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; }
+ }
+ if ($endtime) {
+ if ($now>$endtime) { $active=0; }
+ }
+ if ($active) {
+ if ($sec eq '') {
+ $sec = 'none';
+ }
+ $courses{$cdom.'_'.$cnum}{$sec} =
+ $role.'/'.$cdom.'/'.$cnum.'/'.$sec;
+ }
}
- if ($active) { $courses{$domain.'_'.$id}=1; }
}
}
- return keys(%courses);
+ return %courses;
}
###############################################
+
+sub blockcheck {
+ my ($setters,$activity,$uname,$udom) = @_;
+
+ if (!defined($udom)) {
+ $udom = $env{'user.domain'};
+ }
+ if (!defined($uname)) {
+ $uname = $env{'user.name'};
+ }
+
+ # If uname and udom are for a course, check for blocks in the course.
+
+ if (&Apache::lonnet::is_course($udom,$uname)) {
+ my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
+ my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
+ return ($startblock,$endblock);
+ }
+
+ my $startblock = 0;
+ my $endblock = 0;
+ my %live_courses = &findallcourses(undef,$uname,$udom);
+
+ # If uname is for a user, and activity is course-specific, i.e.,
+ # boards, chat or groups, check for blocking in current course only.
+
+ if (($activity eq 'boards' || $activity eq 'chat' ||
+ $activity eq 'groups') && ($env{'request.course.id'})) {
+ foreach my $key (keys(%live_courses)) {
+ if ($key ne $env{'request.course.id'}) {
+ delete($live_courses{$key});
+ }
+ }
+ }
+
+ my $otheruser = 0;
+ my %own_courses;
+ if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
+ # Resource belongs to user other than current user.
+ $otheruser = 1;
+ # Gather courses for current user
+ %own_courses =
+ &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
+ }
+
+ # Gather active course roles - course coordinator, instructor,
+ # exam proctor, ta, student, or custom role.
+
+ foreach my $course (keys(%live_courses)) {
+ my ($cdom,$cnum);
+ if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
+ $cdom = $env{'course.'.$course.'.domain'};
+ $cnum = $env{'course.'.$course.'.num'};
+ } else {
+ ($cdom,$cnum) = split(/_/,$course);
+ }
+ my $no_ownblock = 0;
+ my $no_userblock = 0;
+ if ($otheruser && $activity ne 'com') {
+ # Check if current user has 'evb' priv for this
+ if (defined($own_courses{$course})) {
+ foreach my $sec (keys(%{$own_courses{$course}})) {
+ my $checkrole = 'cm./'.$cdom.'/'.$cnum;
+ if ($sec ne 'none') {
+ $checkrole .= '/'.$sec;
+ }
+ if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
+ $no_ownblock = 1;
+ last;
+ }
+ }
+ }
+ # if they have 'evb' priv and are currently not playing student
+ next if (($no_ownblock) &&
+ ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
+ }
+ foreach my $sec (keys(%{$live_courses{$course}})) {
+ my $checkrole = 'cm./'.$cdom.'/'.$cnum;
+ if ($sec ne 'none') {
+ $checkrole .= '/'.$sec;
+ }
+ if ($otheruser) {
+ # Resource belongs to user other than current user.
+ # Assemble privs for that user, and check for 'evb' priv.
+ my ($trole,$tdom,$tnum,$tsec);
+ my $entry = $live_courses{$course}{$sec};
+ if ($entry =~ /^cr/) {
+ ($trole,$tdom,$tnum,$tsec) =
+ ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
+ } else {
+ ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
+ }
+ my ($spec,$area,$trest,%allroles,%userroles);
+ $area = '/'.$tdom.'/'.$tnum;
+ $trest = $tnum;
+ if ($tsec ne '') {
+ $area .= '/'.$tsec;
+ $trest .= '/'.$tsec;
+ }
+ $spec = $trole.'.'.$area;
+ if ($trole =~ /^cr/) {
+ &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
+ $tdom,$spec,$trest,$area);
+ } else {
+ &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
+ $tdom,$spec,$trest,$area);
+ }
+ my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
+ if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
+ if ($1) {
+ $no_userblock = 1;
+ last;
+ }
+ }
+ } else {
+ # Resource belongs to current user
+ # Check for 'evb' priv via lonnet::allowed().
+ if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
+ $no_ownblock = 1;
+ last;
+ }
+ }
+ }
+ # if they have the evb priv and are currently not playing student
+ next if (($no_ownblock) &&
+ ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
+ next if ($no_userblock);
+
+ # Retrieve blocking times and identity of blocker for course
+ # of specified user, unless user has 'evb' privilege.
+
+ my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
+ if (($start != 0) &&
+ (($startblock == 0) || ($startblock > $start))) {
+ $startblock = $start;
+ }
+ if (($end != 0) &&
+ (($endblock == 0) || ($endblock < $end))) {
+ $endblock = $end;
+ }
+ }
+ return ($startblock,$endblock);
+}
+
+sub get_blocks {
+ my ($setters,$activity,$cdom,$cnum) = @_;
+ my $startblock = 0;
+ my $endblock = 0;
+ my $course = $cdom.'_'.$cnum;
+ $setters->{$course} = {};
+ $setters->{$course}{'staff'} = [];
+ $setters->{$course}{'times'} = [];
+ my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
+ foreach my $record (keys(%records)) {
+ my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
+ if ($start <= time && $end >= time) {
+ my ($staff_name,$staff_dom,$title,$blocks) =
+ &parse_block_record($records{$record});
+ if ($blocks->{$activity} eq 'on') {
+ push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
+ push(@{$$setters{$course}{'times'}}, [$start,$end]);
+ if ( ($startblock == 0) || ($startblock > $start) ) {
+ $startblock = $start;
+ }
+ if ( ($endblock == 0) || ($endblock < $end) ) {
+ $endblock = $end;
+ }
+ }
+ }
+ }
+ return ($startblock,$endblock);
+}
+
+sub parse_block_record {
+ my ($record) = @_;
+ my ($setuname,$setudom,$title,$blocks);
+ if (ref($record) eq 'HASH') {
+ ($setuname,$setudom) = split(/:/,$record->{'setter'});
+ $title = &unescape($record->{'event'});
+ $blocks = $record->{'blocks'};
+ } else {
+ my @data = split(/:/,$record,3);
+ if (scalar(@data) eq 2) {
+ $title = $data[1];
+ ($setuname,$setudom) = split(/@/,$data[0]);
+ } else {
+ ($setuname,$setudom,$title) = @data;
+ }
+ $blocks = { 'com' => 'on' };
+ }
+ return ($setuname,$setudom,$title,$blocks);
+}
+
+sub build_block_table {
+ my ($startblock,$endblock,$setters) = @_;
+ my %lt = &Apache::lonlocal::texthash(
+ 'cacb' => 'Currently active communication blocks',
+ 'cour' => 'Course',
+ 'dura' => 'Duration',
+ 'blse' => 'Block set by'
+ );
+ my $output;
+ $output = '<br />'.$lt{'cacb'}.':<br />';
+ $output .= &start_data_table();
+ $output .= '
+<tr>
+ <th>'.$lt{'cour'}.'</th>
+ <th>'.$lt{'dura'}.'</th>
+ <th>'.$lt{'blse'}.'</th>
+</tr>
+';
+ foreach my $course (keys(%{$setters})) {
+ my %courseinfo=&Apache::lonnet::coursedescription($course);
+ for (my $i=0; $i<@{$$setters{$course}{staff}}; $i++) {
+ my ($uname,$udom) = @{$$setters{$course}{staff}[$i]};
+ my $fullname = &plainname($uname,$udom);
+ if (defined($env{'user.name'}) && defined($env{'user.domain'})
+ && $env{'user.name'} ne 'public'
+ && $env{'user.domain'} ne 'public') {
+ $fullname = &aboutmewrapper($fullname,$uname,$udom);
+ }
+ my ($openblock,$closeblock) = @{$$setters{$course}{times}[$i]};
+ $openblock = &Apache::lonlocal::locallocaltime($openblock);
+ $closeblock= &Apache::lonlocal::locallocaltime($closeblock);
+ $output .= &Apache::loncommon::start_data_table_row().
+ '<td>'.$courseinfo{'description'}.'</td>'.
+ '<td>'.$openblock.' to '.$closeblock.'</td>'.
+ '<td>'.$fullname.'</td>'.
+ &Apache::loncommon::end_data_table_row();
+ }
+ }
+ $output .= &end_data_table();
+}
+
+sub blocking_status {
+ my ($activity,$uname,$udom) = @_;
+ my %setters;
+ my ($blocked,$output,$ownitem,$is_course);
+ my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);
+ if ($startblock && $endblock) {
+ $blocked = 1;
+ if (wantarray) {
+ my $category;
+ if ($activity eq 'boards') {
+ $category = 'Discussion posts in this course';
+ } elsif ($activity eq 'blogs') {
+ $category = 'Blogs';
+ } elsif ($activity eq 'port') {
+ if (defined($uname) && defined($udom)) {
+ if ($uname eq $env{'user.name'} &&
+ $udom eq $env{'user.domain'}) {
+ $ownitem = 1;
+ }
+ }
+ $is_course = &Apache::lonnet::is_course($udom,$uname);
+ if ($ownitem) {
+ $category = 'Your portfolio files';
+ } elsif ($is_course) {
+ my $coursedesc;
+ foreach my $course (keys(%setters)) {
+ my %courseinfo =
+ &Apache::lonnet::coursedescription($course);
+ $coursedesc = $courseinfo{'description'};
+ }
+ $category = "Group files in the course '$coursedesc'";
+ } else {
+ $category = 'Portfolio files belonging to ';
+ if ($env{'user.name'} eq 'public' &&
+ $env{'user.domain'} eq 'public') {
+ $category .= &plainname($uname,$udom);
+ } else {
+ $category .= &aboutmewrapper(&plainname($uname,$udom),$uname,$udom);
+ }
+ }
+ } elsif ($activity eq 'groups') {
+ $category = 'Groups in this course';
+ }
+ my $showstart = &Apache::lonlocal::locallocaltime($startblock);
+ my $showend = &Apache::lonlocal::locallocaltime($endblock);
+ $output = '<br />'.&mt('[_1] will be inaccessible between [_2] and [_3] because communication is being blocked.',$category,$showstart,$showend).'<br />';
+ if (!($activity eq 'port' && !($ownitem) && !($is_course))) {
+ $output .= &build_block_table($startblock,$endblock,\%setters);
+ }
+ }
+ }
+ if (wantarray) {
+ return ($blocked,$output);
+ } else {
+ return $blocked;
+ }
+}
+
###############################################
=pod
@@ -2734,7 +3170,7 @@ Returns: Determines which domain should
###############################################
sub determinedomain {
my $domain=shift;
- if (! $domain) {
+ if (! $domain) {
# Determine domain if we have not been given one
$domain = $Apache::lonnet::perlvar{'lonDefDomain'};
if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
@@ -2745,6 +3181,60 @@ sub determinedomain {
return $domain;
}
###############################################
+
+sub devalidate_domconfig_cache {
+ my ($udom)=@_;
+ &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
+}
+
+# ---------------------- Get domain configuration for a domain
+sub get_domainconf {
+ my ($udom) = @_;
+ my $cachetime=1800;
+ my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
+ if (defined($cached)) { return %{$result}; }
+
+ my %domconfig = &Apache::lonnet::get_dom('configuration',
+ ['login','rolecolors'],$udom);
+ my %designhash;
+ if (keys(%domconfig) > 0) {
+ if (ref($domconfig{'login'}) eq 'HASH') {
+ foreach my $key (keys(%{$domconfig{'login'}})) {
+ $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
+ }
+ }
+ if (ref($domconfig{'rolecolors'}) eq 'HASH') {
+ foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
+ if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
+ foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
+ $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
+ }
+ }
+ }
+ }
+ } else {
+ my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
+ my $designfile = $designdir.'/'.$udom.'.tab';
+ if (-e $designfile) {
+ if ( open (my $fh,"<$designfile") ) {
+ while (my $line = <$fh>) {
+ next if ($line =~ /^\#/);
+ chomp($line);
+ my ($key,$val)=(split(/\=/,$line));
+ if ($val) { $designhash{$udom.'.'.$key}=$val; }
+ }
+ close($fh);
+ }
+ }
+ if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {
+ $designhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
+ }
+ }
+ &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
+ $cachetime);
+ return %designhash;
+}
+
=pod
=item * &domainlogo()
@@ -2758,13 +3248,21 @@ If the domain logo does not exist, a des
###############################################
sub domainlogo {
- my $domain = &determinedomain(shift);
- # See if there is a logo
- if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {
- my $logo=&lonhttpdurl("/adm/lonDomLogos/$domain.gif");
- return '<img src="'.$logo.'" alt="'.$domain.'" />';
- } elsif(exists($Apache::lonnet::domaindescription{$domain})) {
- return $Apache::lonnet::domaindescription{$domain};
+ my $domain = &determinedomain(shift);
+ my %designhash = &get_domainconf($domain);
+ # See if there is a logo
+ if ($designhash{$domain.'.login.domlogo'} ne '') {
+ my $imgsrc = $designhash{$domain.'.login.domlogo'};
+ if ($imgsrc =~ m{^/(adm|res)/}) {
+ if ($imgsrc =~ m{^/res/}) {
+ my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
+ &Apache::lonnet::repcopy($local_name);
+ }
+ $imgsrc = &lonhttpdurl($imgsrc);
+ }
+ return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
+ } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
+ return &Apache::lonnet::domain($domain,'description');
} else {
return '';
}
@@ -2800,11 +3298,24 @@ sub designparm {
return $env{'environment.color.'.$which};
}
$domain=&determinedomain($domain);
- if (exists($designhash{$domain.'.'.$which})) {
- return $designhash{$domain.'.'.$which};
+ my %domdesign = &get_domainconf($domain);
+ my $output;
+ if ($domdesign{$domain.'.'.$which} ne '') {
+ $output = $domdesign{$domain.'.'.$which};
} else {
- return $designhash{'default.'.$which};
+ $output = $defaultdesign{$which};
+ }
+ if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
+ ($which =~ /login\.(img|logo|domlogo)/)) {
+ if ($output =~ m{^/(adm|res)/}) {
+ if ($output =~ m{^/res/}) {
+ my $local_name = &Apache::lonnet::filelocation('',$output);
+ &Apache::lonnet::repcopy($local_name);
+ }
+ $output = &lonhttpdurl($output);
+ }
}
+ return $output;
}
###############################################
@@ -2853,6 +3364,9 @@ Inputs:
=item * $no_inline_link, if true and in remote mode, don't show the
'Switch To Inline Menu' link
+=item * $args, optional argument valid values are
+ no_auto_mt_title -> prevents &mt()ing the title arg
+
=back
Returns: A uniform header for LON-CAPA web pages.
@@ -2864,9 +3378,9 @@ other decorations will be returned.
sub bodytag {
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,
- $notopbar,$bgcolor,$notitle,$no_inline_link)=@_;
+ $notopbar,$bgcolor,$notitle,$no_inline_link,$args)=@_;
- $title=&mt($title);
+ if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
$function = &get_users_function() if (!$function);
my $img = &designparm($function.'.img',$domain);
@@ -2884,8 +3398,8 @@ sub bodytag {
# role and realm
my ($role,$realm) = split(/\./,$env{'request.role'},2);
if ($role eq 'ca') {
- my ($rdom,$rname) = ($realm =~ m-^/(\w+)/(\w+)$-);
- $realm = &plainname($rname,$rdom).':'.$rdom;
+ my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
+ $realm = &plainname($rname,$rdom);
}
# realm
if ($env{'request.course.id'}) {
@@ -2910,9 +3424,7 @@ sub bodytag {
my $bodytag = "<body $extra_body_attr>".
&Apache::lontexconvert::init_math_support();
- if ($bodyonly
- || ($env{'request.state'} eq 'construct'
- && $env{'environment.remote'} ne 'off' )) {
+ if ($bodyonly) {
return $bodytag;
} elsif ($env{'browser.interface'} eq 'textual') {
# Accessibility
@@ -3020,8 +3532,11 @@ ENDROLE
# Top frame rendering, Remote is up
#
- my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
- $lonhttpdPort.$img.'" alt="'.$function.'" />';
+ my $imgsrc = $img;
+ if ($img =~ /^\/adm/) {
+ $imgsrc = 'http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.$img;
+ }
+ my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
# Explicit link to get inline menu
my $menu= ($no_inline_link?''
@@ -3169,8 +3684,8 @@ sub standard_css {
my $mono = 'monospace';
my $data_table_head = $tabbg;
my $data_table_light = '#EEEEEE';
- my $data_table_dark = '#DDD';
- my $data_table_darker = '#CCC';
+ my $data_table_dark = '#DDDDDD';
+ my $data_table_darker = '#CCCCCC';
my $data_table_highlight = '#FFFF00';
my $mail_new = '#FFBB77';
my $mail_new_hover = '#DD9955';
@@ -3181,16 +3696,26 @@ sub standard_css {
my $mail_other = '#99BBBB';
my $mail_other_hover = '#669999';
my $table_header = '#DDDDDD';
+ my $feedback_link_bg = '#BBBBBB';
my $border = ($env{'browser.type'} eq 'explorer') ? '0px 2px 0px 2px'
: '0px 3px 0px 4px';
+
return <<END;
h1, h2, h3, th { font-family: $sans }
a:focus { color: red; background: yellow }
-table.thinborder { border-collapse: collapse; }
-table.thinborder tr th { border-style: solid; border-width: 1px; background: $tabbg;}
-table.thinborder tr td { border-style: solid; border-width: 1px}
+table.thinborder,
+
+table.thinborder tr th {
+ border-style: solid;
+ border-width: 1px;
+ background: $tabbg;
+}
+table.thinborder tr td {
+ border-style: solid;
+ border-width: 1px
+}
form, .inline { display: inline; }
.center { text-align: center; }
@@ -3199,15 +3724,32 @@ form, .inline { display: inline; }
color: red;
font-size: larger;
}
-.LC_warning {
+.LC_warning,
+.LC_diff_removed {
color: red;
}
-.LC_success {
+
+.LC_info,
+.LC_success,
+.LC_diff_added {
color: green;
}
.LC_icon {
border: 0px;
}
+.LC_indexer_icon {
+ border: 0px;
+ height: 22px;
+}
+
+.LC_internal_info {
+ color: #999;
+}
+
+table.LC_pastsubmission {
+ border: 1px solid black;
+ margin: 2px;
+}
table#LC_top_nav, table#LC_menubuttons {
width: 100%;
@@ -3248,6 +3790,9 @@ table#LC_title_bar td.LC_title_bar_who {
font: small $sans;
text-align: right;
}
+span.LC_metadata {
+ font-family: $sans;
+}
span.LC_title_bar_title {
font: bold x-large $sans;
}
@@ -3262,7 +3807,7 @@ table#LC_title_bar td.LC_title_bar_role_
}
table#LC_menubuttons_mainmenu {
- background: $pgbg;
+ width: 100%;
border: 0px;
border-spacing: 1px;
padding: 0px 1px;
@@ -3317,19 +3862,37 @@ td.LC_table_cell_checkbox {
text-align: center;
}
+table#LC_mainmenu td.LC_mainmenu_column {
+ vertical-align: top;
+}
+
.LC_menubuttons_inline_text {
color: $font;
font-family: $sans;
font-size: smaller;
}
+.LC_menubuttons_link {
+ text-decoration: none;
+}
+
+.LC_menubuttons_category {
+ color: $font;
+ background: $pgbg;
+ font-family: $sans;
+ font-size: larger;
+ font-weight: bold;
+}
+
td.LC_menubuttons_text {
+ width: 90%;
color: $font;
font-family: $sans;
}
+
td.LC_menubuttons_img {
- background: $tabbg;
}
+
.LC_current_location {
font-family: $sans;
background: $tabbg;
@@ -3339,6 +3902,45 @@ td.LC_menubuttons_img {
font-weight: bold;
}
+.LC_rolesmenu_is {
+ font-family: $sans;
+}
+
+.LC_rolesmenu_selected {
+ font-family: $sans;
+}
+
+.LC_rolesmenu_future {
+ font-family: $sans;
+}
+
+
+.LC_rolesmenu_will {
+ font-family: $sans;
+}
+
+.LC_rolesmenu_will_not {
+ font-family: $sans;
+}
+
+.LC_rolesmenu_expired {
+ font-family: $sans;
+}
+
+.LC_rolesinfo {
+ font-family: $sans;
+}
+
+.LC_dropadd_labeltext {
+ font-family: $sans;
+ text-align: right;
+}
+
+.LC_preferences_labeltext {
+ font-family: $sans;
+ text-align: right;
+}
+
table.LC_aboutme_port {
border: 0px;
border-collapse: collapse;
@@ -3352,7 +3954,20 @@ table.LC_data_table, table.LC_mail_list
.LC_data_table_dense {
font-size: small;
}
-table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th {
+table.LC_nested_outer {
+ border: 1px solid #000000;
+ border-collapse: separate;
+ border-spacing: 0px;
+ width: 100%;
+}
+table.LC_nested {
+ border: 0px;
+ border-collapse: separate;
+ border-spacing: 0px;
+ width: 100%;
+}
+table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th,
+table.LC_prior_tries tr th {
font-weight: bold;
background-color: $data_table_head;
font-size: smaller;
@@ -3369,13 +3984,66 @@ table.LC_aboutme_port tr.LC_even_row td
table.LC_data_table tr.LC_data_table_highlight td {
background-color: $data_table_darker;
}
-table.LC_data_table tr.LC_empty_row td {
+table.LC_data_table tr.LC_empty_row td,
+table.LC_nested tr.LC_empty_row td {
background-color: #FFFFFF;
font-weight: bold;
font-style: italic;
text-align: center;
padding: 8px;
}
+table.LC_nested tr.LC_empty_row td {
+ padding: 4ex
+}
+table.LC_nested_outer tr th {
+ font-weight: bold;
+ background-color: $data_table_head;
+ font-size: smaller;
+ border-bottom: 1px solid #000000;
+}
+table.LC_nested_outer tr td.LC_subheader {
+ background-color: $data_table_head;
+ font-weight: bold;
+ font-size: small;
+ border-bottom: 1px solid #000000;
+ text-align: right;
+}
+table.LC_nested tr.LC_info_row td {
+ background-color: #CCC;
+ font-weight: bold;
+ font-size: small;
+ text-align: center;
+}
+table.LC_nested tr.LC_info_row td.LC_left_item {
+ text-align: left;
+}
+table.LC_nested td {
+ background-color: #FFF;
+ font-size: small;
+}
+table.LC_nested_outer tr th.LC_right_item,
+table.LC_nested tr.LC_info_row td.LC_right_item,
+table.LC_nested tr.LC_odd_row td.LC_right_item,
+table.LC_nested tr td.LC_right_item {
+ text-align: right;
+}
+
+table.LC_nested tr.LC_odd_row td {
+ background-color: #EEE;
+}
+
+table.LC_createuser {
+}
+
+table.LC_createuser tr.LC_section_row td {
+ font-size: smaller;
+}
+
+table.LC_createuser tr.LC_info_row td {
+ background-color: #CCC;
+ font-weight: bold;
+ text-align: center;
+}
table.LC_calendar {
border: 1px solid #000000;
@@ -3419,6 +4087,11 @@ table.LC_mail_list tr.LC_mail_other {
table.LC_mail_list tr.LC_mail_other:hover {
background-color: $mail_other_hover;
}
+table.LC_mail_list tr.LC_mail_even {
+}
+table.LC_mail_list tr.LC_mail_odd {
+}
+
table#LC_portfolio_actions {
width: auto;
@@ -3475,7 +4148,8 @@ table#LC_browser tr.LC_browser_file_unpu
table#LC_browser tr.LC_browser_file_obsolete {
background: #AAAAAA;
}
-table#LC_browser tr.LC_browser_file_modified {
+table#LC_browser tr.LC_browser_file_modified,
+table#LC_browser tr.LC_browser_file_metamodified {
background: #FFFF77;
}
table#LC_browser tr.LC_browser_folder {
@@ -3662,6 +4336,82 @@ table.LC_descriptive_input td.LC_descrip
text-align: right;
font-weight: bold;
}
+table.LC_feedback_link {
+ background: $feedback_link_bg;
+}
+span.LC_feedback_link {
+ background: $feedback_link_bg;
+ font-size: larger;
+}
+
+table.LC_prior_tries {
+ border: 1px solid #000000;
+ border-collapse: separate;
+ border-spacing: 1px;
+}
+
+table.LC_prior_tries td {
+ padding: 2px;
+}
+
+.LC_answer_correct {
+ background: #AAFFAA;
+ color: black;
+}
+.LC_answer_charged_try {
+ background: #FFAAAA ! important;
+ color: black;
+}
+.LC_answer_not_charged_try,
+.LC_answer_no_grade,
+.LC_answer_late {
+ background: #FFFFAA;
+ color: black;
+}
+.LC_answer_previous {
+ background: #AAAAFF;
+ color: black;
+}
+.LC_answer_no_message {
+ background: #FFFFFF;
+ color: black;
+}
+.LC_answer_unknown {
+ background: orange;
+ color: black;
+}
+
+
+span.LC_prior_numerical,
+span.LC_prior_string,
+span.LC_prior_custom,
+span.LC_prior_reaction,
+span.LC_prior_math {
+ font-family: monospace;
+ white-space: pre;
+}
+
+span.LC_prior_string {
+ font-family: monospace;
+ white-space: pre;
+}
+
+table.LC_prior_option {
+ width: 100%;
+ border-collapse: collapse;
+}
+table.LC_prior_rank, table.LC_prior_match {
+ border-collapse: collapse;
+}
+table.LC_prior_option tr td,
+table.LC_prior_rank tr td,
+table.LC_prior_match tr td {
+ border: 1px solid #000000;
+}
+
+span.LC_nobreak {
+ white-space: nowrap;
+}
END
}
@@ -3690,6 +4440,8 @@ Inputs: $title - optional title for the
domain
function -> force usage of a specific rolish color scheme
bgcolor -> override the default page bgcolor
+ no_auto_mt_title
+ -> prevent &mt()ing the title arg
=back
@@ -3702,6 +4454,7 @@ sub headtag {
my $domain = $args->{'domain'} || &determinedomain();
my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
my $url = join(':',$env{'user.name'},$env{'user.domain'},
+ $Apache::lonnet::perlvar{'lonVersion'},
#time(),
$env{'environment.color.timestamp'},
$function,$domain,$bgcolor);
@@ -3710,9 +4463,11 @@ sub headtag {
my $result =
'<head>'.
- &font_settings().
- &Apache::lonhtmlcommon::htmlareaheaders();
+ &font_settings();
+ if (!$args->{'frameset'}) {
+ $result .= &Apache::lonhtmlcommon::htmlareaheaders();
+ }
if ($args->{'force_register'}) {
$result .= &Apache::lonmenu::registerurl(1);
}
@@ -3736,8 +4491,8 @@ ADDMETA
if (!defined($title)) {
$title = 'The LearningOnline Network with CAPA';
}
-
- $result .= '<title> LON-CAPA '.&mt($title).'</title>'
+ if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
+ $result .= '<title> LON-CAPA '.$title.'</title>'
.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
.$head_extra;
return $result;
@@ -3881,6 +4636,8 @@ Inputs: $title - optional title for the
no_inline_link -> if true and in remote mode, don't show the
'Switch To Inline Menu' link
+ no_auto_mt_title -> prevent &mt()ing the title arg
+
=back
=cut
@@ -3890,7 +4647,8 @@ sub start_page {
#&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
my %head_args;
foreach my $arg ('redirect','force_register','domain','function',
- 'bgcolor','frameset','no_nav_bar','only_body') {
+ 'bgcolor','frameset','no_nav_bar','only_body',
+ 'no_auto_mt_title') {
if (defined($args->{$arg})) {
$head_args{$arg} = $args->{$arg};
}
@@ -3916,7 +4674,8 @@ sub start_page {
$args->{'only_body'}, $args->{'domain'},
$args->{'force_register'}, $args->{'body_title'},
$args->{'no_nav_bar'}, $args->{'bgcolor'},
- $args->{'no_title'}, $args->{'no_inline_link'});
+ $args->{'no_title'}, $args->{'no_inline_link'},
+ $args);
}
}
@@ -3945,6 +4704,11 @@ Inputs: $args - additional optio
a html attribute
frameset -> if true will start with a <frameset>
rather than <body>
+ dicsussion -> if true will get discussion from
+ lonxml::xmlend
+ (you can pass the target and parser arguments
+ through optional 'target' and 'parser' args
+ to this routine)
=cut
@@ -4056,6 +4820,13 @@ sub simple_error_page {
$css_class = (join(' ',$css_class,$add_class));
return '<tr class="'.$css_class.'">'."\n";;
}
+
+ sub continue_data_table_row {
+ my ($add_class) = @_;
+ my $css_class = ($row_count % 2)?'':'LC_even_row';
+ $css_class = (join(' ',$css_class,$add_class));
+ return '<tr class="'.$css_class.'">'."\n";;
+ }
sub end_data_table_row {
return '</tr>'."\n";;
@@ -4396,7 +5167,7 @@ sub get_course_users {
$usec = 'none';
}
if ($uname ne '' && $udom ne '') {
- if ($end < $now) {
+ if ($end > 0 && $end < $now) {
$status = 'previous';
} elsif ($start > $now) {
$status = 'future';
@@ -4458,6 +5229,154 @@ sub get_user_info {
return;
}
+###############################################
+
+=pod
+
+=item * &get_user_quota()
+
+Retrieves quota assigned for storage of portfolio files for a user
+
+Incoming parameters:
+1. user's username
+2. user's domain
+
+Returns:
+1. Disk quota (in Mb) assigned to student.
+2. (Optional) Type of setting: custom or default
+ (individually assigned or default for user's
+ institutional status).
+3. (Optional) - User's institutional status (e.g., faculty, staff
+ or student - types as defined in localenroll::inst_usertypes
+ for user's domain, which determines default quota for user.
+4. (Optional) - Default quota which would apply to the user.
+
+If a value has been stored in the user's environment,
+it will return that, otherwise it returns the maximal default
+defined for the user's instituional status(es) in the domain.
+
+=cut
+
+###############################################
+
+
+sub get_user_quota {
+ my ($uname,$udom) = @_;
+ my ($quota,$quotatype,$settingstatus,$defquota);
+ if (!defined($udom)) {
+ $udom = $env{'user.domain'};
+ }
+ if (!defined($uname)) {
+ $uname = $env{'user.name'};
+ }
+ if (($udom eq '' || $uname eq '') ||
+ ($udom eq 'public') && ($uname eq 'public')) {
+ $quota = 0;
+ $quotatype = 'default';
+ $defquota = 0;
+ } else {
+ my $inststatus;
+ if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
+ $quota = $env{'environment.portfolioquota'};
+ $inststatus = $env{'environment.inststatus'};
+ } else {
+ my %userenv =
+ &Apache::lonnet::get('environment',['portfolioquota',
+ 'inststatus'],$udom,$uname);
+ my ($tmp) = keys(%userenv);
+ if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
+ $quota = $userenv{'portfolioquota'};
+ $inststatus = $userenv{'inststatus'};
+ } else {
+ undef(%userenv);
+ }
+ }
+ ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
+ if ($quota eq '') {
+ $quota = $defquota;
+ $quotatype = 'default';
+ } else {
+ $quotatype = 'custom';
+ }
+ }
+ if (wantarray) {
+ return ($quota,$quotatype,$settingstatus,$defquota);
+ } else {
+ return $quota;
+ }
+}
+
+###############################################
+
+=pod
+
+=item * &default_quota()
+
+Retrieves default quota assigned for storage of user portfolio files,
+given an (optional) user's institutional status.
+
+Incoming parameters:
+1. domain
+2. (Optional) institutional status(es). This is a : separated list of
+ status types (e.g., faculty, staff, student etc.)
+ which apply to the user for whom the default is being retrieved.
+ If the institutional status string in undefined, the domain
+ default quota will be returned.
+
+Returns:
+1. Default disk quota (in Mb) for user portfolios in the domain.
+2. (Optional) institutional type which determined the value of the
+ default quota.
+
+If a value has been stored in the domain's configuration db,
+it will return that, otherwise it returns 20 (for backwards
+compatibility with domains which have not set up a configuration
+db file; the original statically defined portfolio quota was 20 Mb).
+
+If the user's status includes multiple types (e.g., staff and student),
+the largest default quota which applies to the user determines the
+default quota returned.
+
+=cut
+
+###############################################
+
+
+sub default_quota {
+ my ($udom,$inststatus) = @_;
+ my ($defquota,$settingstatus);
+ my %quotahash = &Apache::lonnet::get_dom('configuration',
+ ['quota'],$udom);
+ if (ref($quotahash{'quota'}) eq 'HASH') {
+ if ($inststatus ne '') {
+ my @statuses = split(/:/,$inststatus);
+ foreach my $item (@statuses) {
+ if ($quotahash{'quota'}{$item} ne '') {
+ if ($defquota eq '') {
+ $defquota = $quotahash{'quota'}{$item};
+ $settingstatus = $item;
+ } elsif ($quotahash{'quota'}{$item} > $defquota) {
+ $defquota = $quotahash{'quota'}{$item};
+ $settingstatus = $item;
+ }
+ }
+ }
+ }
+ if ($defquota eq '') {
+ $defquota = $quotahash{'quota'}{'default'};
+ $settingstatus = 'default';
+ }
+ } else {
+ $settingstatus = 'default';
+ $defquota = 20;
+ }
+ if (wantarray) {
+ return ($defquota,$settingstatus);
+ } else {
+ return $defquota;
+ }
+}
+
sub get_secgrprole_info {
my ($cdom,$cnum,$needroles,$type) = @_;
my %sections_count = &get_sections($cdom,$cnum);
@@ -4632,7 +5551,7 @@ sub get_env_multiple {
=pod
-=back
+=back
=head1 CSV Upload/Handling functions
@@ -4746,7 +5665,12 @@ sub record_sep {
$i++;
}
} else {
- my @allfields=split(/\,/,$record);
+ my @allfields;
+ if ($env{'form.upfiletype'} eq 'semisv') {
+ @allfields=split(/;/,$record,-1);
+ } else {
+ @allfields=split(/\,/,$record,-1);
+ }
my $i=0;
my $j;
for ($j=0;$j<=$#allfields;$j++) {
@@ -4784,6 +5708,7 @@ the file type.
sub upfile_select_html {
my %Types = (
csv => &mt('CSV (comma separated values, spreadsheet)'),
+ semisv => &mt('Semicolon separated values'),
space => &mt('Space separated'),
tab => &mt('Tabulator separated'),
# xml => &mt('HTML/XML'),
@@ -5438,16 +6363,19 @@ Returns: both routines return nothing
#######################################################
#######################################################
sub store_course_settings {
+ return &store_settings($env{'request.course.id'},@_);
+}
+
+sub store_settings {
# save to the environment
# appenv the same items, just to be safe
- my $courseid = $env{'request.course.id'};
my $udom = $env{'user.domain'};
my $uname = $env{'user.name'};
- my ($prefix,$Settings) = @_;
+ my ($context,$prefix,$Settings) = @_;
my %SaveHash;
my %AppHash;
while (my ($setting,$type) = each(%$Settings)) {
- my $basename = join('.','internal',$courseid,$prefix,$setting);
+ my $basename = join('.','internal',$context,$prefix,$setting);
my $envname = 'environment.'.$basename;
if (exists($env{'form.'.$setting})) {
# Save this value away
@@ -5487,11 +6415,14 @@ sub store_course_settings {
}
sub restore_course_settings {
- my $courseid = $env{'request.course.id'};
- my ($prefix,$Settings) = @_;
+ return &restore_settings($env{'request.course.id'},@_);
+}
+
+sub restore_settings {
+ my ($context,$prefix,$Settings) = @_;
while (my ($setting,$type) = each(%$Settings)) {
next if (exists($env{'form.'.$setting}));
- my $envname = 'environment.internal.'.$courseid.'.'.$prefix.
+ my $envname = 'environment.internal.'.$context.'.'.$prefix.
'.'.$setting;
if (exists($env{$envname})) {
if ($type eq 'scalar') {
@@ -5623,7 +6554,7 @@ sub construct_course {
#
# Check if created correctly
#
- ($$crsudom,$$crsunum)=($$courseid=~/^\/(\w+)\/(\w+)$/);
+ ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
$outcome .= &mt('Created on').': '.$crsuhome.'<br>';
#
@@ -5632,7 +6563,7 @@ sub construct_course {
my $cloneid='';
if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
$cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
- my ($clonecrsudom,$clonecrsunum)=($cloneid=~/^\/(\w+)\/(\w+)$/);
+ my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
if ($clonehome eq 'no_host') {
$outcome .=
@@ -5805,9 +6736,11 @@ sub construct_course {
# if specified, key authority is not course, but user
# only active if keyaccess is yes
if ($args->{'keyauth'}) {
- $args->{'keyauth'}=~s/[^\w\@]//g;
- if ($args->{'keyauth'}) {
- $cenv{'keyauth'}=$args->{'keyauth'};
+ my ($user,$domain) = split(':',$args->{'keyauth'});
+ $user = &LONCAPA::clean_username($user);
+ $domain = &LONCAPA::clean_username($domain);
+ if ($user ne '' && $domain ne '') {
+ $cenv{'keyauth'}=$user.':'.$domain;
}
}
@@ -5904,7 +6837,7 @@ sub group_term {
sub icon {
my ($file)=@_;
- my $curfext = (split(/\./,$file))[-1];
+ my $curfext = lc((split(/\./,$file))[-1]);
my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
my $embstyle = &Apache::loncommon::fileembstyle($curfext);
if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
@@ -5925,15 +6858,6 @@ sub lonhttpdurl {
return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url;
}
-sub absolute_url {
- my ($host_name) = @_;
- my $protocol = ($ENV{'SERVER_PORT'} == 443?'https://':'http://');
- if ($host_name eq '') {
- $host_name = $ENV{'SERVER_NAME'};
- }
- return $protocol.$host_name;
-}
-
sub connection_aborted {
my ($r)=@_;
$r->print(" ");$r->rflush();
@@ -5966,6 +6890,171 @@ sub escape_url {
my $lastitem = &escape(pop(@urlslices));
return join('/',@urlslices).'/'.$lastitem;
}
+
+# -------------------------------------------------------- Initliaze user login
+sub init_user_environment {
+ my ($r, $username, $domain, $authhost, $form, $args) = @_;
+ my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
+
+ my $public=($username eq 'public' && $domain eq 'public');
+
+# See if old ID present, if so, remove
+
+ my ($filename,$cookie,$userroles);
+ my $now=time;
+
+ if ($public) {
+ my $max_public=100;
+ my $oldest;
+ my $oldest_time=0;
+ for(my $next=1;$next<=$max_public;$next++) {
+ if (-e $lonids."/publicuser_$next.id") {
+ my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
+ if ($mtime<$oldest_time || !$oldest_time) {
+ $oldest_time=$mtime;
+ $oldest=$next;
+ }
+ } else {
+ $cookie="publicuser_$next";
+ last;
+ }
+ }
+ if (!$cookie) { $cookie="publicuser_$oldest"; }
+ } else {
+ # if this isn't a robot, kill any existing non-robot sessions
+ if (!$args->{'robot'}) {
+ opendir(DIR,$lonids);
+ while ($filename=readdir(DIR)) {
+ if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
+ unlink($lonids.'/'.$filename);
+ }
+ }
+ closedir(DIR);
+ }
+# Give them a new cookie
+ my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
+ : $now);
+ $cookie="$username\_$id\_$domain\_$authhost";
+
+# Initialize roles
+
+ $userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
+ }
+# ------------------------------------ Check browser type and MathML capability
+
+ my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
+ $clientunicode,$clientos) = &decode_user_agent($r);
+
+# -------------------------------------- Any accessibility options to remember?
+ if (($form->{'interface'}) && ($form->{'remember'} eq 'true')) {
+ foreach my $option ('imagesuppress','appletsuppress',
+ 'embedsuppress','fontenhance','blackwhite') {
+ if ($form->{$option} eq 'true') {
+ &Apache::lonnet::put('environment',{$option => 'on'},
+ $domain,$username);
+ } else {
+ &Apache::lonnet::del('environment',[$option],
+ $domain,$username);
+ }
+ }
+ }
+# ------------------------------------------------------------- Get environment
+
+ my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
+ my ($tmp) = keys(%userenv);
+ if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
+ # default remote control to off
+ if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
+ } else {
+ undef(%userenv);
+ }
+ if (($userenv{'interface'}) && (!$form->{'interface'})) {
+ $form->{'interface'}=$userenv{'interface'};
+ }
+ $env{'environment.remote'}=$userenv{'remote'};
+ if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
+
+# --------------- Do not trust query string to be put directly into environment
+ foreach my $option ('imagesuppress','appletsuppress',
+ 'embedsuppress','fontenhance','blackwhite',
+ 'interface','localpath','localres') {
+ $form->{$option}=~s/[\n\r\=]//gs;
+ }
+# --------------------------------------------------------- Write first profile
+
+ {
+ my %initial_env =
+ ("user.name" => $username,
+ "user.domain" => $domain,
+ "user.home" => $authhost,
+ "browser.type" => $clientbrowser,
+ "browser.version" => $clientversion,
+ "browser.mathml" => $clientmathml,
+ "browser.unicode" => $clientunicode,
+ "browser.os" => $clientos,
+ "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
+ "request.course.fn" => '',
+ "request.course.uri" => '',
+ "request.course.sec" => '',
+ "request.role" => 'cm',
+ "request.role.adv" => $env{'user.adv'},
+ "request.host" => $ENV{'REMOTE_ADDR'},);
+
+ if ($form->{'localpath'}) {
+ $initial_env{"browser.localpath"} = $form->{'localpath'};
+ $initial_env{"browser.localres"} = $form->{'localres'};
+ }
+
+ if ($public) {
+ $initial_env{"environment.remote"} = "off";
+ }
+ if ($form->{'interface'}) {
+ $form->{'interface'}=~s/\W//gs;
+ $initial_env{"browser.interface"} = $form->{'interface'};
+ $env{'browser.interface'}=$form->{'interface'};
+ foreach my $option ('imagesuppress','appletsuppress',
+ 'embedsuppress','fontenhance','blackwhite') {
+ if (($form->{$option} eq 'true') ||
+ ($userenv{$option} eq 'on')) {
+ $initial_env{"browser.$option"} = "on";
+ }
+ }
+ }
+
+ $env{'user.environment'} = "$lonids/$cookie.id";
+
+ if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
+ &GDBM_WRCREAT(),0640)) {
+ &_add_to_env(\%disk_env,\%initial_env);
+ &_add_to_env(\%disk_env,\%userenv,'environment.');
+ &_add_to_env(\%disk_env,$userroles);
+ if (ref($args->{'extra_env'})) {
+ &_add_to_env(\%disk_env,$args->{'extra_env'});
+ }
+ untie(%disk_env);
+ } else {
+ &Apache::lonnet::logthis("<font color=\"blue\">WARNING: ".
+ 'Could not create environment storage in lonauth: '.$!.'</font>');
+ return 'error: '.$!;
+ }
+ }
+ $env{'request.role'}='cm';
+ $env{'request.role.adv'}=$env{'user.adv'};
+ $env{'browser.type'}=$clientbrowser;
+
+ return $cookie;
+
+}
+
+sub _add_to_env {
+ my ($idf,$env_data,$prefix) = @_;
+ while (my ($key,$value) = each(%$env_data)) {
+ $idf->{$prefix.$key} = $value;
+ $env{$prefix.$key} = $value;
+ }
+}
+
+
=pod
=back