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.37 and 1.43

version 1.37, 2002/05/09 15:56:02	version 1.43, 2002/07/03 21:12:38
Line 33	Line 33
# 12/25,12/28 Gerd Kortemeyer	# 12/25,12/28 Gerd Kortemeyer
# YEAR=2002	# YEAR=2002
# 1/4 Gerd Kortemeyer	# 1/4 Gerd Kortemeyer
	# 6/24,7/2 H. K. Ng

# Makes a table out of the previous attempts	# Makes a table out of the previous attempts
# Inputs result_from_symbread, user, domain, course_id	# Inputs result_from_symbread, user, domain, course_id
Line 65 Current things done:	Line 66 Current things done:
This is part of the LearningOnline Network with CAPA project	This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.	described at http://www.lon-capa.org.

=head2 Subroutines	=head2 General Subroutines

=over 4	=over 4

Line 79 use Apache::lonnet();	Line 80 use Apache::lonnet();
use POSIX qw(strftime);	use POSIX qw(strftime);
use Apache::Constants qw(:common);	use Apache::Constants qw(:common);
use Apache::lonmsg();	use Apache::lonmsg();

my $readit;	my $readit;

# ----------------------------------------------- Filetypes/Languages/Copyright	# ----------------------------------------------- Filetypes/Languages/Copyright
my %language;	my %language;
my %cprtag;	my %cprtag;
my %fe; my %fd;	my %fe; my %fd;
my %fc;	my %category_extensions;

# -------------------------------------------------------------- Thesaurus data	# -------------------------------------------------------------- Thesaurus data
my @therelated;	my @therelated;
Line 99 my $thethreshold=0.1/$thefuzzy;	Line 99 my $thethreshold=0.1/$thefuzzy;
my $theavecount;	my $theavecount;

# ----------------------------------------------------------------------- BEGIN	# ----------------------------------------------------------------------- BEGIN

	=pod

=item BEGIN()	=item BEGIN()

Initialize values from language.tab, copyright.tab, filetypes.tab,	Initialize values from language.tab, copyright.tab, filetypes.tab,
Line 144 BEGIN {	Line 147 BEGIN {
while (<$fh>) {	while (<$fh>) {
next if /^\#/;	next if /^\#/;
chomp;	chomp;
my ($key,$val)=(split(/\s+/,$_,2));	my ($extension,$category)=(split(/\s+/,$_,2));
push @{$fc{$key}},$val;	push @{$category_extensions{lc($category)}},$extension;
}	}
}	}
}	}
Line 188 BEGIN {	Line 191 BEGIN {

}	}
# ============================================================= END BEGIN BLOCK	# ============================================================= END BEGIN BLOCK
	###############################################################
	## HTML and Javascript Helper Functions ##
	###############################################################

	=pod

	=item browser_and_searcher_javascript

	Returns scalar containing javascript to open a browser window
	or a searcher window. Also creates

	=over 4

	=item openbrowser(formname,elementname,only,omit) [javascript]

	inputs: formname, elementname, only, omit

	formname and elementname indicate the name of the html form and name of
	the element that the results of the browsing selection are to be placed in.

	Specifying 'only' will restrict the browser to displaying only files
	with the given extension. Can be a comma seperated list.

	Specifying 'omit' will restrict the browser to NOT displaying files
	with the given extension. Can be a comma seperated list.

	=item opensearcher(formname, elementname) [javascript]

	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 {
	return <<END;
	var editbrowser;
	function openbrowser(formname,elementname,only,omit) {
	var url = '/res/?';
	if (editbrowser == null) {
	url += 'launch=1&';
	}
	url += 'catalogmode=interactive&';
	url += 'mode=edit&';
	url += 'form=' + formname + '&';
	if (only != null) {
	url += 'only=' + only + '&';
	}
	if (omit != null) {
	url += 'omit=' + omit + '&';
	}
	url += 'element=' + elementname + '';
	var title = 'Browser';
	var options = 'scrollbars=1,resizable=1,menubar=0';
	options += ',width=700,height=600';
	editbrowser = open(url,title,options,'1');
	editbrowser.focus();
	}
	var editsearcher;
	function opensearcher(formname,elementname) {
	var url = '/adm/searchcat?';
	if (editsearcher == null) {
	url += 'launch=1&';
	}
	url += 'catalogmode=interactive&';
	url += 'mode=edit&';
	url += 'form=' + formname + '&';
	url += 'element=' + elementname + '';
	var title = 'Search';
	var options = 'scrollbars=1,resizable=1,menubar=0';
	options += ',width=700,height=600';
	editsearcher = open(url,title,options,'1');
	editsearcher.focus();
	}
	END
	}



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

	=pod

