--- loncom/lonnet/perl/lonnet.pm 2004/04/05 18:07:38 1.486 +++ loncom/lonnet/perl/lonnet.pm 2004/04/29 07:57:47 1.491 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.486 2004/04/05 18:07:38 www Exp $ +# $Id: lonnet.pm,v 1.491 2004/04/29 07:57:47 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -617,6 +617,7 @@ sub idput { my ($udom,%ids)=@_; my %servers=(); foreach (keys %ids) { + &cput('environment',{'id'=>$ids{$_}},$udom,$_); my $uhom=&homeserver($_,$udom); if ($uhom ne 'no_host') { my $id=&escape($ids{$_}); @@ -627,7 +628,6 @@ sub idput { } else { $servers{$uhom}=$id.'='.$unam; } - &critical('put:'.$udom.':'.$unam.':environment:id='.$id,$uhom); } } foreach (keys %servers) { @@ -1338,6 +1338,12 @@ sub finishuserfileupload { } } +sub removeuserfile { + my ($docuname,$docudom,$fname)=@_; + my $home=&homeserver($docuname,$docudom); + return &reply("removeuserfile:$docudom/$docuname/$fname",$home); +} + # ------------------------------------------------------------------------- Log sub log { @@ -3307,9 +3313,10 @@ sub modify_student_enrollment { } my $fullname = &Apache::loncoursedata::ProcessFullName($last,$gene, $first,$middle); - my $value=&escape($uname.':'.$udom).'='. - &escape(join(':',$end,$start,$uid,$usec,$fullname,$type)); - my $reply=critical('put:'.$cdom.':'.$cnum.':classlist:'.$value,$chome); + my $reply=cput('classlist', + {"$uname:$udom" => + join(':',$end,$start,$uid,$usec,$fullname,$type) }, + $cdom,$cnum); unless (($reply eq 'ok') || ($reply eq 'delayed')) { return 'error: '.$reply; } @@ -3937,7 +3944,7 @@ sub metadata { # if it is a non metadata possible uri return quickly if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|)) || ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) || - ($uri =~ m|home/[^/]+/public_html/|) || ($uri =~ m|^uploaded/|)) { + ($uri =~ m|home/[^/]+/public_html/|)) { return undef; } my $filename=$uri; @@ -3966,7 +3973,10 @@ sub metadata { } my %metathesekeys=(); unless ($filename=~/\.meta$/) { $filename.='.meta'; } - my $metastring=&getfile(&filelocation('',&clutter($filename))); + my $metastring; + if ($uri !~ m|^uploaded/|) { + $metastring=&getfile(&filelocation('',&clutter($filename))); + } my $parser=HTML::LCParser->new(\$metastring); my $token; undef %metathesekeys; @@ -4082,14 +4092,14 @@ sub metadata { #&logthis("extsion1 $extension $key !!"); #no specific packages #how's our extension if ($key!~/^extension_\Q$extension\E&/) { next; } - &metadata_create_pacakge_def($uri,$key,'extension_'.$extension, + &metadata_create_package_def($uri,$key,'extension_'.$extension, \%metathesekeys); } if (!exists($metacache{$uri}->{':packages'})) { foreach my $key (sort(keys(%packagetab))) { #no specific packages well let's get default then if ($key!~/^default&/) { next; } - &metadata_create_pacakge_def($uri,$key,'default', + &metadata_create_package_def($uri,$key,'default', \%metathesekeys); } } @@ -4121,7 +4131,7 @@ sub metadata { return $metacache{$uri}->{':'.$what}; } -sub metadata_create_pacakge_def { +sub metadata_create_package_def { my ($uri,$key,$package,$metathesekeys)=@_; my ($pack,$name,$subp)=split(/\&/,$key); if ($subp eq 'default') { next; } @@ -4438,6 +4448,15 @@ sub latest_rnd_algorithm_id { return '64bit2'; } +sub getCODE { + if (defined($ENV{'form.CODE'})) { return $ENV{'form.CODE'}; } + if (defined($Apache::lonhomework::parsing_a_problem) && + defined($Apache::lonhomework::history{'resource.CODE'})) { + return $Apache::lonhomework::history{'resource.CODE'}; + } + return undef; +} + sub rndseed { my ($symb,$courseid,$domain,$username)=@_; @@ -4449,8 +4468,7 @@ sub rndseed { if (!$domain) { $domain=$wdomain; } if (!$username) { $username=$wusername } my $which=$ENV{"course.$courseid.rndseed"}; - my $CODE=$ENV{'form.CODE'}; - if (defined($CODE)) { + if (defined(&getCODE())) { return &rndseed_CODE_64bit($symb,$courseid,$domain,$username); } elsif ($which eq '64bit2') { return &rndseed_64bit2($symb,$courseid,$domain,$username); @@ -4525,8 +4543,8 @@ sub rndseed_CODE_64bit { use integer; my $symbchck=unpack("%32S*",$symb.' ') << 16; my $symbseed=numval2($symb); - my $CODEchck=unpack("%32S*",$ENV{'form.CODE'}.' ') << 16; - my $CODEseed=numval($ENV{'form.CODE'}); + my $CODEchck=unpack("%32S*",&getCODE().' ') << 16; + my $CODEseed=numval(&getCODE()); my $courseseed=unpack("%32S*",$courseid.' '); my $num1=$symbseed+$CODEchck; my $num2=$CODEseed+$courseseed+$symbchck;