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.278 and 1.309

version 1.278, 2005/10/04 18:49:32	version 1.309, 2006/03/16 21:23:51
Line 331 sub storeresurl {	Line 331 sub storeresurl {
sub studentbrowser_javascript {	sub studentbrowser_javascript {
unless (	unless (
(($env{'request.course.id'}) &&	(($env{'request.course.id'}) &&
(&Apache::lonnet::allowed('srm',$env{'request.course.id'})))	(&Apache::lonnet::allowed('srm',$env{'request.course.id'})
	\|\| &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
	'/'.$env{'request.course.sec'})
	))
\|\| ($env{'request.role'}=~/^(au\|dc\|su)/)	\|\| ($env{'request.role'}=~/^(au\|dc\|su)/)
) { return ''; }	) { return ''; }
return (<<'ENDSTDBRW');	return (<<'ENDSTDBRW');
Line 362 ENDSTDBRW	Line 365 ENDSTDBRW
sub selectstudent_link {	sub selectstudent_link {
my ($form,$unameele,$udomele)=@_;	my ($form,$unameele,$udomele)=@_;
if ($env{'request.course.id'}) {	if ($env{'request.course.id'}) {
unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) {	if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
	&& !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
	'/'.$env{'request.course.sec'})) {
return '';	return '';
}	}
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.	return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
Line 380 sub coursebrowser_javascript {	Line 385 sub coursebrowser_javascript {
return (<<ENDSTDBRW);	return (<<ENDSTDBRW);
<script type="text/javascript" language="Javascript" >	<script type="text/javascript" language="Javascript" >
var stdeditbrowser;	var stdeditbrowser;
function opencrsbrowser(formname,uname,udom,desc,extra_element) {	function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag) {
var url = '/adm/pickcourse?';	var url = '/adm/pickcourse?';
var filter;	var filter;
if (filter != null) {	if (filter != null) {
Line 403 sub coursebrowser_javascript {	Line 408 sub coursebrowser_javascript {
url += '&domainfilter='+extra_element;	url += '&domainfilter='+extra_element;
}	}
}	}
	if (multflag !=null && multflag != '') {
	url += '&multiple='+multflag;
	}
var title = 'Course_Browser';	var title = 'Course_Browser';
var options = 'scrollbars=1,resizable=1,menubar=0';	var options = 'scrollbars=1,resizable=1,menubar=0';
options += ',width=700,height=600';	options += ',width=700,height=600';
Line 414 ENDSTDBRW	Line 422 ENDSTDBRW
}	}

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

sub check_uncheck_jscript {	sub check_uncheck_jscript {
Line 1149 sub domain_select {	Line 1157 sub domain_select {
} &get_domains;	} &get_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);
} else {	} else {
return &select_form($name,$value,%domains);	return &select_form($name,$value,%domains);
}	}
}	}

	#-------------------------------------------

	=pod

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

	Returns a string containing a <select> element int multiple mode


	Args:
	$name - name of the <select> element
	$value - sclara 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

	=cut

	#-------------------------------------------
sub multiple_select_form {	sub multiple_select_form {
my ($name,$value,$size,%hash)=@_;	my ($name,$value,$size,$hash,$order)=@_;
my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);	my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
my $output='';	my $output='';
if (! defined($size)) {	if (! defined($size)) {
$size = 4;	$size = 4;
if (scalar(keys(%hash))<4) {	if (scalar(keys(%$hash))<4) {
$size = scalar(keys(%hash));	$size = scalar(keys(%$hash));
}	}
}	}
$output.="\n<select name='$name' size='$size' multiple='1'>";	$output.="\n<select name='$name' size='$size' multiple='1'>";
foreach (sort(keys(%hash))) {	my @order = ref($order) ? @$order
$output.='<option value="'.$_.'" ';	: sort(keys(%$hash));
$output.='selected="selected" ' if ($selected{$_});	foreach my $key (@order) {
$output.='>'.$hash{$_}."</option>\n";	$output.='<option value="'.$key.'" ';
	$output.='selected="selected" ' if ($selected{$key});
	$output.='>'.$hash->{$key}."</option>\n";
}	}
$output.="</select>\n";	$output.="</select>\n";
return $output;	return $output;
Line 1565 sub authform_nochange{	Line 1595 sub authform_nochange{
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);
my $result = &mt('[_1] Do not change login data',	my $result = '<label>'.&mt('[_1] Do not change login data',
'<input type="radio" name="login" value="nochange" '.	'<input type="radio" name="login" value="nochange" '.
'checked="checked" onclick="'.	'checked="checked" onclick="'.
"javascript:changed_radio('nochange',$in{'formname'});".'" />');	"javascript:changed_radio('nochange',$in{'formname'});".'" />').
	'</label>';
return $result;	return $result;
}	}

Line 1600 sub authform_kerberos{	Line 1631 sub authform_kerberos{
my $jscall = "javascript:changed_radio('krb',$in{'formname'});";	my $jscall = "javascript:changed_radio('krb',$in{'formname'});";
my $result .= &mt	my $result .= &mt
('[_1] Kerberos authenticated with domain [_2] '.	('[_1] Kerberos authenticated with domain [_2] '.
'[_3] Version 4 [_4] Version 5',	'[_3] Version 4 [_4] Version 5 [_5]',
'<input type="radio" name="login" value="krb" '.	'<label><input type="radio" name="login" value="krb" '.
'onclick="'.$jscall.'" onchange="'.$jscall.'"'.$krbcheck.' />',	'onclick="'.$jscall.'" onchange="'.$jscall.'"'.$krbcheck.' />',
'<input type="text" size="10" name="krbarg" '.	'</label><input type="text" size="10" name="krbarg" '.
'value="'.$krbarg.'" '.	'value="'.$krbarg.'" '.
'onchange="'.$jscall.'" />',	'onchange="'.$jscall.'" />',
'<input type="radio" name="krbver" value="4" '.$check4.' />',	'<label><input type="radio" name="krbver" value="4" '.$check4.' />',
'<input type="radio" name="krbver" value="5" '.$check5.' />');	'</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
	'</label>');
return $result;	return $result;
}	}

Line 1632 sub authform_internal{	Line 1664 sub authform_internal{
my $jscall = "javascript:changed_radio('int',$args{'formname'});";	my $jscall = "javascript:changed_radio('int',$args{'formname'});";
my $result.=&mt	my $result.=&mt
('[_1] Internally authenticated (with initial password [_2])',	('[_1] Internally authenticated (with initial password [_2])',
'<input type="radio" name="login" value="int" '.$intcheck.	'<label><input type="radio" name="login" value="int" '.$intcheck.
' onchange="'.$jscall.'" onclick="'.$jscall.'" />',	' onchange="'.$jscall.'" onclick="'.$jscall.'" />',
'<input type="text" size="10" name="intarg" '.$intarg.	'</label><input type="text" size="10" name="intarg" '.$intarg.
' onchange="'.$jscall.'" />');	' onchange="'.$jscall.'" />');
return $result;	return $result;
}	}
Line 1659 sub authform_local{	Line 1691 sub authform_local{

my $jscall = "javascript:changed_radio('loc',$in{'formname'});";	my $jscall = "javascript:changed_radio('loc',$in{'formname'});";
my $result.=&mt('[_1] Local Authentication with argument [_2]',	my $result.=&mt('[_1] Local Authentication with argument [_2]',
'<input type="radio" name="login" value="loc" '.$loccheck.	'<label><input type="radio" name="login" value="loc" '.$loccheck.
' onchange="'.$jscall.'" onclick="'.$jscall.'" />',	' onchange="'.$jscall.'" onclick="'.$jscall.'" />',
'<input type="text" size="10" name="locarg" '.$locarg.	'</label><input type="text" size="10" name="locarg" '.$locarg.
' onchange="'.$jscall.'" />');	' onchange="'.$jscall.'" />');
return $result;	return $result;
}	}
Line 1675 sub authform_filesystem{	Line 1707 sub authform_filesystem{
my $jscall = "javascript:changed_radio('fsys',$in{'formname'});";	my $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
my $result.= &mt	my $result.= &mt
('[_1] Filesystem Authenticated (with initial password [_2])',	('[_1] Filesystem Authenticated (with initial password [_2])',
'<input type="radio" name="login" value="fsys" '.	'<label><input type="radio" name="login" value="fsys" '.
'onchange="'.$jscall.'" onclick="'.$jscall.'" />',	'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
'<input type="text" size="10" name="fsysarg" value="" '.	'</label><input type="text" size="10" name="fsysarg" value="" '.
'onchange="'.$jscall.'" />');	'onchange="'.$jscall.'" />');
return $result;	return $result;
}	}
Line 1893 if $first is set to 'lastname' then it r	Line 1925 if $first is set to 'lastname' then it r

=cut	=cut


###############################################################	###############################################################
sub plainname {	sub plainname {
my ($uname,$udom,$first)=@_;	my ($uname,$udom,$first)=@_;
my %names=&Apache::lonnet::get('environment',	my %names=&getnames($uname,$udom);
['firstname','middlename','lastname','generation'],
$udom,$uname);
my $name=&Apache::lonnet::format_name($names{'firstname'},	my $name=&Apache::lonnet::format_name($names{'firstname'},
$names{'middlename'},	$names{'middlename'},
$names{'lastname'},	$names{'lastname'},
Line 1929 if the user does not	Line 1960 if the user does not

sub nickname {	sub nickname {
my ($uname,$udom)=@_;	my ($uname,$udom)=@_;
my %names;	my %names=&getnames($uname,$udom);
if ($uname eq $env{'user.name'} &&
$udom eq $env{'user.domain'}) {
%names=('nickname' => $env{'environment.nickname'} ,
'firstname' => $env{'environment.firstname'} ,
'middlename' => $env{'environment.middlename'},
'lastname' => $env{'environment.lastname'} ,
'generation' => $env{'environment.generation'});
} else {
%names=&Apache::lonnet::get('environment',
['nickname','firstname','middlename',
'lastname','generation'],$udom,$uname);
}
my $name=$names{'nickname'};	my $name=$names{'nickname'};
if ($name) {	if ($name) {
$name='"'.$name.'"';	$name='"'.$name.'"';
Line 1954 sub nickname {	Line 1973 sub nickname {
return $name;	return $name;
}	}

	sub getnames {
	my ($uname,$udom)=@_;
	my $id=$uname.':'.$udom;
	my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
	if ($cached) {
	return %{$names};
	} else {
	my %loadnames=&Apache::lonnet::get('environment',
	['firstname','middlename','lastname','generation','nickname'],
	$udom,$uname);
	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
	return %loadnames;
	}
	}

# ------------------------------------------------------------------ Screenname	# ------------------------------------------------------------------ Screenname

Line 2509 sub pgrdlink {	Line 2542 sub pgrdlink {
Inputs: $text $uname $udom $symb $target	Inputs: $text $uname $udom $symb $target

Returns: A link to parmset.pm such as to see the PPRM view of a	Returns: A link to parmset.pm such as to see the PPRM view of a
student andn resource	student and a specific resource

=cut	=cut

Line 2704 Inputs:	Line 2737 Inputs:
=item * $forcereg, if page should register as content page (relevant for	=item * $forcereg, if page should register as content page (relevant for
text interface only)	text interface only)

	=item * $customtitle, overrides the $title in some way ????

	=item * $notopbar, if true, keep the 'what is this' info but remove the
	navigational links
=back	=back

Returns: A uniform header for LON-CAPA web pages.	Returns: A uniform header for LON-CAPA web pages.
Line 2714 other decorations will be returned.	Line 2751 other decorations will be returned.
=cut	=cut

sub bodytag {	sub bodytag {
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,$notopbar)=@_;	my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,
	$notopbar)=@_;
$title=&mt($title);	$title=&mt($title);
$function = &get_users_function() if (!$function);	$function = &get_users_function() if (!$function);
my $img=&designparm($function.'.img',$domain);	my $img=&designparm($function.'.img',$domain);
Line 2750 sub bodytag {	Line 2788 sub bodytag {
<style type="text/css">	<style type="text/css">
h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }	h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
a:focus { color: red; background: yellow }	a:focus { color: red; background: yellow }
	table.thinborder { border-collapse: collapse; }
	table.thinborder tr th, table.thinborder tr td { border-style: solid; border-width: 1px}
	form, .inline { display: inline; }
	.center { text-align: center; }
	.filename {font-family: monospace;}
</style>	</style>
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"	<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
style="margin-top: 0px;$addstyle" $addentries>	style="margin-top: 0px;$addstyle" $addentries>
Line 2855 ENDROLE	Line 2898 ENDROLE
$dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};	$dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
$dc_info = '('.$dc_info.')';	$dc_info = '('.$dc_info.')';
}	}
	# Explicit link to get inline menu
	my $menu='<br /><font size="2" face="Arial, Helvetica, sans-serif"> <a href="/adm/remote?action=collapse">'.&mt('Switch to Inline Menu Mode').'</a></font>';
#	#
return(<<ENDBODY);	return(<<ENDBODY);
$bodytag	$bodytag
Line 2865 $upperleft</td>	Line 2910 $upperleft</td>
</tr>	</tr>
<tr>	<tr>
<td rowspan="3" bgcolor="$tabbg">	<td rowspan="3" bgcolor="$tabbg">
$titleinfo $dc_info	$titleinfo $dc_info $menu
</td><td bgcolor="$tabbg" align="right">	</td><td bgcolor="$tabbg" align="right">
<font size="2" face="Arial, Helvetica, sans-serif">	<font size="2" face="Arial, Helvetica, sans-serif">
$env{'environment.firstname'}	$env{'environment.firstname'}
Line 2891 ENDBODY	Line 2936 ENDBODY

=back	=back

=head1 HTTP Helpers	=head1 HTML Helpers

=over 4	=over 4

Line 2899 ENDBODY	Line 2944 ENDBODY

Returns a uniform footer for LON-CAPA web pages.	Returns a uniform footer for LON-CAPA web pages.

Inputs:	Inputs: none

=over 4

=back	=back

Returns: A uniform footer for LON-CAPA web pages.

=cut	=cut

sub endbodytag {	sub endbodytag {
Line 2915 sub endbodytag {	Line 2956 sub endbodytag {
return $endbodytag;	return $endbodytag;
}	}

	=pod

	=over 4

	=item * &headtag()

	Returns a uniform footer for LON-CAPA web pages.

	Inputs: $title - optional title for the head
	$head_extra - optional extra HTML to put inside the <head>

	=back

	=cut

	sub headtag {
	my ($title,$head_extra) = @_;

	my $result =
	'<head>'.
	&Apache::lonxml::fontsettings().
	&Apache::lonhtmlcommon::htmlareaheaders();

	if (!defined($title)) {
	$title = 'The LearningOnline Network with CAPA';
	}

	$result .= '<title>'.&mt($title).'</title>'.$head_extra;

	return $result;
	}

	=pod

	=over 4

	=item * &endheadtag()

	Returns a uniform </head> for LON-CAPA web pages.

	Inputs: none

	=back

	=cut

	sub endheadtag {
	return '</head>';
	}

	=pod

	=over 4

	=item * &head()

	Returns a uniform complete <head>..</head> section for LON-CAPA web pages.

	Inputs: $title - optional title for the page
	$head_extra - optional extra HTML to put inside the <head>
	=back

	=cut

	sub head {
	my ($title,$head_extra) = @_;
	return &headtag($title,$head_extra).&endheadtag();
	}

	=pod

	=over 4

	=item * &start_page()

	Returns a complete <html> .. <body> section for LON-CAPA web pages.

	Inputs: $title - optional title for the page
	$head_extra - optional extra HTML to incude inside the <head>
	%args - additional optional args supported are:
	onlybody -> is true will set &bodytag() onlybodytag arg on
	notopbar -> is true will set &bodytag() notopbar arg on

	=back

	=cut

	sub start_page {
	my ($title,$head_extra,$args) = @_;
	return
	&Apache::lonxml::xmlbegin().
	&headtag($title,$head_extra).&endheadtag().
	&bodytag($title,undef,undef,$args->{'onlybody'},undef,undef,undef,
	$args->{'notopbar'});
	}

	=pod

	=over 4

	=item * &head()

	Returns a complete </body></html> section for LON-CAPA web pages.

	Inputs: None

	=back

	=cut

	sub end_page {
	return &endbodytag."\n</html>";
	}
###############################################	###############################################

=pod	=pod

	=over 4

=item get_users_function	=item get_users_function

Used by &bodytag to determine the current users primary role.	Used by &bodytag to determine the current users primary role.
Line 3052 sub get_sections {	Line 3208 sub get_sections {
}	}

###############################################	###############################################

	=pod

	=item coursegroups

	Retrieve information about groups in a course,

	Input:
	1. Reference to hash to populate with group information.
	2. Optional course domain
	3. Optional course number
	4. Optional group name

	Course domain and number will be taken from user's
	environment if not supplied. Optional group name will'
	be passed to lonnet::get_coursegroups() as a regexp to
	use in the call to the dump function.

	Output
	Returns number of groups in the course (subject to the
	optional group name filter).

	Side effects:
	Populates the referenced curr_groups hash, with key,
	value pairs. Keys are group names, corresponding values
	are scalars containing group information in XML. This
	can be sent to &get_group_settings() to be parsed.

	=cut

	###############################################

	sub coursegroups {
	my ($curr_groups,$cdom,$cnum,$group) = @_;
	my $numgroups;
	if (!defined($cdom) \|\| !defined($cnum)) {
	my $cid = $env{'request.course.id'};
	$cdom = $env{'course.'.$cid.'.domain'};
	$cnum = $env{'course.'.$cid.'.num'};
	}
	%{$curr_groups} = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group);
	my ($tmp) = keys(%{$curr_groups});
	if ($tmp=~/^error:/) {
	unless ($tmp eq 'error: 2 tie(GDBM) Failed while attempting dump') {
	&logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.
	$cdom);
	}
	$numgroups = 0;
	} else {
	$numgroups = keys(%{$curr_groups});
	}
	return $numgroups;
	}

	###############################################

	=pod

	=item get_group_settings

	Uses TokeParser to extract group information from the
	XML used to describe course groups.

	Input:
	Scalar containing XML - as retrieved from &coursegroups().

	Output:
	Hash containing group information as key=values for (a), and
	hash of hashes for (b)

	Keys (in two categories):
	(a) groupname, creator, creation, modified, startdate,enddate.
	Corresponding values are name of the group, creator of the group
	(username:domain), UNIX time for date group was created, and
	settings were last modified, and default start and end access
	times for group members.

	(b) functions returned in hash of hashes.
	Outer hash key is functions.
	Inner hash keys are chat,discussion,email,files,homepage,roster.
	Corresponding values are either on or off, depending on
	whether this type of functionality is available for the group.

	=cut

	###############################################

	sub get_group_settings {
	my ($groupinfo)=@_;
	my $parser=HTML::TokeParser->new(\$groupinfo);
	my $token;
	my $tool = '';
	my $role = '';
	my %content=();
	while ($token=$parser->get_token) {
	if ($token->[0] eq 'S') {
	my $entry=$token->[1];
	if ($entry eq 'functions' \|\| $entry eq 'autosec') {
	%{$content{$entry}} = ();
	$tool = $entry;
	} elsif ($entry eq 'role') {
	if ($tool eq 'autosec') {
	$role = $token->[2]{id};
	}
	} else {
	my $value=$parser->get_text('/'.$entry);
	if ($entry eq 'name') {
	if ($tool eq 'functions') {
	my $function = $token->[2]{id};
	$content{$tool}{$function} = $value;
	}
	} elsif ($entry eq 'groupname') {
	$content{$entry}=&Apache::lonnet::unescape($value);
	} elsif (($entry eq 'roles') \|\| ($entry eq 'types') \|\|
	($entry eq 'sectionpick') \|\| ($entry eq 'defpriv')) {
	push(@{$content{$entry}},$value);
	} elsif ($entry eq 'section') {
	if ($tool eq 'autosec' && $role ne '') {
	push(@{$content{$tool}{$role}},$value);
	}
	} else {
	$content{$entry}=$value;
	}
	}
	} elsif ($token->[0] eq 'E') {
	if ($token->[1] eq 'functions' \|\| $token->[1] eq 'autosec') {
	$tool = '';
	} elsif ($token->[1] eq 'role') {
	$role = '';
	}

	}
	}
	return %content;
	}

	sub check_group_access {
	my ($group) = @_;
	my $access = 1;
	my $now = time;
	my ($start,$end) = split(/\./,$env{'user.role.gr/'.$env{'request.course,id'}.'/'.$group});
	if (($end!=0) && ($end<$now)) { $access = 0; }
	if (($start!=0) && ($start>$now)) { $access=0; }
	return $access;
	}

	###############################################

=pod	=pod

Line 3066 Incoming parameters:	Line 3369 Incoming parameters:
3. access status: users must have - either active,	3. access status: users must have - either active,
previous, future, or all.	previous, future, or all.
4. reference to array of permissible roles	4. reference to array of permissible roles
5. reference to results object (hash of hashes).	5. reference to array of section restrictions (optional)
	6. reference to results object (hash of hashes).
	7. reference to optional userdata hash
Keys of top level hash are roles.	Keys of top level hash are roles.
Keys of inner hashes are username:domain, with	Keys of inner hashes are username:domain, with
values set to access type.	values set to access type.
	Optional userdata hash returns an array with arguments in the
	same order as loncoursedata::get_classlist() for student data.

	Entries for end, start, section and status are blank because
	of the possibility of multiple values for non-student roles.

=cut	=cut

###############################################	###############################################

sub get_course_users {	sub get_course_users {
my ($cdom,$cnum,$types,$roles,$users) = @_;	my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata) = @_;
if (grep/^st$/,@{$roles}) {	my %idx = ();
my $statusidx = &Apache::loncoursedata::CL_STATUS();
my $startidx = &Apache::loncoursedata::CL_START();	$idx{udom} = &Apache::loncoursedata::CL_SDOM();
my $endidx = &Apache::loncoursedata::CL_END();	$idx{uname} = &Apache::loncoursedata::CL_SNAME();
	$idx{end} = &Apache::loncoursedata::CL_END();
	$idx{start} = &Apache::loncoursedata::CL_START();
	$idx{id} = &Apache::loncoursedata::CL_ID();
	$idx{section} = &Apache::loncoursedata::CL_SECTION();
	$idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
	$idx{status} = &Apache::loncoursedata::CL_STATUS();

	if (grep(/^st$/,@{$roles})) {
my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);	my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
my $now = time;	my $now = time;
foreach my $student (keys(%{$classlist})) {	foreach my $student (keys(%{$classlist})) {
	my $match = 0;
	if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
	unless(grep(/^\Q$$classlist{$student}[$idx{section}]\E$/,
	@{$sections})) {
	next;
	}
	}
if (defined($$types{'active'})) {	if (defined($$types{'active'})) {
if ($$classlist{$student}[$statusidx] eq 'Active') {	if ($$classlist{$student}[$idx{status}] eq 'Active') {
push(@{$$users{st}{$student}},'active');	push(@{$$users{st}{$student}},'active');
	$match = 1;
}	}
}	}
if (defined($$types{'previous'})) {	if (defined($$types{'previous'})) {
if ($$classlist{$student}[$endidx] <= $now) {	if ($$classlist{$student}[$idx{end}] <= $now) {
push(@{$$users{st}{$student}},'previous');	push(@{$$users{st}{$student}},'previous');
	$match = 1;
}	}
}	}
if (defined($$types{'future'})) {	if (defined($$types{'future'})) {
if (($$classlist{$student}[$startidx] > $now) && ($$classlist{$student}[$endidx] > $now) \|\| ($$classlist{$student}[$endidx] == 0) \|\| ($$classlist{$student}[$endidx] eq '')) {	if (($$classlist{$student}[$idx{start}] > $now) && ($$classlist{$student}[$idx{end}] > $now) \|\| ($$classlist{$student}[$idx{end}] == 0) \|\| ($$classlist{$student}[$idx{end}] eq '')) {
push(@{$$users{st}{$student}},'future');	push(@{$$users{st}{$student}},'future');
	$match = 1;
}	}
}	}
	if ($match && defined($userdata)) {
	$$userdata{$student} = $$classlist{$student};
	}
}	}
}	}
if ((@{$roles} > 0) && (@{$roles} ne "st")) {	if ((@{$roles} > 0) && (@{$roles} ne "st")) {
my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum);	my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum);
foreach my $person (@coursepersonnel) {	foreach my $person (@coursepersonnel) {
	my $match = 0;
my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/);	my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/);
$user =~ s/:$//;	$user =~ s/:$//;
if (($role) && (grep(/^$role$/,@{$roles}))) {	if (($role) && (grep(/^\Q$role\E$/,@{$roles}))) {
my ($uname,$udom) = split(/:/,$user);	my ($uname,$udom,$usec) = split(/:/,$user);
	if ($usec ne '' && (ref($sections) eq 'ARRAY') &&
	@{$sections} > 0) {
	unless(grep(/^\Q$usec\E$/,@{$sections})) {
	next;
	}
	}
if ($uname ne '' && $udom ne '') {	if ($uname ne '' && $udom ne '') {
my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role);	my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role);
foreach my $type (keys(%{$types})) {	foreach my $type (keys(%{$types})) {
if ($status eq $type) {	if ($status eq $type) {
$$users{$role}{$user} = $type;	@{$$users{$role}{$user}} = $type;
	$match = 1;
}	}
}	}
	if ($match && defined($userdata) &&
	!exists($$userdata{$uname.':'.$udom})) {
	&get_user_info($udom,$uname,\%idx,$userdata);
	}
	}
	}
	}
	if (grep(/^ow$/,@{$roles})) {
	if ((defined($cdom)) && (defined($cnum))) {
	my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
	if ( defined($csettings{'internal.courseowner'}) ) {
	my $owner = $csettings{'internal.courseowner'};
	@{$$users{'ow'}{$owner.':'.$cdom}} = 'any';
	if (defined($userdata) &&
	!exists($$userdata{$owner.':'.$cdom})) {
	&get_user_info($cdom,$owner,\%idx,$userdata);
	}
}	}
}	}
}	}
Line 3122 sub get_course_users {	Line 3478 sub get_course_users {
return;	return;
}	}

	sub get_user_info {
	my ($udom,$uname,$idx,$userdata) = @_;
	$$userdata{$uname.':'.$udom}[$$idx{fullname}] =
	&plainname($uname,$udom,'lastname');
	$$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
	$$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
	return;
	}

###############################################	###############################################

Line 3262 sub no_cache {	Line 3625 sub no_cache {

sub content_type {	sub content_type {
my ($r,$type,$charset) = @_;	my ($r,$type,$charset) = @_;
	if ($r) {
	# Note that printout.pl calls this with undef for $r.
	&no_cache($r);
	}
if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }	if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
unless ($charset) {	unless ($charset) {
$charset=&Apache::lonlocal::current_encoding;	$charset=&Apache::lonlocal::current_encoding;
Line 3496 sub upfile_select_html {	Line 3863 sub upfile_select_html {
return $Str;	return $Str;
}	}

	sub get_samples {
	my ($records,$toget) = @_;
	my @samples=({});
	my $got=0;
	foreach my $rec (@$records) {
	my %temp = &record_sep($rec);
	if (! grep(/\S/, values(%temp))) { next; }
	if (%temp) {
	$samples[$got]=\%temp;
	$got++;
	if ($got == $toget) { last; }
	}
	}
	return \@samples;
	}

######################################################	######################################################
######################################################	######################################################

Line 3513 Apache Request ref, $records is an array	Line 3896 Apache Request ref, $records is an array
######################################################	######################################################
sub csv_print_samples {	sub csv_print_samples {
my ($r,$records) = @_;	my ($r,$records) = @_;
my (%sone,%stwo,%sthree);	my $samples = &get_samples($records,3);
%sone=&record_sep($$records[0]);
if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
#
$r->print(&mt('Samples').'<br /><table border="2"><tr>');	$r->print(&mt('Samples').'<br /><table border="2"><tr>');
foreach (sort({$a <=> $b} keys(%sone))) {	foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
$r->print('<th>'.&mt('Column [_1]',($_+1)).'</th>'); }	$r->print('<th>'.&mt('Column [_1]',($_+1)).'</th>'); }
$r->print('</tr>');	$r->print('</tr>');
foreach my $hash (\%sone,\%stwo,\%sthree) {	foreach my $hash (@$samples) {
$r->print('<tr>');	$r->print('<tr>');
foreach (sort({$a <=> $b} keys(%sone))) {	foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
$r->print('<td>');	$r->print('<td>');
if (defined($$hash{$_})) { $r->print($$hash{$_}); }	if (defined($$hash{$_})) { $r->print($$hash{$_}); }
$r->print('</td>');	$r->print('</td>');
Line 3553 $d is an array of 2 element arrays (inte	Line 3933 $d is an array of 2 element arrays (inte
######################################################	######################################################
sub csv_print_select_table {	sub csv_print_select_table {
my ($r,$records,$d) = @_;	my ($r,$records,$d) = @_;
my $i=0;my %sone;	my $i=0;
%sone=&record_sep($$records[0]);	my $samples = &get_samples($records,1);
$r->print(&mt('Associate columns with student attributes.')."\n".	$r->print(&mt('Associate columns with student attributes.')."\n".
'<table border="2"><tr>'.	'<table border="2"><tr>'.
'<th>'.&mt('Attribute').'</th>'.	'<th>'.&mt('Attribute').'</th>'.
Line 3566 sub csv_print_select_table {	Line 3946 sub csv_print_select_table {
$r->print('<td><select name=f'.$i.	$r->print('<td><select name=f'.$i.
' onchange="javascript:flip(this.form,'.$i.');">');	' onchange="javascript:flip(this.form,'.$i.');">');
$r->print('<option value="none"></option>');	$r->print('<option value="none"></option>');
foreach (sort({$a <=> $b} keys(%sone))) {	foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
$r->print('<option value="'.$_.'"'.	$r->print('<option value="'.$_.'"'.
($_ eq $defaultcol ? ' selected="selected" ' : '').	($_ eq $defaultcol ? ' selected="selected" ' : '').
'>Column '.($_+1).'</option>');	'>Column '.($_+1).'</option>');
Line 3597 $d is an array of 2 element arrays (inte	Line 3977 $d is an array of 2 element arrays (inte
######################################################	######################################################
sub csv_samples_select_table {	sub csv_samples_select_table {
my ($r,$records,$d) = @_;	my ($r,$records,$d) = @_;
my %sone; my %stwo; my %sthree;
my $i=0;	my $i=0;
#	#
	my $samples = &get_samples($records,3);
$r->print('<table border=2><tr><th>'.	$r->print('<table border=2><tr><th>'.
&mt('Field').'</th><th>'.&mt('Samples').'</th></tr>');	&mt('Field').'</th><th>'.&mt('Samples').'</th></tr>');
%sone=&record_sep($$records[0]);
if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}	foreach my $key (sort(keys(%{ $samples->[0] }))) {
if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
#
foreach (sort keys %sone) {
$r->print('<tr><td><select name="f'.$i.'"'.	$r->print('<tr><td><select name="f'.$i.'"'.
' onchange="javascript:flip(this.form,'.$i.');">');	' onchange="javascript:flip(this.form,'.$i.');">');
foreach (@$d) {	foreach my $option (@$d) {
my ($value,$display,$defaultcol)=@{ $_ };	my ($value,$display,$defaultcol)=@{ $option };
$r->print('<option value="'.$value.'"'.	$r->print('<option value="'.$value.'"'.
($i eq $defaultcol ? ' selected="selected" ':'').'>'.	($i eq $defaultcol ? ' selected="selected" ':'').'>'.
$display.'</option>');	$display.'</option>');
}	}
$r->print('</select></td><td>');	$r->print('</select></td><td>');
if (defined($sone{$_})) { $r->print($sone{$_}."<br />\n"); }	foreach my $line (0..2) {
if (defined($stwo{$_})) { $r->print($stwo{$_}."<br />\n"); }	if (defined($samples->[$line]{$key})) {
if (defined($sthree{$_})) { $r->print($sthree{$_}."<br />\n"); }	$r->print($samples->[$line]{$key}."<br />\n");
	}
	}
$r->print('</td></tr>');	$r->print('</td></tr>');
$i++;	$i++;
}	}
Line 3707 the routine &Apache::lonnet::transfer_pr	Line 4086 the routine &Apache::lonnet::transfer_pr
my $uniq=0;	my $uniq=0;
sub get_cgi_id {	sub get_cgi_id {
$uniq=($uniq+1)%100000;	$uniq=($uniq+1)%100000;
return (time.'_'.$uniq);	return (time.'_'.$$.'_'.$uniq);
}	}

############################################################	############################################################
Line 4127 sub store_course_settings {	Line 4506 sub store_course_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 $courseid = $env{'request.course.id'};
my $coursedom = $env{'course.'.$courseid.'.domain'};	my $udom = $env{'user.domain'};
	my $uname = $env{'user.name'};
my ($prefix,$Settings) = @_;	my ($prefix,$Settings) = @_;
my %SaveHash;	my %SaveHash;
my %AppHash;	my %AppHash;
while (my ($setting,$type) = each(%$Settings)) {	while (my ($setting,$type) = each(%$Settings)) {
my $basename = 'internal.'.$prefix.'.'.$setting;	my $basename = join('.','internal',$courseid,$prefix,$setting);
my $envname = 'course.'.$courseid.'.'.$basename;	my $envname = 'environment.'.$basename;
if (exists($env{'form.'.$setting})) {	if (exists($env{'form.'.$setting})) {
# Save this value away	# Save this value away
if ($type eq 'scalar' &&	if ($type eq 'scalar' &&
Line 4161 sub store_course_settings {	Line 4541 sub store_course_settings {
}	}
}	}
my $put_result = &Apache::lonnet::put('environment',\%SaveHash,	my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
$coursedom,	$udom,$uname);
$env{'course.'.$courseid.'.num'});
if ($put_result !~ /^(ok\|delayed)/) {	if ($put_result !~ /^(ok\|delayed)/) {
&Apache::lonnet::logthis('unable to save form parameters, '.	&Apache::lonnet::logthis('unable to save form parameters, '.
'got error:'.$put_result);	'got error:'.$put_result);
Line 4177 sub restore_course_settings {	Line 4556 sub restore_course_settings {
my ($prefix,$Settings) = @_;	my ($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 = 'course.'.$courseid.'.internal.'.$prefix.	my $envname = 'environment.internal.'.$courseid.'.'.$prefix.
'.'.$setting;	'.'.$setting;
if (exists($env{$envname})) {	if (exists($env{$envname})) {
if ($type eq 'scalar') {	if ($type eq 'scalar') {

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

Removed from v.1.278
changed lines
	Added in v.1.309