--- loncom/lonnet/perl/lonnet.pm 2004/10/26 17:20:09 1.554 +++ 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.554 2004/10/26 17:20:09 www 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. @@ -2470,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 '') { @@ -2482,6 +2480,7 @@ sub rolesinit { $thesepriv{$privilege}.=$restrictions; } } + if ($thesepriv{'adv'} eq 'F') { $adv=1; } } } $thesestr=''; @@ -2516,7 +2515,7 @@ sub get { my %returnhash=(); my $i=0; foreach (@$storearr) { - $returnhash{$_}=unescape($pairs[$i]); + $returnhash{$_}=&thaw_unescape($pairs[$i]); $i++; } return %returnhash; @@ -2555,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; } @@ -2601,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; @@ -2667,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); @@ -2706,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); @@ -2729,7 +2728,7 @@ sub eget { my %returnhash=(); my $i=0; foreach (@$storearr) { - $returnhash{$_}=unescape($pairs[$i]); + $returnhash{$_}=&thaw_unescape($pairs[$i]); $i++; } return %returnhash; @@ -3058,9 +3057,6 @@ sub allowed { return ''; } } - if (!defined($ENV{'user.state.'.$ENV{'request.course.id'}})) { - &Apache::lonuserstate::evalstate(); - } if (&condval($statecond)) { return '2'; } else { @@ -3631,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) }, @@ -3649,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 { @@ -3767,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 @@ -3876,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 { @@ -5237,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 { @@ -5253,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;