[LON-CAPA-cvs] cvs: loncom /interface lonprintout.pm /lonnet/perl lonnet.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Thu, 01 Apr 2004 15:24:45 -0000
This is a MIME encoded message
--albertel1080833085
Content-Type: text/plain
albertel Thu Apr 1 10:24:45 2004 EDT
Modified files:
/loncom/interface lonprintout.pm
/loncom/lonnet/perl lonnet.pm
Log:
- more anon exam stuff, can now successfully create an exam with a CODE, and print it out
- added option to remeber what CODEs where used for latter reference
--albertel1080833085
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20040401102445.txt"
Index: loncom/interface/lonprintout.pm
diff -u loncom/interface/lonprintout.pm:1.287 loncom/interface/lonprintout.pm:1.288
--- loncom/interface/lonprintout.pm:1.287 Wed Mar 24 17:22:04 2004
+++ loncom/interface/lonprintout.pm Thu Apr 1 10:24:44 2004
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Printout
#
-# $Id: lonprintout.pm,v 1.287 2004/03/24 22:22:04 albertel Exp $
+# $Id: lonprintout.pm,v 1.288 2004/04/01 15:24:44 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1001,10 +1001,38 @@
$result .= $print_array[0].' \end{document}';
} elsif (($helper->{'VARS'}->{'PRINT_TYPE'} eq 'problems_for_anon') ||
($helper->{'VARS'}->{'PRINT_TYPE'} eq 'resources_for_anon') ) {
- $selectionmade="Seems to be useless";
+ my $num_todo=$helper->{'VARS'}->{'NUMBER_TO_PRINT_TOTAL'};
+ my $code_name=$helper->{'VARS'}->{'ANON_CODE_STORAGE_NAME'};
+ if ($helper->{'VARS'}->{'REMEBER_ANON_CODES'} != 1) {
+ $code_name=undef;
+ }
my @master_seq=split /\|\|\|/, $helper->{'VARS'}->{'RESOURCES'};
-
- } elsif ($helper->{'VARS'}->{'PRINT_TYPE'} eq 'problems_from_directory') {
+ my ($type) = split(/_/,$helper->{'VARS'}->{'PRINT_TYPE'});
+ my $flag_latex_header_remove = 'NO';
+ my %moreenv = ('textwidth' => &get_textwidth($helper,$LaTeXwidth));
+ my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Print Status','Class Print Status',$num_todo,'inline');
+ my $seed=time+($$<<16)+($$);
+ my %allcodes;
+ for (my $i=0;$i<$num_todo;$i++) {
+ $moreenv{'CODE'}=&get_CODE(\%allcodes,$i,$seed,'6');
+ my ($output,$fullname)=
+ &print_resources($r,$helper,'anonymous',$type,\%moreenv,
+ \@master_seq,$flag_latex_header_remove);
+ $print_array[$i].=$output;
+ &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
+ &mt('last assignment').' '.$fullname);
+ $flag_latex_header_remove = 'YES';
+ }
+ if ($code_name) {
+ my $cdom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
+ my $cnum = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
+ &Apache::lonnet::put('CODEs',
+ { $code_name => join(',',keys(%allcodes)) },
+ $cdom,$cnum);
+ }
+ &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
+ $result .= $print_array[0].' \end{document}';
+ } elsif ($helper->{'VARS'}->{'PRINT_TYPE'} eq 'problems_from_directory') {
#prints selected problems from the subdirectory
$selectionmade = 6;
my @list_of_files=split /\|\|\|/, $helper->{'VARS'}->{'FILES'};
@@ -1162,19 +1190,43 @@
'cgi.'.$identifier.'backref' => $URLback,);
$r->print(<<FINALEND);
-<meta http-equiv="Refresh" content="0; url=/cgi-bin/printout.pl?$identifier">
+<meta http-equiv="Refresh" content="0; url=/cgi-bin/printout.pl?$identifier" />
</body>
</html>
FINALEND
}
+sub num_to_letters {
+ my ($num) = @_;
+ my @nums= split('',$num);
+ my @num_to_let=('A'..'Z');
+ my $word;
+ foreach my $digit (@nums) { $word.=$num_to_let[$digit]; }
+ return $word;
+}
+
+sub get_CODE {
+ my ($all_codes,$num,$seed,$size)=@_;
+ my $max='1'.'0'x$size;
+ srand($seed);
+ my $newcode;
+ while(1) {
+ $newcode=int(rand($max));
+ if (!exists($$all_codes{$newcode})) {
+ $$all_codes{$newcode}=1;
+ return &num_to_letters($newcode);
+ }
+ }
+}
sub print_resources {
my ($r,$helper,$person,$type,$moreenv,$master_seq,$remove_latex_header)=@_;
my $current_output = '';
my ($username,$userdomain,$usersection) = split /:/,$person;
my $fullname = &get_name($username,$userdomain);
-
+ if ($person =~ 'anon') {
+ $fullname = "CODE - ".$moreenv->{'CODE'};
+ }
#goes through all resources, checks if they are available for
#current student, and produces output
&Apache::lonnet::delenv('form.counter');
@@ -1485,7 +1537,7 @@
if ($helper->{VARS}->{'assignment'}) {
push @{$printChoices}, ["<b>Problems</b> from <b><i>$sequenceTitle</i></b> for <b>selected students</b>", 'problems_for_students', 'CHOOSE_STUDENTS'];
- push @{$printChoices}, ["<b>Problems</b> from <b><i>$sequenceTitle</i></b> for <b>anonymous students</b>", 'problems_for_anonymous', 'CHOOSE_ANON1'];
+ push @{$printChoices}, ["<b>Problems</b> from <b><i>$sequenceTitle</i></b> for <b>anonymous students</b>", 'problems_for_anon', 'CHOOSE_ANON1'];
}
my $resource_selector=<<RESOURCE_SELECTOR;
<message><br /><big><i><b>Select resources for the assignment</b></i></big><br /></message>
@@ -1514,9 +1566,16 @@
CHOOSE_STUDENTS
&Apache::lonxml::xmlparse($r, 'helper', <<CHOOSE_ANON1);
<state name="CHOOSE_ANON1" title="Select Students and Resources">
+ <nextstate>PAGESIZE</nextstate>
<message><hr width='33%' /><b>Number of anonymous assignments to print?</b></message>
<string variable="NUMBER_TO_PRINT_TOTAL" maxlength="5" size="5"></string>
-
+ <choices variable="REMEBER_ANON_CODES" allowempty="1" multichoice="1">
+ <choice computer="1">
+ Should the CODEs used on this printing be remebered for later?
+ </choice>
+ </choices>
+ <message><b>Names to store the CODEs under for later:</b></message>
+ <string variable="ANON_CODE_STORAGE_NAME" maxlength="50" size="20" />
<message><hr width='33%' /></message>
$resource_selector
</state>
@@ -1525,7 +1584,7 @@
if ($helper->{VARS}->{'assignment'}) {
push @{$printChoices}, ["<b>Resources</b> from <b><i>$sequenceTitle</i></b> for <b>selected students</b>", 'resources_for_students', 'CHOOSE_STUDENTS1'];
- push @{$printChoices}, ["<b>Resources</b> from <b><i>$sequenceTitle</i></b> for <b>anonymous students</b>", 'resources_for_anonymous', 'CHOOSE_ANON2'];
+ push @{$printChoices}, ["<b>Resources</b> from <b><i>$sequenceTitle</i></b> for <b>anonymous students</b>", 'resources_for_anon', 'CHOOSE_ANON2'];
}
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.483 loncom/lonnet/perl/lonnet.pm:1.484
--- loncom/lonnet/perl/lonnet.pm:1.483 Thu Apr 1 10:12:26 2004
+++ loncom/lonnet/perl/lonnet.pm Thu Apr 1 10:24:44 2004
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.483 2004/04/01 15:12:26 albertel Exp $
+# $Id: lonnet.pm,v 1.484 2004/04/01 15:24:44 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -4418,6 +4418,21 @@
return int($txt);
}
+sub numval2 {
+ my $txt=shift;
+ $txt=~tr/A-J/0-9/;
+ $txt=~tr/a-j/0-9/;
+ $txt=~tr/K-T/0-9/;
+ $txt=~tr/k-t/0-9/;
+ $txt=~tr/U-Z/0-5/;
+ $txt=~tr/u-z/0-5/;
+ $txt=~s/\D//g;
+ my @txts=split(/(\d\d\d\d\d\d\d\d\d)/,$txt);
+ my $total;
+ foreach my $val (@txts) { $total+=$val; }
+ return int($total);
+}
+
sub latest_rnd_algorithm_id {
return '64bit2';
}
@@ -4433,9 +4448,9 @@
if (!$domain) { $domain=$wdomain; }
if (!$username) { $username=$wusername }
my $which=$ENV{"course.$courseid.rndseed"};
- my $CODE=$ENV{'scantron.CODE'};
+ my $CODE=$ENV{'form.CODE'};
if (defined($CODE)) {
- &rndseed_CODE_64bit($symb,$courseid,$domain,$username);
+ return &rndseed_CODE_64bit($symb,$courseid,$domain,$username);
} elsif ($which eq '64bit2') {
return &rndseed_64bit2($symb,$courseid,$domain,$username);
} elsif ($which eq '64bit') {
@@ -4508,12 +4523,13 @@
{
use integer;
my $symbchck=unpack("%32S*",$symb.' ') << 16;
- my $symbseed=numval($symb);
- my $CODEseed=numval($ENV{'scantron.CODE'}) << 16;
+ my $symbseed=numval2($symb);
+ my $CODEchck=unpack("%32S*",$ENV{'form.CODE'}.' ') << 16;
+ my $CODEseed=numval($ENV{'form.CODE'});
my $courseseed=unpack("%32S*",$courseid.' ');
- my $num1=$symbseed+$CODEseed;
- my $num2=$courseseed+$symbchck;
- #&Apache::lonxml::debug("$symbseed:$CODEseed|$courseseed:$symbchck");
+ my $num1=$symbseed+$CODEchck;
+ my $num2=$CODEseed+$courseseed+$symbchck;
+ #&Apache::lonxml::debug("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck");
#&Apache::lonxml::debug("rndseed :$num1:$num2:$symb");
return "$num1,$num2";
}
@@ -4831,7 +4847,7 @@
open(my $config,"</etc/httpd/conf/loncapa.conf");
while (my $configline=<$config>) {
- if ($configline =~ /^[^\#]*PerlSetVar/) {
+ if ($configline=~/\S/ && $configline =~ /^[^\#]*PerlSetVar/) {
my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
chomp($varvalue);
$perlvar{$varname}=$varvalue;
--albertel1080833085--