list to be used in a
@@ -1500,7 +1455,7 @@ returns a string which contains an ';
+ } else {
+ return '';
+ }
+}
+
=pod
=back
@@ -2473,19 +2441,21 @@ sub preferred_languages {
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;
@@ -2690,7 +2660,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;
}
@@ -2850,7 +2822,7 @@ sub findallcourses {
$cnum = $cnumpart;
($sec,$role) = split(/_/,$secpart);
$realsec = $sec;
- }
+ }
$courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
}
} else {
@@ -2885,15 +2857,50 @@ sub findallcourses {
sub blockcheck {
my ($setters,$activity,$uname,$udom) = @_;
- # Retrieve active course roles - course coordinator, instructor, exam proctor, ta, student or custom role.
- my %live_courses = &findallcourses(undef,$uname,$udom);
+ if (!defined($udom)) {
+ $udom = $env{'user.domain'};
+ }
+ if (!defined($uname)) {
+ $uname = $env{'user.name'};
+ }
- # Retrieve blocking times and identity of blocker for active courses
- # of specified user, unless user has 'evb' privilege.
+ # 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);
@@ -2901,17 +2908,36 @@ sub blockcheck {
$cdom = $env{'course.'.$course.'.domain'};
$cnum = $env{'course.'.$course.'.num'};
} else {
- ($cdom,$cnum) = split(/_/,$course);
+ ($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 ((defined($uname) && ($uname ne $env{'user.name'})) ||
- (defined($udom) && ($udom ne $env{'user.domain'}))) {
+ 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/) {
@@ -2943,6 +2969,8 @@ sub blockcheck {
}
}
} 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;
@@ -2951,26 +2979,47 @@ sub blockcheck {
}
# if they have the evb priv and are currently not playing student
next if (($no_ownblock) &&
- ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
+ ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
next if ($no_userblock);
- $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 > $1) ) {
- $startblock = $1;
- }
- if ( ($endblock == 0) || ($endblock < $2) ) {
- $endblock = $2;
- }
+ # 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;
}
}
}
@@ -3020,20 +3069,83 @@ sub build_block_table {
my %courseinfo=&Apache::lonnet::coursedescription($course);
for (my $i=0; $i<@{$$setters{$course}{staff}}; $i++) {
my ($uname,$udom) = @{$$setters{$course}{staff}[$i]};
- my $fullname = &aboutmewrapper(&plainname($uname,$udom),$uname,$udom);
+ 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().
''.$courseinfo{'description'}.' '.
''.$openblock.' to '.$closeblock.' '.
- ''.$fullname.'. '.
+ ''.$fullname.' '.
&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 = ' '.&mt('[_1] will be inaccessible between [_2] and [_3] because communication is being blocked.',$category,$showstart,$showend).' ';
+ if (!($activity eq 'port' && !($ownitem) && !($is_course))) {
+ $output .= &build_block_table($startblock,$endblock,\%setters);
+ }
+ }
+ }
+ if (wantarray) {
+ return ($blocked,$output);
+ } else {
+ return $blocked;
+ }
+}
+
###############################################
=pod
@@ -3053,7 +3165,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'}; }
@@ -3064,6 +3176,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()
@@ -3077,13 +3243,17 @@ 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 ' ';
- } 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 =~ /^\/(adm|res)/) {
+ $imgsrc = &lonhttpdurl($imgsrc);
+ }
+ return ' ';
+ } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
+ return &Apache::lonnet::domain($domain,'description');
} else {
return '';
}
@@ -3119,11 +3289,20 @@ 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 =~ /^\/(adm|res)\//) {
+ $output = &lonhttpdurl($output);
+ }
}
+ return $output;
}
###############################################
@@ -3196,7 +3375,7 @@ sub bodytag {
my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
my %design = ( 'style' => 'margin-top: 0px',
- 'bgcolor' => $pgbg,
+ 'bgcolor' => '#ffffff',
'text' => $font,
'alink' => &designparm($function.'.alink',$domain),
'vlink' => &designparm($function.'.vlink',$domain),
@@ -3207,7 +3386,7 @@ sub bodytag {
my ($role,$realm) = split(/\./,$env{'request.role'},2);
if ($role eq 'ca') {
my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
- $realm = &plainname($rname,$rdom).':'.$rdom;
+ $realm = &plainname($rname,$rdom);
}
# realm
if ($env{'request.course.id'}) {
@@ -3232,9 +3411,7 @@ sub bodytag {
my $bodytag = "".
&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
@@ -3342,8 +3519,11 @@ ENDROLE
# Top frame rendering, Remote is up
#
- my $upperleft=' ';
+ my $imgsrc = $img;
+ if ($img =~ /^\/adm/) {
+ $imgsrc = 'http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.$img;
+ }
+ my $upperleft=' ';
# Explicit link to get inline menu
my $menu= ($no_inline_link?''
@@ -3503,16 +3683,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 < if true will start with a
rather than
+ 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
@@ -4784,7 +5150,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';
@@ -5226,9 +5592,9 @@ sub record_sep {
} else {
my @allfields;
if ($env{'form.upfiletype'} eq 'semisv') {
- @allfields=split(/;/,$record);
+ @allfields=split(/;/,$record,-1);
} else {
- @allfields=split(/\,/,$record);
+ @allfields=split(/\,/,$record,-1);
}
my $i=0;
my $j;
@@ -5922,16 +6288,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
@@ -5971,11 +6340,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') {
@@ -6289,9 +6661,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;
}
}
@@ -6388,7 +6762,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')) {