--- loncom/interface/loncommon.pm 2001/12/25 21:02:35 1.20 +++ loncom/interface/loncommon.pm 2002/04/22 15:26:46 1.32 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.20 2001/12/25 21:02:35 www Exp $ +# $Id: loncommon.pm,v 1.32 2002/04/22 15:26:46 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -30,7 +30,9 @@ # 12/11,12/12,12/17 Scott Harrison # 12/21 Gerd Kortemeyer # 12/21 Scott Harrison -# 12/25 Gerd Kortemeyer +# 12/25,12/28 Gerd Kortemeyer +# YEAR=2002 +# 1/4 Gerd Kortemeyer # Makes a table out of the previous attempts # Inputs result_from_symbread, user, domain, course_id @@ -39,10 +41,13 @@ package Apache::loncommon; use strict; +use Apache::lonnet(); use POSIX qw(strftime); use Apache::Constants qw(:common); use Apache::lonmsg(); +my $readit; + # ----------------------------------------------- Filetypes/Languages/Copyright my %language; my %cprtag; @@ -50,17 +55,19 @@ my %fe; my %fd; my %fc; # -------------------------------------------------------------- Thesaurus data -my @therelated=(); -my @theword=(); -my @thecount=(); -my %theindex=(); -my $thetotalcount=0; +my @therelated; +my @theword; +my @thecount; +my %theindex; +my $thetotalcount; my $thefuzzy=2; my $thethreshold=0.1/$thefuzzy; my $theavecount; # ----------------------------------------------------------------------- BEGIN BEGIN { + + unless ($readit) { # ------------------------------------------------------------------- languages { my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. @@ -132,9 +139,197 @@ BEGIN { } $theavecount=$thetotalcount/$#thecount; } + &Apache::lonnet::logthis( + "INFO: Read file types and thesaurus"); + $readit=1; +} + } # ============================================================= END BEGIN BLOCK +############################################################### +## Authentication changing form generation subroutines ## +############################################################### +## +## All of the authform_xxxxxxx subroutines take their inputs in a +## hash, and have reasonable default values. +## +## formname = the name given in the
tag. +sub authform_header{ + my %in = ( + formname => 'cu', + kerb_def_dom => 'MSU.EDU', + @_, + ); + $in{'formname'} = 'document.' . $in{'formname'}; + my $result=''; + $result.=<<"END"; +var current = new Object(); +current.radiovalue = 'nochange'; +current.argfield = null; + +function changed_radio(choice,currentform) { + var choicearg = choice + 'arg'; + // If a radio button in changed, we need to change the argfield + if (current.radiovalue != choice) { + current.radiovalue = choice; + if (current.argfield != null) { + currentform.elements[current.argfield].value = ''; + } + if (choice == 'nochange') { + current.argfield = null; + } else { + current.argfield = choicearg; + switch(choice) { + case 'krb': + currentform.elements[current.argfield].value = + "$in{'kerb_def_dom'}"; + break; + default: + break; + } + } + } + return; +} + +function changed_text(choice,currentform) { + var choicearg = choice + 'arg'; + if (currentform.elements[choicearg].value !='') { + switch (choice) { + case 'krb': currentform.elements[choicearg].value = + currentform.elements[choicearg].value.toUpperCase(); + break; + default: + } + // clear old field + if ((current.argfield != choicearg) && (current.argfield != null)) { + currentform.elements[current.argfield].value = ''; + } + current.argfield = choicearg; + } + set_auth_radio_buttons(choice,currentform); + return; +} + +function set_auth_radio_buttons(newvalue,currentform) { + var i=0; + while (i < currentform.login.length) { + if (currentform.login[i].value == newvalue) { break; } + i++; + } + if (i == currentform.login.length) { + return; + } + current.radiovalue = newvalue; + currentform.login[i].checked = true; + return; +} +END + return $result; +} + +sub authform_authorwarning{ + my $result=''; + $result=<<"END"; +As a general rule, only authors or co-authors should be filesystem +authenticated (which allows access to the server filesystem). +END + return $result; +} + +sub authform_nochange{ + my %in = ( + formname => 'document.cu', + kerb_def_dom => 'MSU.EDU', + @_, + ); + my $result=''; + $result.=<<"END"; + +Do not change login data +END + return $result; +} + +sub authform_kerberos{ + my %in = ( + formname => 'document.cu', + kerb_def_dom => 'MSU.EDU', + @_, + ); + my $result=''; + $result.=<<"END"; + +Kerberos authenticated with domain + +END + return $result; +} + +sub authform_internal{ + my %args = ( + formname => 'document.cu', + kerb_def_dom => 'MSU.EDU', + @_, + ); + my $result=''; + $result.=<<"END"; + +Internally authenticated (with initial password + +END + return $result; +} + +sub authform_local{ + my %in = ( + formname => 'document.cu', + kerb_def_dom => 'MSU.EDU', + @_, + ); + my $result=''; + $result.=<<"END"; + +Local Authentication with argument + +END + return $result; +} + +sub authform_filesystem{ + my %in = ( + formname => 'document.cu', + kerb_def_dom => 'MSU.EDU', + @_, + ); + my $result=''; + $result.=<<"END"; + +Filesystem authenticated (with initial password + +END + return $result; +} + +############################################################### +## End Authentication changing form generation functions ## +############################################################### + + # ---------------------------------------------------------- Is this a keyword? @@ -261,7 +456,14 @@ sub get_previous_attempt { } $prevattempts=''; foreach (sort(keys %lasthash)) { - $prevattempts.=''; + my ($ign,@parts) = split(/\./,$_); + if (@parts) { + my $data=$parts[-1]; + pop(@parts); + $prevattempts.=''; + } else { + $prevattempts.=''; + } } for ($version=1;$version<=$returnhash{'version'};$version++) { $prevattempts.=''; @@ -346,16 +548,22 @@ sub get_student_answers { } sub get_unprocessed_cgi { - my ($query)= @_; + my ($query,$possible_names)= @_; + # $Apache::lonxml::debug=1; foreach (split(/&/,$query)) { my ($name, $value) = split(/=/,$_); - $value =~ tr/+/ /; - $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; - if (!defined($ENV{'form.'.$name})) { $ENV{'form.'.$name}=$value; } + $name = &Apache::lonnet::unescape($name); + if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) { + $value =~ tr/+/ /; + $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; + &Apache::lonxml::debug("Seting :$name: to :$value:"); + unless (defined($ENV{'form.'.$name})) { &add_to_env('form.'.$name,$value) }; + } } } sub cacheheader { + unless ($ENV{'request.method'} eq 'GET') { return ''; } my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime); my $output .=' @@ -365,10 +573,225 @@ sub cacheheader { sub no_cache { my ($r) = @_; - my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime); + unless ($ENV{'request.method'} eq 'GET') { return ''; } + #my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime); $r->no_cache(1); $r->header_out("Pragma" => "no-cache"); - $r->header_out("Expires" => $date); + #$r->header_out("Expires" => $date); +} + +sub add_to_env { + my ($name,$value)=@_; + if (defined($ENV{$name})) { + if (ref($ENV{$name})) { + #already have multiple values + push(@{ $ENV{$name} },$value); + } else { + #first time seeing multiple values, convert hash entry to an arrayref + my $first=$ENV{$name}; + undef($ENV{$name}); + push(@{ $ENV{$name} },$first,$value); + } + } else { + $ENV{$name}=$value; + } +} + +#---CSV Upload/Handling functions + +# ========================================================= Store uploaded file +# needs $ENV{'form.upfile'} +# return $datatoken to be put into hidden field + +sub upfile_store { + my $r=shift; + $ENV{'form.upfile'}=~s/\r/\n/gs; + $ENV{'form.upfile'}=~s/\f/\n/gs; + $ENV{'form.upfile'}=~s/\n+/\n/gs; + $ENV{'form.upfile'}=~s/\n+$//gs; + + my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}. + '_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$; + { + my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons'). + '/tmp/'.$datatoken.'.tmp'); + print $fh $ENV{'form.upfile'}; + } + return $datatoken; +} + +# ================================================= Load uploaded file from tmp +# needs $ENV{'form.datatoken'} +# sets $ENV{'form.upfile'} to the contents of the file + +sub load_tmp_file { + my $r=shift; + my @studentdata=(); + { + my $fh; + if ($fh=Apache::File->new($r->dir_config('lonDaemons'). + '/tmp/'.$ENV{'form.datatoken'}.'.tmp')) { + @studentdata=<$fh>; + } + } + $ENV{'form.upfile'}=join('',@studentdata); +} + +# ========================================= Separate uploaded file into records +# returns array of records +# needs $ENV{'form.upfile'} +# needs $ENV{'form.upfiletype'} + +sub upfile_record_sep { + if ($ENV{'form.upfiletype'} eq 'xml') { + } else { + return split(/\n/,$ENV{'form.upfile'}); + } +} + +# =============================================== Separate a record into fields +# needs $ENV{'form.upfiletype'} +# takes $record as arg +sub record_sep { + my $record=shift; + my %components=(); + if ($ENV{'form.upfiletype'} eq 'xml') { + } elsif ($ENV{'form.upfiletype'} eq 'space') { + my $i=0; + foreach (split(/\s+/,$record)) { + my $field=$_; + $field=~s/^(\"|\')//; + $field=~s/(\"|\')$//; + $components{$i}=$field; + $i++; + } + } elsif ($ENV{'form.upfiletype'} eq 'tab') { + my $i=0; + foreach (split(/\t+/,$record)) { + my $field=$_; + $field=~s/^(\"|\')//; + $field=~s/(\"|\')$//; + $components{$i}=$field; + $i++; + } + } else { + my @allfields=split(/\,/,$record); + my $i=0; + my $j; + for ($j=0;$j<=$#allfields;$j++) { + my $field=$allfields[$j]; + if ($field=~/^\s*(\"|\')/) { + my $delimiter=$1; + while (($field!~/$delimiter$/) && ($j<$#allfields)) { + $j++; + $field.=','.$allfields[$j]; + } + $field=~s/^\s*$delimiter//; + $field=~s/$delimiter\s*$//; + } + $components{$i}=$field; + $i++; + } + } + return %components; +} + +# =============================== HTML code to select file and specify its type +sub upfile_select_html { + return (<<'ENDUPFORM'); + +
Type: +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 +sub csv_print_samples { + my ($r,$records) = @_; + my (%sone,%stwo,%sthree); + %sone=&record_sep($$records[0]); + if (defined($$records[1])) {%stwo=&record_sep($$records[1]);} + if (defined($$records[2])) {%sthree=&record_sep($$records[2]);} + + $r->print('Samples
History'.$_.'Part '.join('.',@parts).'
'.$data.'		'.$ign.'
Attempt '.$version.'
'); + foreach (sort({$a <=> $b} keys(%sone))) { $r->print(''); } + $r->print(''); + foreach my $hash (\%sone,\%stwo,\%sthree) { + $r->print(''); + foreach (sort({$a <=> $b} keys(%sone))) { + $r->print(''); + } + $r->print(''); + } + $r->print('
Column '.($_+1).'
'); + if (defined($$hash{$_})) { $r->print($$hash{$_}); } + $r->print('

'."\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) +sub csv_print_select_table { + my ($r,$records,$d) = @_; + my $i=0;my %sone; + %sone=&record_sep($$records[0]); + $r->print('Associate columns with student attributes.'."\n". + ''."\n"); + foreach (@$d) { + my ($value,$display)=@{ $_ }; + $r->print(''); + + $r->print(''."\n"); + $i++; + } + $i--; + 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) +sub csv_samples_select_table { + my ($r,$records,$d) = @_; + my %sone; my %stwo; my %sthree; + my $i=0; + + $r->print('
AttributeColumn
'.$display.'
'); + %sone=&record_sep($$records[0]); + if (defined($$records[1])) {%stwo=&record_sep($$records[1]);} + if (defined($$records[2])) {%sthree=&record_sep($$records[2]);} + + foreach (sort keys %sone) { + $r->print(''); + $i++; + } + $i--; + return($i); } 1; __END__; @@ -474,6 +897,12 @@ cacheheader() : returns cache-controllin nocache() : specifies header code to not have cache +=item * + +add_to_env($name,$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. + =back =cut
FieldSamples
'); + if (defined($sone{$_})) { $r->print($sone{$_}."
\n"); } + if (defined($stwo{$_})) { $r->print($stwo{$_}."
\n"); } + if (defined($sthree{$_})) { $r->print($sthree{$_}."
\n"); } + $r->print('