loncom/interface/loncommon.pm - diff

Return to loncommon.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncommon.pm between versions 1.487 and 1.521

version 1.487, 2006/12/05 02:55:51	version 1.521, 2007/04/11 02:42:00
Line 59 use Apache::lonnet;	Line 59 use Apache::lonnet;
use GDBM_File;	use GDBM_File;
use POSIX qw(strftime mktime);	use POSIX qw(strftime mktime);
use Apache::lonmenu();	use Apache::lonmenu();
	use Apache::lonenc();
use Apache::lonlocal;	use Apache::lonlocal;
use HTML::Entities;	use HTML::Entities;
use Apache::lonhtmlcommon();	use Apache::lonhtmlcommon();
Line 67 use Apache::lontexconvert();	Line 68 use Apache::lontexconvert();
use Apache::lonclonecourse();	use Apache::lonclonecourse();
use LONCAPA qw(:DEFAULT :match);	use LONCAPA qw(:DEFAULT :match);

	# ---------------------------------------------- Designs
	use vars qw(%defaultdesign);

my $readit;	my $readit;


##	##
## Global Variables	## Global Variables
##	##
Line 81 my %scprtag;	Line 86 my %scprtag;
my %fe; my %fd; my %fm;	my %fe; my %fd; my %fm;
my %category_extensions;	my %category_extensions;

# ---------------------------------------------- Designs

my %designhash;

# ---------------------------------------------- Thesaurus variables	# ---------------------------------------------- Thesaurus variables
#	#
# %Keywords:	# %Keywords:
Line 150 BEGIN {	Line 151 BEGIN {
}	}
}	}

# -------------------------------------------------------------- domain designs	# -------------------------------------------------------------- default domain designs

