Annotation of loncom/interface/loncommon.pm, revision 1.31
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.31 ! albertel 4: # $Id: loncommon.pm,v 1.30 2002/03/28 22:15:56 albertel Exp $
1.10 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.12 harris41 28: # YEAR=2001
29: # 2/13-12/7 Guy Albertelli
1.17 harris41 30: # 12/11,12/12,12/17 Scott Harrison
1.18 www 31: # 12/21 Gerd Kortemeyer
1.20 www 32: # 12/21 Scott Harrison
1.22 www 33: # 12/25,12/28 Gerd Kortemeyer
1.23 www 34: # YEAR=2002
35: # 1/4 Gerd Kortemeyer
1.1 albertel 36:
37: # Makes a table out of the previous attempts
1.2 albertel 38: # Inputs result_from_symbread, user, domain, course_id
1.16 harris41 39: # Reads in non-network-related .tab files
1.1 albertel 40:
41: package Apache::loncommon;
42:
43: use strict;
1.22 www 44: use Apache::lonnet();
1.8 albertel 45: use POSIX qw(strftime);
1.1 albertel 46: use Apache::Constants qw(:common);
47: use Apache::lonmsg();
1.12 harris41 48:
1.22 www 49: my $readit;
50:
1.20 www 51: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 52: my %language;
53: my %cprtag;
54: my %fe; my %fd;
1.15 harris41 55: my %fc;
1.12 harris41 56:
1.20 www 57: # -------------------------------------------------------------- Thesaurus data
1.21 www 58: my @therelated;
59: my @theword;
60: my @thecount;
61: my %theindex;
62: my $thetotalcount;
1.20 www 63: my $thefuzzy=2;
64: my $thethreshold=0.1/$thefuzzy;
65: my $theavecount;
66:
1.12 harris41 67: # ----------------------------------------------------------------------- BEGIN
1.18 www 68: BEGIN {
1.22 www 69:
70: unless ($readit) {
1.12 harris41 71: # ------------------------------------------------------------------- languages
72: {
73: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
74: '/language.tab');
1.16 harris41 75: if ($fh) {
76: while (<$fh>) {
77: next if /^\#/;
78: chomp;
79: my ($key,$val)=(split(/\s+/,$_,2));
80: $language{$key}=$val;
81: }
1.12 harris41 82: }
83: }
84: # ------------------------------------------------------------------ copyrights
85: {
1.16 harris41 86: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}.
87: '/copyright.tab');
88: if ($fh) {
89: while (<$fh>) {
90: next if /^\#/;
91: chomp;
92: my ($key,$val)=(split(/\s+/,$_,2));
93: $cprtag{$key}=$val;
94: }
1.12 harris41 95: }
96: }
1.15 harris41 97: # ------------------------------------------------------------- file categories
98: {
99: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
1.16 harris41 100: '/filecategories.tab');
101: if ($fh) {
102: while (<$fh>) {
103: next if /^\#/;
104: chomp;
105: my ($key,$val)=(split(/\s+/,$_,2));
106: push @{$fc{$key}},$val;
107: }
1.15 harris41 108: }
109: }
1.12 harris41 110: # ------------------------------------------------------------------ file types
111: {
1.16 harris41 112: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
113: '/filetypes.tab');
114: if ($fh) {
115: while (<$fh>) {
116: next if (/^\#/);
117: chomp;
118: my ($ending,$emb,$descr)=split(/\s+/,$_,3);
119: if ($descr ne '') {
120: $fe{$ending}=lc($emb);
121: $fd{$ending}=$descr;
122: }
1.12 harris41 123: }
124: }
125: }
1.20 www 126: # -------------------------------------------------------------- Thesaurus data
127: {
128: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
129: '/thesaurus.dat');
130: if ($fh) {
131: while (<$fh>) {
132: my ($tword,$tindex,$tcount,$trelated)=split(/\@/,$_);
133: $theindex{$tword}=$tindex;
134: $theword[$tindex]=$tword;
135: $thecount[$tindex]=$tcount;
136: $thetotalcount+=$tcount;
137: $therelated[$tindex]=$trelated;
138: }
139: }
140: $theavecount=$thetotalcount/$#thecount;
141: }
1.22 www 142: &Apache::lonnet::logthis(
143: "<font color=yellow>INFO: Read file types and thesaurus</font>");
144: $readit=1;
145: }
146:
1.20 www 147: }
148: # ============================================================= END BEGIN BLOCK
149:
150:
151: # ---------------------------------------------------------- Is this a keyword?
152:
153: sub keyword {
154: my $newword=shift;
155: $newword=~s/\W//g;
156: $newword=~tr/A-Z/a-z/;
157: my $tindex=$theindex{$newword};
158: if ($tindex) {
159: if ($thecount[$tindex]>$theavecount) {
160: return 1;
161: }
162: }
163: return 0;
164: }
165: # -------------------------------------------------------- Return related words
166:
167: sub related {
168: my $newword=shift;
169: $newword=~s/\W//g;
170: $newword=~tr/A-Z/a-z/;
171: my $tindex=$theindex{$newword};
172: if ($tindex) {
173: my %found=();
174: foreach (split(/\,/,$therelated[$tindex])) {
175: # - Related word found
176: my ($ridx,$rcount)=split(/\:/,$_);
177: # - Direct relation index
178: my $directrel=$rcount/$thecount[$tindex];
179: if ($directrel>$thethreshold) {
180: foreach (split(/\,/,$therelated[$ridx])) {
181: my ($rridx,$rrcount)=split(/\:/,$_);
182: if ($rridx==$tindex) {
183: # - Determine reverse relation index
184: my $revrel=$rrcount/$thecount[$ridx];
185: # - Calculate full index
186: $found{$ridx}=$directrel*$revrel;
187: if ($found{$ridx}>$thethreshold) {
188: foreach (split(/\,/,$therelated[$ridx])) {
189: my ($rrridx,$rrrcount)=split(/\:/,$_);
190: unless ($found{$rrridx}) {
191: my $revrevrel=$rrrcount/$thecount[$ridx];
192: if (
193: $directrel*$revrel*$revrevrel>$thethreshold
194: ) {
195: $found{$rrridx}=
196: $directrel*$revrel*$revrevrel;
197: }
198: }
199: }
200: }
201: }
202: }
203: }
204: }
205: }
206: return ();
1.14 harris41 207: }
208:
209: # ---------------------------------------------------------------- Language IDs
210: sub languageids {
1.16 harris41 211: return sort(keys(%language));
1.14 harris41 212: }
213:
214: # -------------------------------------------------------- Language Description
215: sub languagedescription {
1.16 harris41 216: return $language{shift(@_)};
1.14 harris41 217: }
218:
219: # --------------------------------------------------------------- Copyright IDs
220: sub copyrightids {
1.16 harris41 221: return sort(keys(%cprtag));
1.14 harris41 222: }
223:
224: # ------------------------------------------------------- Copyright Description
225: sub copyrightdescription {
1.16 harris41 226: return $cprtag{shift(@_)};
1.14 harris41 227: }
228:
229: # ------------------------------------------------------------- File Categories
230: sub filecategories {
1.16 harris41 231: return sort(keys(%fc));
1.15 harris41 232: }
1.14 harris41 233:
1.17 harris41 234: # -------------------------------------- File Types within a specified category
1.15 harris41 235: sub filecategorytypes {
1.16 harris41 236: return @{$fc{lc(shift(@_))}};
1.14 harris41 237: }
238:
239: # ------------------------------------------------------------------ File Types
240: sub fileextensions {
1.16 harris41 241: return sort(keys(%fe));
1.14 harris41 242: }
243:
244: # ------------------------------------------------------------- Embedding Style
245: sub fileembstyle {
1.16 harris41 246: return $fe{lc(shift(@_))};
1.14 harris41 247: }
248:
249: # ------------------------------------------------------------ Description Text
250: sub filedescription {
1.16 harris41 251: return $fd{lc(shift(@_))};
252: }
253:
254: # ------------------------------------------------------------ Description Text
255: sub filedescriptionex {
256: my $ex=shift;
257: return '.'.$ex.' '.$fd{lc($ex)};
1.12 harris41 258: }
1.1 albertel 259:
260: sub get_previous_attempt {
1.2 albertel 261: my ($symb,$username,$domain,$course)=@_;
1.1 albertel 262: my $prevattempts='';
263: if ($symb) {
1.3 albertel 264: my (%returnhash)=
265: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 266: if ($returnhash{'version'}) {
267: my %lasthash=();
268: my $version;
269: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.19 harris41 270: foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) {
1.1 albertel 271: $lasthash{$_}=$returnhash{$version.':'.$_};
1.19 harris41 272: }
1.1 albertel 273: }
274: $prevattempts='<table border=2></tr><th>History</th>';
1.16 harris41 275: foreach (sort(keys %lasthash)) {
1.31 ! albertel 276: my ($ign,@parts) = split(/\./,$_);
! 277: if (@parts) {
! 278: my $data=$parts[-1];
! 279: pop(@parts);
! 280: $prevattempts.='<th>Part '.join('.',@parts).'<br />'.$data.'</th>';
! 281: } else {
! 282: $prevattempts.='<th>'.$ign.'</th>';
! 283: }
1.16 harris41 284: }
1.1 albertel 285: for ($version=1;$version<=$returnhash{'version'};$version++) {
286: $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
1.16 harris41 287: foreach (sort(keys %lasthash)) {
1.5 albertel 288: my $value;
289: if ($_ =~ /timestamp/) {
290: $value=scalar(localtime($returnhash{$version.':'.$_}));
291: } else {
292: $value=$returnhash{$version.':'.$_};
293: }
294: $prevattempts.='<td>'.$value.'</td>';
1.16 harris41 295: }
1.1 albertel 296: }
297: $prevattempts.='</tr><tr><th>Current</th>';
1.16 harris41 298: foreach (sort(keys %lasthash)) {
1.5 albertel 299: my $value;
300: if ($_ =~ /timestamp/) {
301: $value=scalar(localtime($lasthash{$_}));
302: } else {
303: $value=$lasthash{$_};
304: }
305: $prevattempts.='<td>'.$value.'</td>';
1.16 harris41 306: }
1.1 albertel 307: $prevattempts.='</tr></table>';
308: } else {
309: $prevattempts='Nothing submitted - no attempts.';
310: }
311: } else {
312: $prevattempts='No data.';
313: }
1.10 albertel 314: }
315:
316: sub get_student_view {
317: my ($symb,$username,$domain,$courseid) = @_;
318: my ($map,$id,$feedurl) = split(/___/,$symb);
319: my (%old,%moreenv);
320: my @elements=('symb','courseid','domain','username');
321: foreach my $element (@elements) {
322: $old{$element}=$ENV{'form.grade_'.$element};
323: $moreenv{'form.grade_'.$element}=eval '$'.$element #'
324: }
1.11 albertel 325: &Apache::lonnet::appenv(%moreenv);
326: my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
327: &Apache::lonnet::delenv('form.grade_');
328: foreach my $element (@elements) {
329: $ENV{'form.grade_'.$element}=$old{$element};
330: }
331: $userview=~s/\<body[^\>]*\>//gi;
332: $userview=~s/\<\/body\>//gi;
333: $userview=~s/\<html\>//gi;
334: $userview=~s/\<\/html\>//gi;
335: $userview=~s/\<head\>//gi;
336: $userview=~s/\<\/head\>//gi;
337: $userview=~s/action\s*\=/would_be_action\=/gi;
338: return $userview;
339: }
340:
341: sub get_student_answers {
342: my ($symb,$username,$domain,$courseid) = @_;
343: my ($map,$id,$feedurl) = split(/___/,$symb);
344: my (%old,%moreenv);
345: my @elements=('symb','courseid','domain','username');
346: foreach my $element (@elements) {
347: $old{$element}=$ENV{'form.grade_'.$element};
348: $moreenv{'form.grade_'.$element}=eval '$'.$element #'
349: }
350: $moreenv{'form.grade_target'}='answer';
1.10 albertel 351: &Apache::lonnet::appenv(%moreenv);
352: my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
353: &Apache::lonnet::delenv('form.grade_');
354: foreach my $element (@elements) {
355: $ENV{'form.grade_'.$element}=$old{$element};
356: }
357: $userview=~s/\<body[^\>]*\>//gi;
358: $userview=~s/\<\/body\>//gi;
359: $userview=~s/\<html\>//gi;
360: $userview=~s/\<\/html\>//gi;
361: $userview=~s/\<head\>//gi;
362: $userview=~s/\<\/head\>//gi;
363: $userview=~s/action\s*\=/would_be_action\=/gi;
364: return $userview;
1.1 albertel 365: }
366:
1.6 albertel 367: sub get_unprocessed_cgi {
1.25 albertel 368: my ($query,$possible_names)= @_;
1.26 matthew 369: # $Apache::lonxml::debug=1;
1.16 harris41 370: foreach (split(/&/,$query)) {
1.6 albertel 371: my ($name, $value) = split(/=/,$_);
1.25 albertel 372: $name = &Apache::lonnet::unescape($name);
373: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
374: $value =~ tr/+/ /;
375: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
376: &Apache::lonxml::debug("Seting :$name: to :$value:");
1.30 albertel 377: unless (defined($ENV{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 378: }
1.16 harris41 379: }
1.6 albertel 380: }
381:
1.7 albertel 382: sub cacheheader {
1.23 www 383: unless ($ENV{'request.method'} eq 'GET') { return ''; }
1.8 albertel 384: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.7 albertel 385: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
386: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
387: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
388: return $output;
389: }
390:
1.9 albertel 391: sub no_cache {
392: my ($r) = @_;
1.23 www 393: unless ($ENV{'request.method'} eq 'GET') { return ''; }
1.24 albertel 394: #my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.9 albertel 395: $r->no_cache(1);
396: $r->header_out("Pragma" => "no-cache");
1.24 albertel 397: #$r->header_out("Expires" => $date);
1.9 albertel 398: }
1.25 albertel 399:
400: sub add_to_env {
401: my ($name,$value)=@_;
1.28 albertel 402: if (defined($ENV{$name})) {
1.27 albertel 403: if (ref($ENV{$name})) {
1.25 albertel 404: #already have multiple values
405: push(@{ $ENV{$name} },$value);
406: } else {
407: #first time seeing multiple values, convert hash entry to an arrayref
408: my $first=$ENV{$name};
409: undef($ENV{$name});
410: push(@{ $ENV{$name} },$first,$value);
411: }
412: } else {
413: $ENV{$name}=$value;
414: }
1.31 ! albertel 415: }
! 416:
! 417: #---CSV Upload/Handling functions
! 418:
! 419: # ========================================================= Store uploaded file
! 420: # needs $ENV{'form.upfile'}
! 421: # return $datatoken to be put into hidden field
! 422:
! 423: sub upfile_store {
! 424: my $r=shift;
! 425: $ENV{'form.upfile'}=~s/\r/\n/gs;
! 426: $ENV{'form.upfile'}=~s/\f/\n/gs;
! 427: $ENV{'form.upfile'}=~s/\n+/\n/gs;
! 428: $ENV{'form.upfile'}=~s/\n+$//gs;
! 429:
! 430: my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
! 431: '_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;
! 432: {
! 433: my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
! 434: '/tmp/'.$datatoken.'.tmp');
! 435: print $fh $ENV{'form.upfile'};
! 436: }
! 437: return $datatoken;
! 438: }
! 439:
! 440: # ================================================= Load uploaded file from tmp
! 441: # needs $ENV{'form.datatoken'}
! 442: # sets $ENV{'form.upfile'} to the contents of the file
! 443:
! 444: sub load_tmp_file {
! 445: my $r=shift;
! 446: my @studentdata=();
! 447: {
! 448: my $fh;
! 449: if ($fh=Apache::File->new($r->dir_config('lonDaemons').
! 450: '/tmp/'.$ENV{'form.datatoken'}.'.tmp')) {
! 451: @studentdata=<$fh>;
! 452: }
! 453: }
! 454: $ENV{'form.upfile'}=join('',@studentdata);
! 455: }
! 456:
! 457: # ========================================= Separate uploaded file into records
! 458: # returns array of records
! 459: # needs $ENV{'form.upfile'}
! 460: # needs $ENV{'form.upfiletype'}
! 461:
! 462: sub upfile_record_sep {
! 463: if ($ENV{'form.upfiletype'} eq 'xml') {
! 464: } else {
! 465: return split(/\n/,$ENV{'form.upfile'});
! 466: }
! 467: }
! 468:
! 469: # =============================================== Separate a record into fields
! 470: # needs $ENV{'form.upfiletype'}
! 471: # takes $record as arg
! 472: sub record_sep {
! 473: my $record=shift;
! 474: my %components=();
! 475: if ($ENV{'form.upfiletype'} eq 'xml') {
! 476: } elsif ($ENV{'form.upfiletype'} eq 'space') {
! 477: my $i=0;
! 478: foreach (split(/\s+/,$record)) {
! 479: my $field=$_;
! 480: $field=~s/^(\"|\')//;
! 481: $field=~s/(\"|\')$//;
! 482: $components{$i}=$field;
! 483: $i++;
! 484: }
! 485: } elsif ($ENV{'form.upfiletype'} eq 'tab') {
! 486: my $i=0;
! 487: foreach (split(/\t+/,$record)) {
! 488: my $field=$_;
! 489: $field=~s/^(\"|\')//;
! 490: $field=~s/(\"|\')$//;
! 491: $components{$i}=$field;
! 492: $i++;
! 493: }
! 494: } else {
! 495: my @allfields=split(/\,/,$record);
! 496: my $i=0;
! 497: my $j;
! 498: for ($j=0;$j<=$#allfields;$j++) {
! 499: my $field=$allfields[$j];
! 500: if ($field=~/^\s*(\"|\')/) {
! 501: my $delimiter=$1;
! 502: while (($field!~/$delimiter$/) && ($j<$#allfields)) {
! 503: $j++;
! 504: $field.=','.$allfields[$j];
! 505: }
! 506: $field=~s/^\s*$delimiter//;
! 507: $field=~s/$delimiter\s*$//;
! 508: }
! 509: $components{$i}=$field;
! 510: $i++;
! 511: }
! 512: }
! 513: return %components;
! 514: }
! 515:
! 516: # =============================== HTML code to select file and specify its type
! 517: sub upfile_select_html {
! 518: return (<<'ENDUPFORM');
! 519: <input type="file" name="upfile" size="50">
! 520: <br />Type: <select name="upfiletype">
! 521: <option value="csv">CSV (comma separated values, spreadsheet)</option>
! 522: <option value="space">Space separated</option>
! 523: <option value="tab">Tabulator separated</option>
! 524: <option value="xml">HTML/XML</option>
! 525: </select>
! 526: ENDUPFORM
! 527: }
! 528:
! 529: # ===================Prints a table of sample values from each column uploaded
! 530: # $r is an Apache Request ref
! 531: # $records is an arrayref from &Apache::loncommon::upfile_record_sep
! 532: sub csv_print_samples {
! 533: my ($r,$records) = @_;
! 534: my (%sone,%stwo,%sthree);
! 535: %sone=&record_sep($$records[0]);
! 536: if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
! 537: if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
! 538:
! 539: $r->print('Samples<br /><table border="2"><tr>');
! 540: foreach (sort({$a <=> $b} keys(%sone))) { $r->print('<th>Column '.($_+1).'</th>'); }
! 541: $r->print('</tr>');
! 542: foreach my $hash (\%sone,\%stwo,\%sthree) {
! 543: $r->print('<tr>');
! 544: foreach (sort({$a <=> $b} keys(%sone))) {
! 545: $r->print('<td>');
! 546: if (defined($$hash{$_})) { $r->print($$hash{$_}); }
! 547: $r->print('</td>');
! 548: }
! 549: $r->print('</tr>');
! 550: }
! 551: $r->print('</tr></table><br />'."\n");
! 552: }
! 553:
! 554: # ======Prints a table to create associations between values and table columns
! 555: # $r is an Apache Request ref
! 556: # $records is an arrayref from &Apache::loncommon::upfile_record_sep
! 557: # $d is an array of 2 element arrays (internal name, displayed name)
! 558: sub csv_print_select_table {
! 559: my ($r,$records,$d) = @_;
! 560: my $i=0;my %sone;
! 561: %sone=&record_sep($$records[0]);
! 562: $r->print('Associate columns with student attributes.'."\n".
! 563: '<table border="2"><tr><th>Attribute</th><th>Column</th></tr>'."\n");
! 564: foreach (@$d) {
! 565: my ($value,$display)=@{ $_ };
! 566: $r->print('<tr><td>'.$display.'</td>');
! 567:
! 568: $r->print('<td><select name=f'.$i.
! 569: ' onChange="flip(this.form,'.$i.');">');
! 570: $r->print('<option value="none"></option>');
! 571: foreach (sort({$a <=> $b} keys(%sone))) {
! 572: $r->print('<option value="'.$_.'">Column '.($_+1).'</option>');
! 573: }
! 574: $r->print('</select></td></tr>'."\n");
! 575: $i++;
! 576: }
! 577: $i--;
! 578: return $i;
! 579: }
! 580:
! 581: # ===================Prints a table of sample values from the upload and
! 582: # can make associate samples to internal names
! 583: # $r is an Apache Request ref
! 584: # $records is an arrayref from &Apache::loncommon::upfile_record_sep
! 585: # $d is an array of 2 element arrays (internal name, displayed name)
! 586: sub csv_samples_select_table {
! 587: my ($r,$records,$d) = @_;
! 588: my %sone; my %stwo; my %sthree;
! 589: my $i=0;
! 590:
! 591: $r->print('<table border=2><tr><th>Field</th><th>Samples</th></tr>');
! 592: %sone=&record_sep($$records[0]);
! 593: if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
! 594: if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
! 595:
! 596: foreach (sort keys %sone) {
! 597: $r->print('<tr><td><select name=f'.$i.
! 598: ' onChange="flip(this.form,'.$i.');">');
! 599: foreach (@$d) {
! 600: my ($value,$display)=@{ $_ };
! 601: $r->print('<option value='.$value.'>'.$display.'</option>');
! 602: }
! 603: $r->print('</select></td><td>');
! 604: if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }
! 605: if (defined($stwo{$_})) { $r->print($stwo{$_}."</br>\n"); }
! 606: if (defined($sthree{$_})) { $r->print($sthree{$_}."</br>\n"); }
! 607: $r->print('</td></tr>');
! 608: $i++;
! 609: }
! 610: $i--;
! 611: return($i);
1.25 albertel 612: }
1.1 albertel 613: 1;
614: __END__;
1.17 harris41 615:
616:
617: =head1 NAME
618:
619: Apache::loncommon - pile of common routines
620:
621: =head1 SYNOPSIS
622:
623: Referenced by other mod_perl Apache modules.
624:
625: Invocation:
626: &Apache::loncommon::SUBROUTINENAME(ARGUMENTS);
627:
628: =head1 INTRODUCTION
629:
630: Common collection of used subroutines. This collection helps remove
631: redundancy from other modules and increase efficiency of memory usage.
632:
633: Current things done:
634:
635: Makes a table out of the previous homework attempts
636: Inputs result_from_symbread, user, domain, course_id
637: Reads in non-network-related .tab files
638:
639: This is part of the LearningOnline Network with CAPA project
640: described at http://www.lon-capa.org.
641:
642: =head1 HANDLER SUBROUTINE
643:
644: There is no handler subroutine.
645:
646: =head1 OTHER SUBROUTINES
647:
648: =over 4
649:
650: =item *
651:
652: BEGIN() : initialize values from language.tab, copyright.tab, filetypes.tab,
653: and filecategories.tab.
654:
655: =item *
656:
657: languageids() : returns list of all language ids
658:
659: =item *
660:
661: languagedescription() : returns description of a specified language id
662:
663: =item *
664:
665: copyrightids() : returns list of all copyrights
666:
667: =item *
668:
669: copyrightdescription() : returns description of a specified copyright id
670:
671: =item *
672:
673: filecategories() : returns list of all file categories
674:
675: =item *
676:
677: filecategorytypes() : returns list of file types belonging to a given file
678: category
679:
680: =item *
681:
682: fileembstyle() : returns embedding style for a specified file type
683:
684: =item *
685:
686: filedescription() : returns description for a specified file type
687:
688: =item *
689:
690: filedescriptionex() : returns description for a specified file type with
691: extra formatting
692:
693: =item *
694:
695: get_previous_attempt() : return string with previous attempt on problem
696:
697: =item *
698:
699: get_student_view() : show a snapshot of what student was looking at
700:
701: =item *
702:
703: get_student_answers() : show a snapshot of how student was answering problem
704:
705: =item *
706:
707: get_unprocessed_cgi() : get unparsed CGI parameters
708:
709: =item *
710:
711: cacheheader() : returns cache-controlling header code
712:
713: =item *
714:
715: nocache() : specifies header code to not have cache
1.25 albertel 716:
717: =item *
718:
719: add_to_env($name,$value) : adds $name to the %ENV hash with value
720: $value, if $name already exists, the entry is converted to an array
721: reference and $value is added to the array.
1.17 harris41 722:
723: =back
724:
725: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>