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&nbsp;'.($_+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>