--- loncom/interface/loncommon.pm 2002/04/22 18:04:19 1.33 +++ loncom/interface/loncommon.pm 2002/07/03 21:12:38 1.43 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.33 2002/04/22 18:04:19 matthew Exp $ +# $Id: loncommon.pm,v 1.43 2002/07/03 21:12:38 ng Exp $ # # Copyright Michigan State University Board of Trustees # @@ -33,11 +33,46 @@ # 12/25,12/28 Gerd Kortemeyer # YEAR=2002 # 1/4 Gerd Kortemeyer +# 6/24,7/2 H. K. Ng # Makes a table out of the previous attempts # Inputs result_from_symbread, user, domain, course_id # Reads in non-network-related .tab files +# POD header: + +=head1 NAME + +Apache::loncommon - pile of common routines + +=head1 SYNOPSIS + +Referenced by other mod_perl Apache modules. + +Invocation: + &Apache::loncommon::SUBROUTINENAME(ARGUMENTS); + +=head1 INTRODUCTION + +Common collection of used subroutines. This collection helps remove +redundancy from other modules and increase efficiency of memory usage. + +Current things done: + + Makes a table out of the previous homework attempts + Inputs result_from_symbread, user, domain, course_id + Reads in non-network-related .tab files + +This is part of the LearningOnline Network with CAPA project +described at http://www.lon-capa.org. + +=head2 General Subroutines + +=over 4 + +=cut + +# End of POD header package Apache::loncommon; use strict; @@ -45,14 +80,13 @@ use Apache::lonnet(); use POSIX qw(strftime); use Apache::Constants qw(:common); use Apache::lonmsg(); - my $readit; # ----------------------------------------------- Filetypes/Languages/Copyright my %language; my %cprtag; my %fe; my %fd; -my %fc; +my %category_extensions; # -------------------------------------------------------------- Thesaurus data my @therelated; @@ -65,6 +99,17 @@ my $thethreshold=0.1/$thefuzzy; my $theavecount; # ----------------------------------------------------------------------- BEGIN + +=pod + +=item BEGIN() + +Initialize values from language.tab, copyright.tab, filetypes.tab, +and filecategories.tab. + +=cut +# ----------------------------------------------------------------------- BEGIN + BEGIN { unless ($readit) { @@ -102,8 +147,8 @@ BEGIN { while (<$fh>) { next if /^\#/; chomp; - my ($key,$val)=(split(/\s+/,$_,2)); - push @{$fc{$key}},$val; + my ($extension,$category)=(split(/\s+/,$_,2)); + push @{$category_extensions{lc($category)}},$extension; } } } @@ -147,8 +192,316 @@ BEGIN { } # ============================================================= 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(...) + +linked_select_forms returns a string containing a <script></script> block +and html for two <select> menus. The select menus will be linked in that +changing the value of the first menu will result in new values being placed +in the second menu. The values in the select menu will appear in alphabetical +order. + +linked_select_forms takes the following ordered inputs: + +=over 4 + +=item $formname, the name of the <form> tag + +=item $middletext, the text which appears between the <select> tags + +=item $firstdefault, the default value for the first menu + +=item $firstselectname, the name of the first <select> tag + +=item $secondselectname, the name of the second <select> tag + +=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 +'select2' keys must appear as stated. keys(%menu) are the possible +values for the first select menu. The text that coincides with the +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 +$menu{$choice1}->{'select2'}. + +my %menu = ( A1 => { text =>"Choice A1" , + default => "B3", + select2 => { + B1 => "Choice B1", + B2 => "Choice B2", + B3 => "Choice B3", + B4 => "Choice B4" + } + }, + A2 => { text =>"Choice A2" , + default => "C2", + select2 => { + C1 => "Choice C1", + C2 => "Choice C2", + C3 => "Choice C3" + } + }, + A3 => { text =>"Choice A3" , + default => "D6", + select2 => { + D1 => "Choice D1", + D2 => "Choice D2", + D3 => "Choice D3", + D4 => "Choice D4", + D5 => "Choice D5", + D6 => "Choice D6", + D7 => "Choice D7" + } + } + ); + +=back + +=cut + +# ------------------------------------------------ + +sub linked_select_forms { + my ($formname, + $middletext, + $firstdefault, + $firstselectname, + $secondselectname, + $hashref + ) = @_; + my $second = "document.$formname.$secondselectname"; + my $first = "document.$formname.$firstselectname"; + # output the javascript to do the changing + my $result = ''; + $result.="<script>\n"; + $result.="var select2data = new Object();\n"; + $" = '","'; + my $debug = ''; + foreach my $s1 (sort(keys(%$hashref))) { + $result.="select2data.d_$s1 = new Object();\n"; + $result.="select2data.d_$s1.def = new String('". + $hashref->{$s1}->{'default'}."');\n"; + $result.="select2data.d_$s1.values = new Array("; + my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } )); + $result.="\"@s2values\");\n"; + $result.="select2data.d_$s1.texts = new Array("; + my @s2texts; + foreach my $value (@s2values) { + push @s2texts, $hashref->{$s1}->{'select2'}->{$value}; + } + $result.="\"@s2texts\");\n"; + } + $"=' '; + $result.= <<"END"; + +function select1_changed() { + // Determine new choice + var newvalue = "d_" + $first.value; + // update select2 + var values = select2data[newvalue].values; + var texts = select2data[newvalue].texts; + var select2def = select2data[newvalue].def; + var i; + // out with the old + for (i = 0; i < $second.options.length; i++) { + $second.options[i] = null; + } + // in with the nuclear + for (i=0;i<values.length; i++) { + $second.options[i] = new Option(values[i]); + $second.options[i].text = texts[i]; + if (values[i] == select2def) { + $second.options[i].selected = true; + } + } +} +</script> +END + # output the initial values for the selection lists + $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n"; + foreach my $value (sort(keys(%$hashref))) { + $result.=" <option value=\"$value\" "; + $result.=" selected=\"true\" " if ($value eq $firstdefault); + $result.=">$hashref->{$value}->{'text'}</option>\n"; + } + $result .= "</select>\n"; + my %select2 = %{$hashref->{$firstdefault}->{'select2'}}; + $result .= $middletext; + $result .= "<select size=\"1\" name=\"$secondselectname\">\n"; + my $seconddefault = $hashref->{$firstdefault}->{'default'}; + foreach my $value (sort(keys(%select2))) { + $result.=" <option value=\"$value\" "; + $result.=" selected=\"true\" " if ($value eq $seconddefault); + $result.=">$select2{$value}</option>\n"; + } + $result .= "</select>\n"; + # return $debug; + return $result; +} # end of sub linked_select_forms { + +############################################################### + +=item csv_translate($text) + +Translate $text to allow it to be output as a 'comma seperated values' +format. + +=cut + +sub csv_translate { + my $text = shift; + $text =~ s/\"/\"\"/g; + $text =~ s/\n//g; + return $text; +} + +############################################################### + +############################################################### ## Home server <option> list generating code ## ############################################################### +#------------------------------------------- + +=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 (sort values(%Apache::lonnet::hostdom)) { + push (@domains,$_) unless $seen{$_}++; + } + return @domains; +} + +#------------------------------------------- + +=item select_dom_form($defdom,$name) + +Returns a string containing a <select name='$name' size='1'> form to +allow a user to select the domain to preform an operation in. +See loncreateuser.pm for an example invocation and use. + +=cut + +#------------------------------------------- +sub select_dom_form { + my ($defdom,$name) = @_; + my @domains = get_domains(); + my $selectdomain = "<select name=\"$name\" size=\"1\">\n"; + foreach (@domains) { + $selectdomain.="<option value=\"$_\" ". + ($_ eq $defdom ? 'selected' : ''). + ">$_</option>\n"; + } + $selectdomain.="</select>"; + return $selectdomain; +} + +#------------------------------------------- + +=item get_home_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_home_servers { my $domain = shift; my %home_servers; @@ -160,6 +513,16 @@ sub get_home_servers { return %home_servers; } +#------------------------------------------- + +=item home_server_option_list($domain) + +returns a string which contains an <option> list to be used in a +<select> form input. See loncreateuser.pm for an example. + +=cut + +#------------------------------------------- sub home_server_option_list { my $domain = shift; my %servers = &get_home_servers($domain); @@ -182,6 +545,35 @@ sub home_server_option_list { ## hash, and have reasonable default values. ## ## formname = the name given in the <form> tag. +#------------------------------------------- + +=item authform_xxxxxx + +The authform_xxxxxx subroutines provide javascript and html forms which +handle some of the conveniences required for authentication forms. +This is not an optimal method, but it works. + +See loncreateuser.pm for invocation and use examples. + +=over 4 + +=item authform_header + +=item authform_authorwarning + +=item authform_nochange + +=item authform_kerberos + +=item authform_internal + +=item authform_filesystem + +=back + +=cut + +#------------------------------------------- sub authform_header{ my %in = ( formname => 'cu', @@ -438,12 +830,12 @@ sub copyrightdescription { # ------------------------------------------------------------- File Categories sub filecategories { - return sort(keys(%fc)); + return sort(keys(%category_extensions)); } # -------------------------------------- File Types within a specified category sub filecategorytypes { - return @{$fc{lc(shift(@_))}}; + return @{$category_extensions{lc($_[0])}}; } # ------------------------------------------------------------------ File Types @@ -467,9 +859,22 @@ sub filedescriptionex { 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 { - my ($symb,$username,$domain,$course)=@_; + my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_; my $prevattempts=''; + no strict 'refs'; if ($symb) { my (%returnhash)= &Apache::lonnet::restore($symb,$course,$domain,$username); @@ -481,30 +886,37 @@ sub get_previous_attempt { $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)) { my ($ign,@parts) = split(/\./,$_); - if (@parts) { + if ($#parts > 0) { my $data=$parts[-1]; pop(@parts); - $prevattempts.='<th>Part '.join('.',@parts).'<br />'.$data.'</th>'; + $prevattempts.='<td>Part '.join('.',@parts).'<br />'.$data.' </td>'; } else { - $prevattempts.='<th>'.$ign.'</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.':'.$_})); + if ($#parts == 0) { + $prevattempts.='<th>'.$parts[0].'</th>'; } 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)) { my $value; if ($_ =~ /timestamp/) { @@ -512,9 +924,10 @@ sub get_previous_attempt { } else { $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 { $prevattempts='Nothing submitted - no attempts.'; } @@ -564,16 +977,13 @@ sub get_student_answers { foreach my $element (@elements) { $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; } +############################################### + +############################################### + sub get_unprocessed_cgi { my ($query,$possible_names)= @_; # $Apache::lonxml::debug=1; @@ -624,11 +1034,19 @@ sub add_to_env { } } -#---CSV Upload/Handling functions +=pod + +=head2 CSV Upload/Handling functions + +=over 4 + +=item upfile_store($r) -# ========================================================= Store uploaded file -# needs $ENV{'form.upfile'} -# return $datatoken to be put into hidden field +Store uploaded file, $r should be the HTTP Request object, +needs $ENV{'form.upfile'} +returns $datatoken to be put into hidden field + +=cut sub upfile_store { my $r=shift; @@ -647,9 +1065,13 @@ sub upfile_store { return $datatoken; } -# ================================================= Load uploaded file from tmp -# needs $ENV{'form.datatoken'} -# sets $ENV{'form.upfile'} to the contents of the file +=item load_tmp_file($r) + +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 { my $r=shift; @@ -664,10 +1086,13 @@ sub load_tmp_file { $ENV{'form.upfile'}=join('',@studentdata); } -# ========================================= Separate uploaded file into records -# returns array of records -# needs $ENV{'form.upfile'} -# needs $ENV{'form.upfiletype'} +=item upfile_record_sep() + +Separate uploaded file into records +returns array of records, +needs $ENV{'form.upfile'} and $ENV{'form.upfiletype'} + +=cut sub upfile_record_sep { if ($ENV{'form.upfiletype'} eq 'xml') { @@ -676,9 +1101,12 @@ sub upfile_record_sep { } } -# =============================================== Separate a record into fields -# needs $ENV{'form.upfiletype'} -# takes $record as arg +=item record_sep($record) + +Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'} + +=cut + sub record_sep { my $record=shift; my %components=(); @@ -723,7 +1151,12 @@ sub record_sep { 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 { return (<<'ENDUPFORM'); <input type="file" name="upfile" size="50"> @@ -736,9 +1169,14 @@ sub upfile_select_html { ENDUPFORM } -# ===================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 +=item csv_print_samples($r,$records) + +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 { my ($r,$records) = @_; my (%sone,%stwo,%sthree); @@ -761,10 +1199,15 @@ sub csv_print_samples { $r->print('</tr></table><br />'."\n"); } -# ======Prints a table to create associations between values and table columns -# $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) +=item csv_print_select_table($r,$records,$d) + +Prints a table to create associations between values and table columns. +$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 { my ($r,$records,$d) = @_; my $i=0;my %sone; @@ -788,11 +1231,16 @@ sub csv_print_select_table { return $i; } -# ===================Prints a table of sample values from the upload and -# can make associate samples to internal names -# $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) +=item csv_samples_select_table($r,$records,$d) + +Prints a table of sample values from the upload and can make associate samples to internal names. + +$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 { my ($r,$records,$d) = @_; my %sone; my %stwo; my %sthree; @@ -823,110 +1271,98 @@ sub csv_samples_select_table { 1; __END__; +=pod -=head1 NAME - -Apache::loncommon - pile of common routines +=back -=head1 SYNOPSIS +=head2 Access .tab File Data -Referenced by other mod_perl Apache modules. - -Invocation: - &Apache::loncommon::SUBROUTINENAME(ARGUMENTS); - -=head1 INTRODUCTION - -Common collection of used subroutines. This collection helps remove -redundancy from other modules and increase efficiency of memory usage. - -Current things done: - - Makes a table out of the previous homework attempts - Inputs result_from_symbread, user, domain, course_id - Reads in non-network-related .tab files +=over 4 -This is part of the LearningOnline Network with CAPA project -described at http://www.lon-capa.org. +=item languageids() -=head1 HANDLER SUBROUTINE +returns list of all language ids -There is no handler subroutine. +=item languagedescription() -=head1 OTHER SUBROUTINES +returns description of a specified language id -=over 4 +=item copyrightids() -=item * +returns list of all copyrights -BEGIN() : initialize values from language.tab, copyright.tab, filetypes.tab, -and filecategories.tab. +=item copyrightdescription() -=item * +returns description of a specified copyright id -languageids() : returns list of all language ids +=item filecategories() -=item * +returns list of all file categories -languagedescription() : returns description of a specified language id +=item filecategorytypes() -=item * +returns list of file types belonging to a given file +category -copyrightids() : returns list of all copyrights +=item fileembstyle() -=item * +returns embedding style for a specified file type -copyrightdescription() : returns description of a specified copyright id +=item filedescription() -=item * +returns description for a specified file type -filecategories() : returns list of all file categories +=item filedescriptionex() -=item * +returns description for a specified file type with +extra formatting -filecategorytypes() : returns list of file types belonging to a given file -category +=back -=item * +=head2 Alternate Problem Views -fileembstyle() : returns embedding style for a specified file type +=over 4 -=item * +=item get_previous_attempt() -filedescription() : returns description for a specified file type +return string with previous attempt on problem -=item * +=item get_student_view() -filedescriptionex() : returns description for a specified file type with -extra formatting +show a snapshot of what student was looking at -=item * +=item get_student_answers() -get_previous_attempt() : return string with previous attempt on problem +show a snapshot of how student was answering problem -=item * +=back -get_student_view() : show a snapshot of what student was looking at +=head2 HTTP Helper -=item * +=over 4 -get_student_answers() : show a snapshot of how student was answering problem +=item get_unprocessed_cgi($query,$possible_names) -=item * +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. -get_unprocessed_cgi() : get unparsed CGI parameters +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 * +=item cacheheader() -cacheheader() : returns cache-controlling header code +returns cache-controlling header code -=item * +=item nocache() -nocache() : specifies header code to not have cache +specifies header code to not have cache -=item * +=item add_to_env($name,$value) -add_to_env($name,$value) : adds $name to the %ENV hash with value +adds $name to the %ENV hash with value $value, if $name already exists, the entry is converted to an array reference and $value is added to the array.