--- loncom/lonnet/perl/lonnet.pm 2006/06/02 21:32:30 1.743 +++ loncom/lonnet/perl/lonnet.pm 2006/06/08 20:53:34 1.748 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.743 2006/06/02 21:32:30 albertel Exp $ +# $Id: lonnet.pm,v 1.748 2006/06/08 20:53:34 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -4555,9 +4555,15 @@ sub is_locked { $env{'user.domain'},$env{'user.name'}); my ($tmp)=keys(%locked); if ($tmp=~/^error:/) { undef(%locked); } - + if (ref($locked{$file_name}) eq 'ARRAY') { - $is_locked = 'true'; + $is_locked = 'false'; + foreach my $entry (@{$locked{$file_name}}) { + if (ref($entry) eq 'ARRAY') { + $is_locked = 'true'; + last; + } + } } else { $is_locked = 'false'; } @@ -4646,48 +4652,98 @@ sub files_not_in_path { return (@return_files); } -#--------------------------------------------------------------Get Marked as Read Only - +#----------------------------------------------Get portfolio file permissions -sub get_marked_as_readonly { - my ($domain,$user,$what) = @_; +sub get_portfile_permissions { + my ($domain,$user) = @_; my %current_permissions = &dump('file_permissions',$domain,$user); my ($tmp)=keys(%current_permissions); if ($tmp=~/^error:/) { undef(%current_permissions); } + return \%current_permissions; +} + +#---------------------------------------------Get portfolio file access controls + +sub get_access_controls { + my ($current_permissions,$group,$file) = @_; + my @access_checks = (); + my %access; + if (defined($file)) { + @access_checks = ($file); + } else { + @access_checks = keys(%{$current_permissions}); + } + foreach my $file_name (@access_checks) { + my $value = $$current_permissions{$file_name}; + if (defined($group)) { + if ($file_name !~ m-^\Q$group\E/-) { + next; + } + } + if (ref($value) eq "ARRAY") { + foreach my $stored_what (@{$value}) { + if (ref($stored_what) eq 'HASH') { + $access{$file_name} = $$stored_what{'access'}; + } + } + } + } + return %access; +} + +#------------------------------------------------------Get Marked as Read Only + +sub get_marked_as_readonly { + my ($domain,$user,$what,$group) = @_; + my $current_permissions = &get_portfile_permissions($domain,$user); my @readonly_files; my $cmp1=$what; if (ref($what)) { $cmp1=join('',@{$what}) }; - while (my ($file_name,$value) = each(%current_permissions)) { + while (my ($file_name,$value) = each(%{$current_permissions})) { + if (defined($group)) { + if ($file_name !~ m-^\Q$group\E/-) { + next; + } + } if (ref($value) eq "ARRAY"){ foreach my $stored_what (@{$value}) { my $cmp2=$stored_what; - if (ref($stored_what)) { $cmp2=join('',@{$stored_what}) }; + if (ref($stored_what eq 'HASH')) { + next; + } elsif (ref($stored_what eq 'ARRAY')) { + $cmp2=join('',@{$stored_what}); + } if ($cmp1 eq $cmp2) { push(@readonly_files, $file_name); + last; } elsif (!defined($what)) { push(@readonly_files, $file_name); + last; } } - } + } } return @readonly_files; } #-----------------------------------------------------------Get Marked as Read Only Hash sub get_marked_as_readonly_hash { - my ($domain,$user,$what) = @_; - my %current_permissions = &dump('file_permissions',$domain,$user); - my ($tmp)=keys(%current_permissions); - if ($tmp=~/^error:/) { undef(%current_permissions); } - + my ($current_permissions,$group,$what) = @_; my %readonly_files; - while (my ($file_name,$value) = each(%current_permissions)) { + while (my ($file_name,$value) = each(%{$current_permissions})) { + if (defined($group)) { + if ($file_name !~ m-^\Q$group\E/-) { + next; + } + } if (ref($value) eq "ARRAY"){ foreach my $stored_what (@{$value}) { - if ($stored_what eq $what) { - $readonly_files{$file_name} = 'locked'; - } elsif (!defined($what)) { - $readonly_files{$file_name} = 'locked'; + if (ref($stored_what) eq 'ARRAY') { + if ($stored_what eq $what) { + $readonly_files{$file_name} = 'locked'; + } elsif (!defined($what)) { + $readonly_files{$file_name} = 'locked'; + } } } } @@ -4699,13 +4755,13 @@ sub get_marked_as_readonly_hash { sub unmark_as_readonly { # 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 ($domain,$user,$what,$file_name,$group) = @_; my $symb_crs = $what; if (ref($what)) { $symb_crs=join('',@$what); } - my %current_permissions = &dump('file_permissions',$domain,$user); + my %current_permissions = &dump('file_permissions',$domain,$user,$group); my ($tmp)=keys(%current_permissions); if ($tmp=~/^error:/) { undef(%current_permissions); } - my @readonly_files = &get_marked_as_readonly($domain,$user,$what); + my @readonly_files = &get_marked_as_readonly($domain,$user,$what,$group); foreach my $file (@readonly_files) { if (defined($file_name) && ($file_name ne $file)) { next; } my $current_locks = $current_permissions{$file}; @@ -4714,9 +4770,13 @@ sub unmark_as_readonly { if (ref($current_locks) eq "ARRAY"){ foreach my $locker (@{$current_locks}) { my $compare=$locker; - if (ref($locker)) { $compare=join('',@{$locker}) }; - if ($compare ne $symb_crs) { - push(@new_locks, $locker); + if (!ref($locker) eq 'ARRAY') { + push(@new_locks,$locker); + } else { + $compare=join('',@{$locker}); + if ($compare ne $symb_crs) { + push(@new_locks, $locker); + } } } if (scalar(@new_locks) > 0) { @@ -5117,8 +5177,14 @@ sub EXT { if ( (defined($Apache::lonhomework::parsing_a_problem) || defined($Apache::lonhomework::parsing_a_task)) && - ($symbparm eq &symbread()) ) { - return $Apache::lonhomework::history{$qualifierrest}; + ($symbparm eq &symbread()) ) { + # if we are in the middle of processing the resource the + # get the value we are planning on committing + if (defined($Apache::lonhomework::results{$qualifierrest})) { + return $Apache::lonhomework::results{$qualifierrest}; + } else { + return $Apache::lonhomework::history{$qualifierrest}; + } } else { my %restored; if ($publicuser || $env{'request.state'} eq 'construct') { @@ -7499,6 +7565,31 @@ cput($namespace,$storehash,$udom,$uname) =item * +newput($namespace,$storehash,$udom,$uname) : + +Attempts to store the items in the $storehash, but only if they don't +currently exist, if this succeeds you can be certain that you have +successfully created a new key value pair in the $namespace db. + + +Args: + $namespace: name of database to store values to + $storehash: hashref to store to the db + $udom: (optional) domain of user containing the db + $uname: (optional) name of user caontaining the db + +Returns: + 'ok' -> succeeded in storing all keys of $storehash + 'key_exists: ' -> failed to anything out of $storehash, as at + least already existed in the db (other + requested keys may also already exist) + 'error: ' -> unable to tie the DB or other erorr occured + 'con_lost' -> unable to contact request server + 'refused' -> action was not allowed by remote machine + + +=item * + eget($namespace,$storearr,$udom,$uname) : returns hash with keys from array reference filled in from namesp (encrypts the return communication) ($udom and $uname are optional) @@ -7733,6 +7824,45 @@ removeuploadedurl(): convience function Args: url: a full /uploaded/... url to delete +=item * + +get_portfile_permissions(): + Args: + domain: domain of user or course contain the portfolio files + user: name of user or num of course contain the portfolio files + Returns: + hashref of a dump of the proper file_permissions.db + + +=item * + +get_access_controls(): + +Args: + current_permissions: the hash ref returned from get_portfile_permissions() + group: (optional) the group you want the files associated with + file: (optional) the file you want access info on + +Returns: + a hash containing + keys of 'control type' (possiblities?) + values are XML contianing settings + +Internal notes: + + access controls are stored in file_permissions.db as array of arrays and a hash. + array refs -> are locks + hash refs -> all other types of controls + and will contain keys + + 'access' -> hash where keys are access controls and + values are settings (in XML) + + 'accesscount' -> scalar - equal to the next number to + use as the first part of an access + control key when defining a new + control. + =back =head2 HTTP Helper Routines