=item linked_select_forms(...)	=item linked_select_forms(...)

Line 213 linked_select_forms takes the following	Line 302 linked_select_forms takes the following

=item $hashref, a reference to a hash containing the data for the menus.	=item $hashref, a reference to a hash containing the data for the menus.

	=back

Below is an example of such a hash. Only the 'text', 'default', and	Below is an example of such a hash. Only the 'text', 'default', and
'select2' keys must appear as stated. keys(%menu) are the possible	'select2' keys must appear as stated. keys(%menu) are the possible
values for the first select menu. The text that coincides with the	values for the first select menu. The text that coincides with the
first menu values is given in $menu{$choice1}->{'text'}. The values	first menu value is given in $menu{$choice1}->{'text'}. The values
and text for the second menu are given in the hash pointed to by	and text for the second menu are given in the hash pointed to by
$menu{$choice1}->{'select2'}.	$menu{$choice1}->{'select2'}.

my %menu = ( A1 => { text =>"Choice A1" ,	my %menu = ( A1 => { text =>"Choice A1" ,
default => "B3",	default => "B3",
select2 => {	select2 => {
B1 => "Choice B1",	B1 => "Choice B1",
Line 739 sub copyrightdescription {	Line 830 sub copyrightdescription {

# ------------------------------------------------------------- File Categories	# ------------------------------------------------------------- File Categories
sub filecategories {	sub filecategories {
return sort(keys(%fc));	return sort(keys(%category_extensions));
}	}

# -------------------------------------- File Types within a specified category	# -------------------------------------- File Types within a specified category
sub filecategorytypes {	sub filecategorytypes {
return @{$fc{lc(shift(@_))}};	return @{$category_extensions{lc($_[0])}};
}	}

# ------------------------------------------------------------------ File Types	# ------------------------------------------------------------------ File Types
Line 768 sub filedescriptionex {	Line 859 sub filedescriptionex {
return '.'.$ex.' '.$fd{lc($ex)};	return '.'.$ex.' '.$fd{lc($ex)};
}	}

	# ---- Retrieve attempts by students
	# input
	# $symb - problem including path
	# $username,$domain - that of the student
	# $course - course name
	# $getattempt - leave blank if want all attempts, else put something.
	# $regexp - regular expression. If string matches regexp send to
	# $gradesub - routine that process the string if it matches regexp
	#
	# output
	# formatted as a table all the attempts, if any.
	#
sub get_previous_attempt {	sub get_previous_attempt {
my ($symb,$username,$domain,$course)=@_;	my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
my $prevattempts='';	my $prevattempts='';
	no strict 'refs';
if ($symb) {	if ($symb) {
my (%returnhash)=	my (%returnhash)=
&Apache::lonnet::restore($symb,$course,$domain,$username);	&Apache::lonnet::restore($symb,$course,$domain,$username);
Line 782 sub get_previous_attempt {	Line 886 sub get_previous_attempt {
$lasthash{$_}=$returnhash{$version.':'.$_};	$lasthash{$_}=$returnhash{$version.':'.$_};
}	}
}	}
$prevattempts='<table border=2></tr><th>History</th>';	$prevattempts='<table border="0" width="100%"><tr><td bgcolor="#777777">';
	$prevattempts.='<table border="0" width="100%"><tr bgcolor="#e6ffff"><td>History</td>';
foreach (sort(keys %lasthash)) {	foreach (sort(keys %lasthash)) {
my ($ign,@parts) = split(/\./,$_);	my ($ign,@parts) = split(/\./,$_);
if (@parts) {	if ($#parts > 0) {
my $data=$parts[-1];	my $data=$parts[-1];
pop(@parts);	pop(@parts);
$prevattempts.='<th>Part '.join('.',@parts).'<br />'.$data.'</th>';	$prevattempts.='<td>Part '.join('.',@parts).'<br />'.$data.' </td>';
} else {	} else {
$prevattempts.='<th>'.$ign.'</th>';	if ($#parts == 0) {
}	$prevattempts.='<th>'.$parts[0].'</th>';
}
for ($version=1;$version<=$returnhash{'version'};$version++) {
$prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
foreach (sort(keys %lasthash)) {
my $value;
if ($_ =~ /timestamp/) {
$value=scalar(localtime($returnhash{$version.':'.$_}));
} else {	} else {
$value=$returnhash{$version.':'.$_};	$prevattempts.='<th>'.$ign.'</th>';
}	}
$prevattempts.='<td>'.$value.'</td>';	}
}
}	}
$prevattempts.='</tr><tr><th>Current</th>';	if ($getattempt eq '') {
	for ($version=1;$version<=$returnhash{'version'};$version++) {
	$prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Transaction '.$version.'</td>';
	foreach (sort(keys %lasthash)) {
	my $value;
	if ($_ =~ /timestamp/) {
	$value=scalar(localtime($returnhash{$version.':'.$_}));
	} else {
	$value=$returnhash{$version.':'.$_};
	}
	$prevattempts.='<td>'.$value.' </td>';
	}
	}
	}
	$prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Current</td>';
foreach (sort(keys %lasthash)) {	foreach (sort(keys %lasthash)) {
my $value;	my $value;
if ($_ =~ /timestamp/) {	if ($_ =~ /timestamp/) {
Line 813 sub get_previous_attempt {	Line 924 sub get_previous_attempt {
} else {	} else {
$value=$lasthash{$_};	$value=$lasthash{$_};
}	}
$prevattempts.='<td>'.$value.'</td>';	if ($_ =~/$regexp$/) {$value = &$gradesub($value)}
	$prevattempts.='<td>'.$value.' </td>';
}	}
$prevattempts.='</tr></table>';	$prevattempts.='</tr></table></td></tr></table>';
} else {	} else {
$prevattempts='Nothing submitted - no attempts.';	$prevattempts='Nothing submitted - no attempts.';
}	}
Line 865 sub get_student_answers {	Line 977 sub get_student_answers {
foreach my $element (@elements) {	foreach my $element (@elements) {
$ENV{'form.grade_'.$element}=$old{$element};	$ENV{'form.grade_'.$element}=$old{$element};
}	}
$userview=~s/\<body[^\>]*\>//gi;
$userview=~s/\<\/body\>//gi;
$userview=~s/\<html\>//gi;
$userview=~s/\<\/html\>//gi;
$userview=~s/\<head\>//gi;
$userview=~s/\<\/head\>//gi;
$userview=~s/action\s*\=/would_be_action\=/gi;
return $userview;	return $userview;
}	}

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

=item get_unprocessed_cgi($query,$possible_names)

Modify the %ENV hash to contain unprocessed CGI form parameters held in
$query. The parameters listed in $possible_names (an array reference),
will be set in $ENV{'form.name'} if they do not already exist.

Typically called with $ENV{'QUERY_STRING'} as the first parameter.
$possible_names is an ref to an array of form element names. As an example:
get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
will result in $ENV{'form.uname'} and $ENV{'form.udom'} being set.

=cut

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

sub get_unprocessed_cgi {	sub get_unprocessed_cgi {
Line 942 sub add_to_env {	Line 1034 sub add_to_env {
}	}
}	}

#---CSV Upload/Handling functions	=pod

	=head2 CSV Upload/Handling functions

	=over 4

	=item upfile_store($r)

	Store uploaded file, $r should be the HTTP Request object,
	needs $ENV{'form.upfile'}
	returns $datatoken to be put into hidden field

# ========================================================= Store uploaded file	=cut
# needs $ENV{'form.upfile'}
# return $datatoken to be put into hidden field

sub upfile_store {	sub upfile_store {
my $r=shift;	my $r=shift;
Line 965 sub upfile_store {	Line 1065 sub upfile_store {
return $datatoken;	return $datatoken;
}	}

# ================================================= Load uploaded file from tmp	=item load_tmp_file($r)
# needs $ENV{'form.datatoken'}
# sets $ENV{'form.upfile'} to the contents of the file	Load uploaded file from tmp, $r should be the HTTP Request object,
	needs $ENV{'form.datatoken'},
	sets $ENV{'form.upfile'} to the contents of the file

	=cut

sub load_tmp_file {	sub load_tmp_file {
my $r=shift;	my $r=shift;
Line 982 sub load_tmp_file {	Line 1086 sub load_tmp_file {
$ENV{'form.upfile'}=join('',@studentdata);	$ENV{'form.upfile'}=join('',@studentdata);
}	}

# ========================================= Separate uploaded file into records	=item upfile_record_sep()
# returns array of records
# needs $ENV{'form.upfile'}	Separate uploaded file into records
# needs $ENV{'form.upfiletype'}	returns array of records,
	needs $ENV{'form.upfile'} and $ENV{'form.upfiletype'}

	=cut

sub upfile_record_sep {	sub upfile_record_sep {
if ($ENV{'form.upfiletype'} eq 'xml') {	if ($ENV{'form.upfiletype'} eq 'xml') {
Line 994 sub upfile_record_sep {	Line 1101 sub upfile_record_sep {
}	}
}	}

# =============================================== Separate a record into fields	=item record_sep($record)
# needs $ENV{'form.upfiletype'}
# takes $record as arg	Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'}

	=cut

sub record_sep {	sub record_sep {
my $record=shift;	my $record=shift;
my %components=();	my %components=();
Line 1041 sub record_sep {	Line 1151 sub record_sep {
return %components;	return %components;
}	}

# =============================== HTML code to select file and specify its type	=item upfile_select_html()

	return HTML code to select file and specify its type

	=cut

sub upfile_select_html {	sub upfile_select_html {
return (<<'ENDUPFORM');	return (<<'ENDUPFORM');
<input type="file" name="upfile" size="50">	<input type="file" name="upfile" size="50">
Line 1054 sub upfile_select_html {	Line 1169 sub upfile_select_html {
ENDUPFORM	ENDUPFORM
}	}

# ===================Prints a table of sample values from each column uploaded	=item csv_print_samples($r,$records)
# $r is an Apache Request ref
# $records is an arrayref from &Apache::loncommon::upfile_record_sep	Prints a table of sample values from each column uploaded $r is an
	Apache Request ref, $records is an arrayref from
	&Apache::loncommon::upfile_record_sep

	=cut

sub csv_print_samples {	sub csv_print_samples {
my ($r,$records) = @_;	my ($r,$records) = @_;
my (%sone,%stwo,%sthree);	my (%sone,%stwo,%sthree);
Line 1079 sub csv_print_samples {	Line 1199 sub csv_print_samples {
$r->print('</tr></table><br />'."\n");	$r->print('</tr></table><br />'."\n");
}	}

# ======Prints a table to create associations between values and table columns	=item csv_print_select_table($r,$records,$d)
# $r is an Apache Request ref
# $records is an arrayref from &Apache::loncommon::upfile_record_sep	Prints a table to create associations between values and table columns.
# $d is an array of 2 element arrays (internal name, displayed name)	$r is an Apache Request ref,
	$records is an arrayref from &Apache::loncommon::upfile_record_sep,
	$d is an array of 2 element arrays (internal name, displayed name)

	=cut

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;my %sone;
Line 1106 sub csv_print_select_table {	Line 1231 sub csv_print_select_table {
return $i;	return $i;
}	}

# ===================Prints a table of sample values from the upload and	=item csv_samples_select_table($r,$records,$d)
# can make associate samples to internal names
# $r is an Apache Request ref	Prints a table of sample values from the upload and can make associate samples to internal names.
# $records is an arrayref from &Apache::loncommon::upfile_record_sep
# $d is an array of 2 element arrays (internal name, displayed name)	$r is an Apache Request ref,
	$records is an arrayref from &Apache::loncommon::upfile_record_sep,
	$d is an array of 2 element arrays (internal name, displayed name)

	=cut

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 %sone; my %stwo; my %sthree;
Line 1141 sub csv_samples_select_table {	Line 1271 sub csv_samples_select_table {
1;	1;
__END__;	__END__;

	=pod

	=back

	=head2 Access .tab File Data

	=over 4

=item languageids()	=item languageids()

returns list of all language ids	returns list of all language ids
Line 1179 returns description for a specified file	Line 1317 returns description for a specified file
returns description for a specified file type with	returns description for a specified file type with
extra formatting	extra formatting

	=back

	=head2 Alternate Problem Views

	=over 4

=item get_previous_attempt()	=item get_previous_attempt()

return string with previous attempt on problem	return string with previous attempt on problem
Line 1191 show a snapshot of what student was look	Line 1335 show a snapshot of what student was look

show a snapshot of how student was answering problem	show a snapshot of how student was answering problem

=item get_unprocessed_cgi()	=back

	=head2 HTTP Helper

	=over 4

	=item get_unprocessed_cgi($query,$possible_names)

get unparsed CGI parameters	Modify the %ENV hash to contain unprocessed CGI form parameters held in
	$query. The parameters listed in $possible_names (an array reference),
	will be set in $ENV{'form.name'} if they do not already exist.

	Typically called with $ENV{'QUERY_STRING'} as the first parameter.
	$possible_names is an ref to an array of form element names. As an example:
	get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
	will result in $ENV{'form.uname'} and $ENV{'form.udom'} being set.

=item cacheheader()	=item cacheheader()

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

Removed from v.1.37
changed lines
	Added in v.1.43