my $filename;
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';	my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
opendir(DIR,$designdir);	my $designfile = $designdir.'/default.tab';
while ($filename=readdir(DIR)) {	if ( open (my $fh,"<$designfile") ) {
if ($filename!~/\.tab$/) { next; }	while (my $line = <$fh>) {
my ($domain)=($filename=~/^($match_domain)\./);	next if ($line =~ /^\#/);
{	chomp($line);
my $designfile = $designdir.'/'.$filename;	my ($key,$val)=(split(/\=/,$line));
if ( open (my $fh,"<$designfile") ) {	if ($val) { $defaultdesign{$key}=$val; }
while (my $line = <$fh>) {	}
next if ($line =~ /^\#/);	close($fh);
chomp($line);
my ($key,$val)=(split(/\=/,$line));
if ($val) { $designhash{$domain.'.'.$key}=$val; }
}
close($fh);
}
}

}	}
closedir(DIR);


# ------------------------------------------------------------- file categories	# ------------------------------------------------------------- file categories
{	{
Line 515 function setSect(sectionlist) {	Line 504 function setSect(sectionlist) {

sub selectcourse_link {	sub selectcourse_link {
my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_;	my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_;
return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.	return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
'","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select [_1]',$selecttype)."</a>";	'","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select Course')."</a>";
}	}

sub check_uncheck_jscript {	sub check_uncheck_jscript {
Line 1264 sub create_text_file {	Line 1253 sub create_text_file {
## Home server <option> list generating code ##	## 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 {	sub domain_select {
my ($name,$value,$multiple)=@_;	my ($name,$value,$multiple)=@_;
my %domains=map {	my %domains=map {
$_ => $_.' '.$Apache::lonnet::domaindescription{$_}	$_ => $_.' '. &Apache::lonnet::domain($_,'description')
} &get_domains;	} &Apache::lonnet::all_domains();
if ($multiple) {	if ($multiple) {
$domains{''}=&mt('Any domain');	$domains{''}=&mt('Any domain');
return &multiple_select_form($name,$value,4,\%domains);	return &multiple_select_form($name,$value,4,\%domains);
Line 1307 sub domain_select {	Line 1272 sub domain_select {

=pod	=pod

	=head1 Routines for form select boxes

	=over 4

	=cut

=item * multiple_select_form($name,$value,$size,$hash,$order)	=item * multiple_select_form($name,$value,$size,$hash,$order)

Returns a string containing a <select> element int multiple mode	Returns a string containing a <select> element int multiple mode
Line 1314 Returns a string containing a <select> e	Line 1285 Returns a string containing a <select> e

Args:	Args:
$name - name of the <select> element	$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	$size - number of rows long the select element is
$hash - the elements should be 'option' => 'shown text'	$hash - the elements should be 'option' => 'shown text'
(shown text should already have been &mt())	(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	=cut

Line 1334 sub multiple_select_form {	Line 1305 sub multiple_select_form {
}	}
}	}
$output.="\n<select name='$name' size='$size' multiple='1'>";	$output.="\n<select name='$name' size='$size' multiple='1'>";
my @order = ref($order) ? @$order	my @order;
: sort(keys(%$hash));	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) {	foreach my $key (@order) {
$output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';	$output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
$output.='selected="selected" ' if ($selected{$key});	$output.='selected="selected" ' if ($selected{$key});
Line 1450 selected");	Line 1429 selected");
#-------------------------------------------	#-------------------------------------------
sub select_dom_form {	sub select_dom_form {
my ($defdom,$name,$includeempty) = @_;	my ($defdom,$name,$includeempty) = @_;
my @domains = get_domains();	my @domains = sort(&Apache::lonnet::all_domains());
if ($includeempty) { @domains=('',@domains); }	if ($includeempty) { @domains=('',@domains); }
my $selectdomain = "<select name=\"$name\" size=\"1\">\n";	my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
foreach my $dom (@domains) {	foreach my $dom (@domains) {
Line 1466 sub select_dom_form {	Line 1445 sub select_dom_form {

=pod	=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)	=item * home_server_option_list($domain)

returns a string which contains an <option> list to be used in a	returns a string which contains an <option> list to be used in a
Line 1500 returns a string which contains an <opti	Line 1455 returns a string which contains an <opti
#-------------------------------------------	#-------------------------------------------
sub home_server_option_list {	sub home_server_option_list {
my $domain = shift;	my $domain = shift;
my %servers = &get_library_servers($domain);	my %servers = &Apache::lonnet::get_servers($domain,'library');
my $result = '';	my $result = '';
foreach my $hostid (sort(keys(%servers))) {	foreach my $hostid (sort(keys(%servers))) {
$result.=	$result.=
Line 1512 sub home_server_option_list {	Line 1467 sub home_server_option_list {

=pod	=pod

=back

=cut	=cut

###############################################################	###############################################################
Line 1902 If target_domain is not found in domain.	Line 1855 If target_domain is not found in domain.
#-------------------------------------------	#-------------------------------------------
sub get_auth_defaults {	sub get_auth_defaults {
my $domain=shift;	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 ##	## End Get Authentication Defaults for Domain ##
Line 2258 sub track_student_link {	Line 2213 sub track_student_link {
&help_open_topic('View_recent_activity');	&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	=pod

=back	=back
Line 2473 sub preferred_languages {	Line 2441 sub preferred_languages {
if ($browser) {	if ($browser) {
@languages=(@languages,split(/\s(\,\|\;\|\:)\s/,$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,	@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,	@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{	if (&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
$Apache::lonnet::perlvar{'lonDefDomain'}}) {	'lang_def')) {
@languages=(@languages,	@languages=(@languages,
$Apache::lonnet::domain_lang_def{	&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
$Apache::lonnet::perlvar{'lonDefDomain'}});	'lang_def'));
}	}
# turn "en-ca" into "en-ca,en"	# turn "en-ca" into "en-ca,en"
my @genlanguages;	my @genlanguages;
Line 2690 sub get_student_answers {	Line 2660 sub get_student_answers {
}	}
$moreenv{'grade_target'}='answer';	$moreenv{'grade_target'}='answer';
%moreenv=(%form,%moreenv);	%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;	return $userview;
}	}

Line 2850 sub findallcourses {	Line 2822 sub findallcourses {
$cnum = $cnumpart;	$cnum = $cnumpart;
($sec,$role) = split(/_/,$secpart);	($sec,$role) = split(/_/,$secpart);
$realsec = $sec;	$realsec = $sec;
}	}
$courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;	$courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
}	}
} else {	} else {
Line 2885 sub findallcourses {	Line 2857 sub findallcourses {

sub blockcheck {	sub blockcheck {
my ($setters,$activity,$uname,$udom) = @_;	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	# If uname and udom are for a course, check for blocks in the course.
# of specified user, unless user has 'evb' privilege.
	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 $startblock = 0;
my $endblock = 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)) {	foreach my $course (keys(%live_courses)) {
my ($cdom,$cnum);	my ($cdom,$cnum);
Line 2901 sub blockcheck {	Line 2908 sub blockcheck {
$cdom = $env{'course.'.$course.'.domain'};	$cdom = $env{'course.'.$course.'.domain'};
$cnum = $env{'course.'.$course.'.num'};	$cnum = $env{'course.'.$course.'.num'};
} else {	} else {
($cdom,$cnum) = split(/_/,$course);	($cdom,$cnum) = split(/_/,$course);
}	}
my $no_ownblock = 0;	my $no_ownblock = 0;
my $no_userblock = 0;	my $no_userblock = 0;
	if ($otheruser) {
	# 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}})) {	foreach my $sec (keys(%{$live_courses{$course}})) {
my $checkrole = 'cm./'.$cdom.'/'.$cnum;	my $checkrole = 'cm./'.$cdom.'/'.$cnum;
if ($sec ne 'none') {	if ($sec ne 'none') {
$checkrole .= '/'.$sec;	$checkrole .= '/'.$sec;
}	}
if ((defined($uname) && ($uname ne $env{'user.name'})) \|\|	if ($otheruser) {
(defined($udom) && ($udom ne $env{'user.domain'}))) {	# Resource belongs to user other than current user.
	# Assemble privs for that user, and check for 'evb' priv.
my ($trole,$tdom,$tnum,$tsec);	my ($trole,$tdom,$tnum,$tsec);
my $entry = $live_courses{$course}{$sec};	my $entry = $live_courses{$course}{$sec};
if ($entry =~ /^cr/) {	if ($entry =~ /^cr/) {
Line 2942 sub blockcheck {	Line 2968 sub blockcheck {
last;	last;
}	}
}	}
} else {	} else {
	# Resource belongs to current user
	# Check for 'evb' priv via lonnet::allowed().
if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {	if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
$no_ownblock = 1;	$no_ownblock = 1;
last;	last;
Line 2951 sub blockcheck {	Line 2979 sub blockcheck {
}	}
# if they have the evb priv and are currently not playing student	# if they have the evb priv and are currently not playing student
next if (($no_ownblock) &&	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);	next if ($no_userblock);

$setters->{$course} = {};	# Retrieve blocking times and identity of blocker for course
$setters->{$course}{'staff'} = [];	# of specified user, unless user has 'evb' privilege.
$setters->{$course}{'times'} = [];
my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);	my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
foreach my $record (keys(%records)) {	if (($start != 0) &&
my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);	(($startblock == 0) \|\| ($startblock > $start))) {
if ($start <= time && $end >= time) {	$startblock = $start;
my ($staff_name,$staff_dom,$title,$blocks) =	}
&parse_block_record($records{$record});	if (($end != 0) &&
if ($blocks->{$activity} eq 'on') {	(($endblock == 0) \|\| ($endblock < $end))) {
push(@{$$setters{$course}{'staff'}}, [$staff_name,$staff_dom]); push(@{$$setters{$course}{'times'}}, [$start,$end]);	$endblock = $end;
if ( ($startblock == 0) \|\| ($startblock > $1) ) {	}
$startblock = $1;	}
}	return ($startblock,$endblock);
if ( ($endblock == 0) \|\| ($endblock < $2) ) {	}
$endblock = $2;
}	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;
}	}
}	}
}	}
Line 3020 sub build_block_table {	Line 3069 sub build_block_table {
my %courseinfo=&Apache::lonnet::coursedescription($course);	my %courseinfo=&Apache::lonnet::coursedescription($course);
for (my $i=0; $i<@{$$setters{$course}{staff}}; $i++) {	for (my $i=0; $i<@{$$setters{$course}{staff}}; $i++) {
my ($uname,$udom) = @{$$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]};	my ($openblock,$closeblock) = @{$$setters{$course}{times}[$i]};
$openblock = &Apache::lonlocal::locallocaltime($openblock);	$openblock = &Apache::lonlocal::locallocaltime($openblock);
$closeblock= &Apache::lonlocal::locallocaltime($closeblock);	$closeblock= &Apache::lonlocal::locallocaltime($closeblock);
$output .= &Apache::loncommon::start_data_table_row().	$output .= &Apache::loncommon::start_data_table_row().
'<td>'.$courseinfo{'description'}.'</td>'.	'<td>'.$courseinfo{'description'}.'</td>'.
'<td>'.$openblock.' to '.$closeblock.'</td>'.	'<td>'.$openblock.' to '.$closeblock.'</td>'.
'<td>'.$fullname.'.</td>'.	'<td>'.$fullname.'</td>'.
&Apache::loncommon::end_data_table_row();	&Apache::loncommon::end_data_table_row();
}	}
}	}
$output .= &end_data_table();	$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	=pod
Line 3064 sub determinedomain {	Line 3176 sub determinedomain {
return $domain;	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	=pod

=item * &domainlogo()	=item * &domainlogo()
Line 3077 If the domain logo does not exist, a des	Line 3243 If the domain logo does not exist, a des

###############################################	###############################################
sub domainlogo {	sub domainlogo {
my $domain = &determinedomain(shift);	my $domain = &determinedomain(shift);
# See if there is a logo	my %designhash = &get_domainconf($domain);
if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {	# See if there is a logo
my $logo=&lonhttpdurl("/adm/lonDomLogos/$domain.gif");	if ($designhash{$domain.'.login.domlogo'} ne '') {
return '<img src="'.$logo.'" alt="'.$domain.'" />';	my $imgsrc = $designhash{$domain.'.login.domlogo'};
} elsif(exists($Apache::lonnet::domaindescription{$domain})) {	if ($imgsrc =~ /^\/(adm\|res)/) {
return $Apache::lonnet::domaindescription{$domain};	$imgsrc = &lonhttpdurl($imgsrc);
	}
	return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
	} elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
	return &Apache::lonnet::domain($domain,'description');
} else {	} else {
return '';	return '';
}	}
Line 3119 sub designparm {	Line 3289 sub designparm {
return $env{'environment.color.'.$which};	return $env{'environment.color.'.$which};
}	}
$domain=&determinedomain($domain);	$domain=&determinedomain($domain);
if (exists($designhash{$domain.'.'.$which})) {	my %domdesign = &get_domainconf($domain);
return $designhash{$domain.'.'.$which};	my $output;
	if ($domdesign{$domain.'.'.$which} ne '') {
	$output = $domdesign{$domain.'.'.$which};
} else {	} 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;
}	}

###############################################	###############################################
Line 3207 sub bodytag {	Line 3386 sub bodytag {
my ($role,$realm) = split(/\./,$env{'request.role'},2);	my ($role,$realm) = split(/\./,$env{'request.role'},2);
if ($role eq 'ca') {	if ($role eq 'ca') {
my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});	my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
$realm = &plainname($rname,$rdom).':'.$rdom;	$realm = &plainname($rname,$rdom);
}	}
# realm	# realm
if ($env{'request.course.id'}) {	if ($env{'request.course.id'}) {
Line 3342 ENDROLE	Line 3521 ENDROLE
# Top frame rendering, Remote is up	# Top frame rendering, Remote is up
#	#

my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.	my $imgsrc = $img;
$lonhttpdPort.$img.'" alt="'.$function.'" />';	if ($img =~ /^\/adm/) {
	$imgsrc = 'http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.$img;
	}
	my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';

# Explicit link to get inline menu	# Explicit link to get inline menu
my $menu= ($no_inline_link?''	my $menu= ($no_inline_link?''
Line 3503 sub standard_css {	Line 3685 sub standard_css {
my $mail_other = '#99BBBB';	my $mail_other = '#99BBBB';
my $mail_other_hover = '#669999';	my $mail_other_hover = '#669999';
my $table_header = '#DDDDDD';	my $table_header = '#DDDDDD';
	my $feedback_link_bg = '#BBBBBB';

my $border = ($env{'browser.type'} eq 'explorer') ? '0px 2px 0px 2px'	my $border = ($env{'browser.type'} eq 'explorer') ? '0px 2px 0px 2px'
: '0px 3px 0px 4px';	: '0px 3px 0px 4px';
Line 3510 sub standard_css {	Line 3693 sub standard_css {
return <<END;	return <<END;
h1, h2, h3, th { font-family: $sans }	h1, h2, h3, th { font-family: $sans }
a:focus { color: red; background: yellow }	a:focus { color: red; background: yellow }
table.thinborder { border-collapse: collapse; }	table.thinborder,
table.thinborder tr th { border-style: solid; border-width: 1px; background: $tabbg;}	table.LC_optres_prior {
table.thinborder tr td { border-style: solid; border-width: 1px}	border-collapse: collapse;
	}
	table.thinborder tr th {
	border-style: solid;
	border-width: 1px;
	background: $tabbg;
	}
	table.thinborder tr td,
	table.LC_optres_prior tr td {
	border-style: solid;
	border-width: 1px
	}

form, .inline { display: inline; }	form, .inline { display: inline; }
.center { text-align: center; }	.center { text-align: center; }
Line 3655 td.LC_table_cell_checkbox {	Line 3849 td.LC_table_cell_checkbox {
font-size: smaller;	font-size: smaller;
}	}

	.LC_menu_category {
	color: $font;
	font-family: $sans;
	font-size: larger;
	font-weight: bold;
	}

td.LC_menubuttons_text {	td.LC_menubuttons_text {
color: $font;	color: $font;
font-family: $sans;	font-family: $sans;
Line 3684 table.LC_data_table, table.LC_mail_list	Line 3885 table.LC_data_table, table.LC_mail_list
.LC_data_table_dense {	.LC_data_table_dense {
font-size: small;	font-size: small;
}	}
	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_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th {
font-weight: bold;	font-weight: bold;
background-color: $data_table_head;	background-color: $data_table_head;
Line 3702 table.LC_data_table tr.LC_data_table_hig	Line 3915 table.LC_data_table tr.LC_data_table_hig
background-color: $data_table_darker;	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_whatsnew tr.LC_empty_row td {	table.LC_nested tr.LC_empty_row td {
background-color: #FFFFFF;	background-color: #FFFFFF;
font-weight: bold;	font-weight: bold;
font-style: italic;	font-style: italic;
text-align: center;	text-align: center;
padding: 8px;	padding: 8px;
}	}
table.LC_whatsnew tr.LC_empty_row td {	table.LC_nested tr.LC_empty_row td {
padding: 4ex	padding: 4ex
}	}
table.LC_whatsnew {	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 {
table.LC_whatsnew tr th,	background-color: $data_table_head;
table.LC_whatsnew tr.LC_info_row td {
background-color: #CCC;
font-weight: bold;	font-weight: bold;
font-size: small;	font-size: small;
	border-bottom: 1px solid #000000;
text-align: right;	text-align: right;
}	}
table.LC_whatsnew tr td {	table.LC_nested tr.LC_info_row td {
background-color: #FFF;	background-color: #CCC;
	font-weight: bold;
font-size: small;	font-size: small;
text-align: right;	text-align: center;
}	}
table.LC_whatsnew tr td.LC_first_item {	table.LC_nested tr.LC_info_row td.LC_left_item {
text-align: left;	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_whatsnew tr.LC_odd_row td {	table.LC_nested tr.LC_odd_row td {
background-color: #EEE;	background-color: #EEE;
}	}

Line 3790 table.LC_mail_list tr.LC_mail_other {	Line 4017 table.LC_mail_list tr.LC_mail_other {
table.LC_mail_list tr.LC_mail_other:hover {	table.LC_mail_list tr.LC_mail_other:hover {
background-color: $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 {	table#LC_portfolio_actions {
width: auto;	width: auto;
Line 4034 table.LC_descriptive_input td.LC_descrip	Line 4266 table.LC_descriptive_input td.LC_descrip
text-align: right;	text-align: right;
font-weight: bold;	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-width: 1px;
	border-style: solid;
	border-color: gray;
	border-collapse: collapse;
	}
	table.LC_prior_tries th,
	table.LC_prior_tries td {
	border-width: 1px;
	border-style: solid;
	border-color: gray;
	padding: 3px;
	}
	table.LC_prior_tries tr.LC_correct {
	font-weight: bold;
	background: #aaffaa;
	}
	span.LC_prior_numerical {
	font-family: monospace;
	white-space: pre;
	}

	span.LC_nobreak {
	white-space: nowrap;
	}

END	END
}	}
Line 4326 Inputs: $args - additional optio	Line 4591 Inputs: $args - additional optio
a html attribute	a html attribute
frameset -> if true will start with a <frameset>	frameset -> if true will start with a <frameset>
rather than <body>	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	=cut

Line 4784 sub get_course_users {	Line 5054 sub get_course_users {
$usec = 'none';	$usec = 'none';
}	}
if ($uname ne '' && $udom ne '') {	if ($uname ne '' && $udom ne '') {
if ($end < $now) {	if ($end > 0 && $end < $now) {
$status = 'previous';	$status = 'previous';
} elsif ($start > $now) {	} elsif ($start > $now) {
$status = 'future';	$status = 'future';
Line 5226 sub record_sep {	Line 5496 sub record_sep {
} else {	} else {
my @allfields;	my @allfields;
if ($env{'form.upfiletype'} eq 'semisv') {	if ($env{'form.upfiletype'} eq 'semisv') {
@allfields=split(/;/,$record);	@allfields=split(/;/,$record,-1);
} else {	} else {
@allfields=split(/\,/,$record);	@allfields=split(/\,/,$record,-1);
}	}
my $i=0;	my $i=0;
my $j;	my $j;
Line 5922 Returns: both routines return nothing	Line 6192 Returns: both routines return nothing
#######################################################	#######################################################
#######################################################	#######################################################
sub store_course_settings {	sub store_course_settings {
	return &store_settings($env{'request.course.id'},@_);
	}

	sub store_settings {
# save to the environment	# save to the environment
# appenv the same items, just to be safe	# appenv the same items, just to be safe
my $courseid = $env{'request.course.id'};
my $udom = $env{'user.domain'};	my $udom = $env{'user.domain'};
my $uname = $env{'user.name'};	my $uname = $env{'user.name'};
my ($prefix,$Settings) = @_;	my ($context,$prefix,$Settings) = @_;
my %SaveHash;	my %SaveHash;
my %AppHash;	my %AppHash;
while (my ($setting,$type) = each(%$Settings)) {	while (my ($setting,$type) = each(%$Settings)) {
my $basename = join('.','internal',$courseid,$prefix,$setting);	my $basename = join('.','internal',$context,$prefix,$setting);
my $envname = 'environment.'.$basename;	my $envname = 'environment.'.$basename;
if (exists($env{'form.'.$setting})) {	if (exists($env{'form.'.$setting})) {
# Save this value away	# Save this value away
Line 5971 sub store_course_settings {	Line 6244 sub store_course_settings {
}	}

sub restore_course_settings {	sub restore_course_settings {
my $courseid = $env{'request.course.id'};	return &restore_settings($env{'request.course.id'},@_);
my ($prefix,$Settings) = @_;	}

	sub restore_settings {
	my ($context,$prefix,$Settings) = @_;
while (my ($setting,$type) = each(%$Settings)) {	while (my ($setting,$type) = each(%$Settings)) {
next if (exists($env{'form.'.$setting}));	next if (exists($env{'form.'.$setting}));
my $envname = 'environment.internal.'.$courseid.'.'.$prefix.	my $envname = 'environment.internal.'.$context.'.'.$prefix.
'.'.$setting;	'.'.$setting;
if (exists($env{$envname})) {	if (exists($env{$envname})) {
if ($type eq 'scalar') {	if ($type eq 'scalar') {
Line 6292 sub construct_course {	Line 6568 sub construct_course {
my ($user,$domain) = split(':',$args->{'keyauth'});	my ($user,$domain) = split(':',$args->{'keyauth'});
$user = &LONCAPA::clean_username($user);	$user = &LONCAPA::clean_username($user);
$domain = &LONCAPA::clean_username($domain);	$domain = &LONCAPA::clean_username($domain);
if ($user ne '' && $domain ne '');	if ($user ne '' && $domain ne '') {
$cenv{'keyauth'}=$user.':'.$domain;	$cenv{'keyauth'}=$user.':'.$domain;
}	}
}	}
Line 6390 sub group_term {	Line 6666 sub group_term {

sub icon {	sub icon {
my ($file)=@_;	my ($file)=@_;
my $curfext = (split(/\./,$file))[-1];	my $curfext = lc((split(/\./,$file))[-1]);
my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';	my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
my $embstyle = &Apache::loncommon::fileembstyle($curfext);	my $embstyle = &Apache::loncommon::fileembstyle($curfext);
if (!(!defined($embstyle) \|\| $embstyle eq 'unk' \|\| $embstyle eq 'hdn')) {	if (!(!defined($embstyle) \|\| $embstyle eq 'unk' \|\| $embstyle eq 'hdn')) {

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.487
changed lines
	Added in v.1.521