--- loncom/lonnet/perl/lonnet.pm 2005/04/18 21:10:41 1.625 +++ loncom/lonnet/perl/lonnet.pm 2005/04/25 17:18:15 1.629 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.625 2005/04/18 21:10:41 raeburn Exp $ +# $Id: lonnet.pm,v 1.629 2005/04/25 17:18:15 banghart Exp $ # # Copyright Michigan State University Board of Trustees # @@ -258,6 +258,7 @@ sub critical { sub transfer_profile_to_env { my ($lonidsdir,$handle)=@_; + undef(%env); my @profile; { open(my $idf,"$lonidsdir/$handle.id"); @@ -827,8 +828,11 @@ sub getsection { } sub save_cache { + my ($r)=@_; + if (! $r->is_initial_req()) { return DECLINED; } &purge_remembered(); undef(%env); + return OK; } my $to_remember=-1; @@ -2561,10 +2565,16 @@ sub convert_dump_to_currentdump{ return \%returnhash; } +# ------------------------------------------------------ critical inc interface + +sub cinc { + return &inc(@_,'critical'); +} + # --------------------------------------------------------------- inc interface sub inc { - my ($namespace,$store,$udomain,$uname) = @_; + my ($namespace,$store,$udomain,$uname,$critical) = @_; if (!$udomain) { $udomain=$env{'user.domain'}; } if (!$uname) { $uname=$env{'user.name'}; } my $uhome=&homeserver($uname,$udomain); @@ -2582,7 +2592,11 @@ sub inc { } } $items=~s/\&$//; - return &reply("inc:$udomain:$uname:$namespace:$items",$uhome); + if ($critical) { + return &critical("inc:$udomain:$uname:$namespace:$items",$uhome); + } else { + return &reply("inc:$udomain:$uname:$namespace:$items",$uhome); + } } # --------------------------------------------------------------- put interface @@ -2639,21 +2653,6 @@ sub cput { return &critical("put:$udomain:$uname:$namespace:$items",$uhome); } -# ------------------------------------------------------ critical inc interface - -sub cinc { - my ($namespace,$storehash,$udomain,$uname)=@_; - if (!$udomain) { $udomain=$env{'user.domain'}; } - if (!$uname) { $uname=$env{'user.name'}; } - my $uhome=&homeserver($uname,$udomain); - my $items=''; - foreach (keys %$storehash) { - $items.=escape($_).'='.&freeze_escape($$storehash{$_}).'&'; - } - $items=~s/\&$//; - return &critical("inc:$udomain:$uname:$namespace:$items",$uhome); -} - # -------------------------------------------------------------- eget interface sub eget { @@ -3758,7 +3757,6 @@ sub mark_as_readonly { my %current_permissions = &dump('file_permissions',$domain,$user); my ($tmp)=keys(%current_permissions); if ($tmp=~/^error:/) { undef(%current_permissions); } - foreach my $file (@{$files}) { push(@{$current_permissions{$file}},$what); } @@ -3837,17 +3835,21 @@ sub files_not_in_path { #--------------------------------------------------------------Get Marked as Read Only + sub get_marked_as_readonly { my ($domain,$user,$what) = @_; my %current_permissions = &dump('file_permissions',$domain,$user); my ($tmp)=keys(%current_permissions); if ($tmp=~/^error:/) { undef(%current_permissions); } - my @readonly_files; + my $cmp1=$what; + if (ref($what)) { $cmp1=join('',@{$what}) }; while (my ($file_name,$value) = each(%current_permissions)) { if (ref($value) eq "ARRAY"){ foreach my $stored_what (@{$value}) { - if ($stored_what eq $what) { + my $cmp2=$stored_what; + if (ref($stored_what)) { $cmp2=join('',@{$stored_what}) }; + if ($cmp1 eq $cmp2) { push(@readonly_files, $file_name); } elsif (!defined($what)) { push(@readonly_files, $file_name); @@ -3882,13 +3884,13 @@ sub get_marked_as_readonly_hash { # ------------------------------------------------------------ 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) = @_; + # unmarks $file_name (if $file_name is defined), or all files locked by $what + # for portfolio submissions, $what contains [$symb,$crsid] + my ($domain,$user,$what,$file_name) = @_; + my $symb_crs = join('',@$what); my %current_permissions = &dump('file_permissions',$domain,$user); my ($tmp)=keys(%current_permissions); if ($tmp=~/^error:/) { undef(%current_permissions); } - my @readonly_files = &get_marked_as_readonly($domain,$user,$what); foreach my $file(@readonly_files){ my $current_locks = $current_permissions{$file}; @@ -3896,7 +3898,12 @@ sub unmark_as_readonly { my @del_keys; if (ref($current_locks) eq "ARRAY"){ foreach my $locker (@{$current_locks}) { - unless ($locker eq $what) { + &logthis("$$locker[0].$$locker[1] eq $symb_crs"); + if ($$locker[0].$$locker[1] eq $symb_crs) { + if (defined($file_name) && ($file_name ne $file)) { + push(@new_locks, $what); + } + } else { push(@new_locks, $what); } } @@ -4952,7 +4959,8 @@ sub symbread { if ($#possibilities==0) { # ----------------------------------------------- There is only one possibility my ($mapid,$resid)=split(/\./,$ids); - $syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid; + $syval=&encode_symb($bighash{'map_id_'.$mapid}, + $resid,$thisfn); } elsif (!$donotrecurse) { # ------------------------------------------ There is more than one possibility my $realpossible=0; @@ -4962,8 +4970,8 @@ sub symbread { my ($mapid,$resid)=split(/\./,$_); if ($bighash{'map_type_'.$mapid} ne 'page') { $realpossible++; - $syval=declutter($bighash{'map_id_'.$mapid}). - '___'.$resid; + $syval=&encode_symb($bighash{'map_id_'.$mapid}, + $resid,$thisfn); } } } @@ -4977,7 +4985,6 @@ sub symbread { } if ($syval) { return $env{$cache_str}=$syval; - #return $env{$cache_str}=&symbclean($syval.'___'.$thisfn); } } &appenv('request.ambiguous' => $thisfn); @@ -5325,6 +5332,7 @@ sub receipt { sub getfile { my ($file) = @_; + &Apache::lonnet::logthis("file name is $file"); if ($file =~ m -^/*(uploaded|editupload)/-) { $file=&filelocation("",$file); } &repcopy($file); return &readfile($file);