--- loncom/lonnet/perl/lonnet.pm 2004/10/12 20:51:54 1.551 +++ loncom/lonnet/perl/lonnet.pm 2004/11/04 23:43:07 1.561 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.551 2004/10/12 20:51:54 albertel Exp $ +# $Id: lonnet.pm,v 1.561 2004/11/04 23:43:07 banghart Exp $ # # Copyright Michigan State University Board of Trustees # @@ -47,9 +47,8 @@ use GDBM_File; use Apache::Constants qw(:common :http); use HTML::LCParser; use Fcntl qw(:flock); -use Apache::loncoursedata; use Apache::lonlocal; -use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw); +use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw nfreeze); use Time::HiRes qw( gettimeofday tv_interval ); my $readit; my $max_connection_retries = 10; # Or some such value. @@ -461,7 +460,7 @@ sub overloaderror { if ($overload>0) { $r->err_headers_out->{'Retry-After'}=$overload; $r->log_error('Overload of '.$overload.' on '.$checkserver); - return 409; + return 413; } return ''; } @@ -853,7 +852,7 @@ sub getsection { } -my $disk_caching_disabled=0; +my $disk_caching_disabled=1; sub devalidate_cache { my ($cache,$id,$name) = @_; @@ -1873,6 +1872,7 @@ sub devalidate { # - the student level sheet of this user in course's homespace # - the assessment level sheet for this resource # for this user in user's homespace + # - current conditional state info my $key=$uname.':'.$udom.':'; my $status= &del('nohist_calculatedsheets', @@ -1887,6 +1887,7 @@ sub devalidate { $uname.' at '.$udom.' for '. $symb.': '.$status); } + &delenv('user.state.'.$cid); } } @@ -2468,7 +2469,6 @@ sub rolesinit { my $author=0; foreach (keys %allroles) { %thesepriv=(); - if (($_!~/^st/) && ($_!~/^ta/) && ($_!~/^cm/)) { $adv=1; } if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; } foreach (split(/:/,$allroles{$_})) { if ($_ ne '') { @@ -2480,6 +2480,7 @@ sub rolesinit { $thesepriv{$privilege}.=$restrictions; } } + if ($thesepriv{'adv'} eq 'F') { $adv=1; } } } $thesestr=''; @@ -2514,7 +2515,7 @@ sub get { my %returnhash=(); my $i=0; foreach (@$storearr) { - $returnhash{$_}=unescape($pairs[$i]); + $returnhash{$_}=&thaw_unescape($pairs[$i]); $i++; } return %returnhash; @@ -2553,7 +2554,7 @@ sub dump { my %returnhash=(); foreach (@pairs) { my ($key,$value)=split(/=/,$_); - $returnhash{unescape($key)}=unescape($value); + $returnhash{unescape($key)}=&thaw_unescape($value); } return %returnhash; } @@ -2599,7 +2600,7 @@ sub currentdump { my ($key,$value)=split(/=/,$_); my ($symb,$param) = split(/:/,$key); $returnhash{&unescape($symb)}->{&unescape($param)} = - &unescape($value); + &thaw_unescape($value); } } return %returnhash; @@ -2665,7 +2666,7 @@ sub put { my $uhome=&homeserver($uname,$udomain); my $items=''; foreach (keys %$storehash) { - $items.=&escape($_).'='.&escape($$storehash{$_}).'&'; + $items.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&'; } $items=~s/\&$//; return &reply("put:$udomain:$uname:$namespace:$items",$uhome); @@ -2704,7 +2705,7 @@ sub cput { my $uhome=&homeserver($uname,$udomain); my $items=''; foreach (keys %$storehash) { - $items.=escape($_).'='.escape($$storehash{$_}).'&'; + $items.=escape($_).'='.&freeze_escape($$storehash{$_}).'&'; } $items=~s/\&$//; return &critical("put:$udomain:$uname:$namespace:$items",$uhome); @@ -2727,7 +2728,7 @@ sub eget { my %returnhash=(); my $i=0; foreach (@$storearr) { - $returnhash{$_}=unescape($pairs[$i]); + $returnhash{$_}=&thaw_unescape($pairs[$i]); $i++; } return %returnhash; @@ -3626,8 +3627,7 @@ sub modify_student_enrollment { $gene = $tmp{'generation'} if (!defined($gene) || $gene eq ''); $uid = $tmp{'id'} if (!defined($uid) || $uid eq ''); } - my $fullname = &Apache::loncoursedata::ProcessFullName($last,$gene, - $first,$middle); + my $fullname = &format_name($first,$middle,$last,$gene,'lastname'); my $reply=cput('classlist', {"$uname:$udom" => join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype) }, @@ -3644,6 +3644,25 @@ sub modify_student_enrollment { return &assignrole($udom,$uname,$uurl,'st',$end,$start); } +sub format_name { + my ($firstname,$middlename,$lastname,$generation,$first)=@_; + my $name; + if ($first ne 'lastname') { + $name=$firstname.' '.$middlename.' '.$lastname.' '.$generation; + } else { + if ($lastname=~/\S/) { + $name.= $lastname.' '.$generation.', '.$firstname.' '.$middlename; + $name=~s/\s+,/,/; + } else { + $name.= $firstname.' '.$middlename.' '.$generation; + } + } + $name=~s/^\s+//; + $name=~s/\s+$//; + $name=~s/\s+/ /g; + return $name; +} + # ------------------------------------------------- Write to course preferences sub writecoursepref { @@ -3762,6 +3781,50 @@ sub diskusage { return $listing; } +# ------------------------------------------------------------- Mark as Read Only + +sub mark_as_readonly { + my ($domain,$user,$files,$what) = @_; + my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user); + foreach my $file (@{$files}) { + push(@{$current_permissions{$file}},$what); + } + &Apache::lonnet::put('file_permissions',\%current_permissions,$domain,$user); + return; +} + +#--------------------------------------------------------------Get Marked as Read Only + +sub get_marked_as_readonly { + my ($domain,$user,$what) = @_; + my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user); + my @readonly_files = []; + while ((my $file_name, my $value) = each %current_permissions) { + if (ref($value) eq "ARRAY"){ + foreach my $stored_what (@{$value}) { + if ($stored_what eq $what) { + push(@readonly_files, $file_name); + } + } + } + } + return @readonly_files; +} + +# ------------------------------------------------------------ Unmark as Read Only + +sub unmark_as_readonly { + # unmarks all files locked by $what + # for portfolio submissions, $what contains $crsid and $symb + my ($domain,$user,$what) = @_; + my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user); + my @readonly_files = &Apache::lonnet::get_marked_as_readonly($domain,$user,$what); + foreach my $file(@readonly_files){ + + } + &Apache::lonnet::put('file_permissions',\%current_permissions,$domain,$user); + return; +} # ------------------------------------------------------------ Directory lister @@ -3871,6 +3934,9 @@ sub GetFileTimestamp { sub directcondval { my $number=shift; + if (!defined($ENV{'user.state.'.$ENV{'request.course.id'}})) { + &Apache::lonuserstate::evalstate(); + } if ($ENV{'user.state.'.$ENV{'request.course.id'}}) { return substr($ENV{'user.state.'.$ENV{'request.course.id'}},$number,1); } else { @@ -5091,13 +5157,15 @@ sub repcopy_userfile { sub tokenwrapper { my $uri=shift; - $uri=~s/^http\:\/\/([^\/]+)//; - $uri=~s/^\///; + $uri=~s|^http\://([^/]+)||; + $uri=~s|^/||; $ENV{'user.environment'}=~/\/([^\/]+)\.id/; my $token=$1; - if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) { - &appenv('userfile.'.$1.'/'.$2.'/'.$3 => $ENV{'request.course.id'}); - return 'http://'.$hostname{ &homeserver($2,$1)}.'/'.$uri. + my (undef,$udom,$uname,$file)=split('/',$uri,4); + if ($udom && $uname && $file) { + $file=~s|(\?\.*)*$||; + &appenv("userfile.$udom/$uname/$file" => $ENV{'request.course.id'}); + return 'http://'.$hostname{ &homeserver($uname,$udom)}.'/'.$uri. (($uri=~/\?/)?'&':'?').'token='.$token. '&tokenissued='.$perlvar{'lonHostID'}; } else { @@ -5230,6 +5298,15 @@ sub clutter { return $thisfn; } +sub freeze_escape { + my ($value)=@_; + if (ref($value)) { + $value=&nfreeze($value); + return '__FROZEN__'.&escape($value); + } + return &escape($value); +} + # -------------------------------------------------------- Escape Special Chars sub escape { @@ -5246,6 +5323,16 @@ sub unescape { return $str; } +sub thaw_unescape { + my ($value)=@_; + if ($value =~ /^__FROZEN__/) { + substr($value,0,10,undef); + $value=&unescape($value); + return &thaw($value); + } + return &unescape($value); +} + sub mod_perl_version { if (defined($perlvar{'MODPERL2'})) { return 2;