--- loncom/interface/loncommon.pm 2002/02/26 20:59:28 1.25 +++ 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.25 2002/02/26 20:59:28 albertel Exp $ +# $Id: loncommon.pm,v 1.32 2002/04/22 15:26:46 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -143,10 +143,193 @@ BEGIN { "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? @@ -273,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.=''; @@ -359,7 +549,7 @@ sub get_student_answers { sub get_unprocessed_cgi { my ($query,$possible_names)= @_; - $Apache::lonxml::debug=1; + # $Apache::lonxml::debug=1; foreach (split(/&/,$query)) { my ($name, $value) = split(/=/,$_); $name = &Apache::lonnet::unescape($name); @@ -367,7 +557,7 @@ sub get_unprocessed_cgi { $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; &Apache::lonxml::debug("Seting :$name: to :$value:"); - &add_to_env('form.'.$name,$value); + unless (defined($ENV{'form.'.$name})) { &add_to_env('form.'.$name,$value) }; } } } @@ -392,8 +582,8 @@ sub no_cache { sub add_to_env { my ($name,$value)=@_; - if ($ENV{$name}) { - if (defined(@{ $ENV{$name} })) { + if (defined($ENV{$name})) { + if (ref($ENV{$name})) { #already have multiple values push(@{ $ENV{$name} },$value); } else { @@ -406,6 +596,203 @@ sub add_to_env { $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__;
FieldSamples
'); + if (defined($sone{$_})) { $r->print($sone{$_}."
\n"); } + if (defined($stwo{$_})) { $r->print($stwo{$_}."
\n"); } + if (defined($sthree{$_})) { $r->print($sthree{$_}."
\n"); } + $r->print('