--- loncom/lonnet/perl/lonnet.pm	2006/06/07 21:15:10	1.746
+++ loncom/lonnet/perl/lonnet.pm	2006/06/16 22:37:35	1.749
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.746 2006/06/07 21:15:10 raeburn Exp $
+# $Id: lonnet.pm,v 1.749 2006/06/16 22:37:35 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -4655,7 +4655,6 @@ sub files_not_in_path {
 #----------------------------------------------Get portfolio file permissions
 
 sub get_portfile_permissions {
-    # returns a reference to a hash containing contents of file_permissions.db 
     my ($domain,$user) = @_;
     my %current_permissions = &dump('file_permissions',$domain,$user);
     my ($tmp)=keys(%current_permissions);
@@ -4665,45 +4664,140 @@ sub get_portfile_permissions {
 
 #---------------------------------------------Get portfolio file access controls
 
-sub get_access_controls  {
-    # returns a hash containing access control information retrieved from
-    # file_permissions.db. The hash contains key=value pairs where key is
-    # the control type, end date and start date, in the form type_end_start
-    # and value is a string containing access control settings (in XML),
-    #
-    # Internally access_controls are stored in file_permissions.db in an
-    # array of arrays and a hash, where arrays are locks set when a portfolio   
-    # file has been uploaded to an essayresponse problem in a course, and
-    # the hash contains other data. Two keys are currently defined in the hash:  
-    # access and accesscount. The value for accesscount is a scalar - equal to 
-    # the next number to use as the first part of an access control key
-    # when defining a new control. The value for access is an anonymous hash
-    # where keys are access controls and values are settings.
-    #    
+sub get_access_controls {
     my ($current_permissions,$group,$file) = @_;
-    my @access_checks = ();
     my %access; 
     if (defined($file)) {
-        @access_checks = ($file);
+        if (ref($$current_permissions{$file."\0".'accesscontrol'}) eq 'HASH') {
+            foreach my $control (keys(%{$$current_permissions{$file."\0".'accesscontrol'}})) {
+                $access{$file}{$control} = $$current_permissions{$file."\0".$control};
+            }
+        }
     } else {
-        @access_checks = keys(%{$current_permissions});
+        foreach my $key (keys(%{$current_permissions})) {
+            if ($key =~ /\0accesscontrol$/) {
+                if (defined($group)) {
+                    if ($key !~ m-^\Q$group\E/-) {
+                        next;
+                    }
+                }
+                my ($fullpath) = split(/\0/,$key);
+                if (ref($$current_permissions{$key}) eq 'HASH') {
+                    foreach my $control (keys(%{$$current_permissions{$key}})) {
+                        $access{$fullpath}{$control}=$$current_permissions{$fullpath."\0".$control};
+                    }
+                }
+            }
+        }
     }
-    foreach my $file_name (@access_checks) {
-        my $value = $$current_permissions{$file_name};
-        if (defined($group)) {
-            if ($file_name !~ m-^\Q$group\E/-) {
-                next;
+    return %access;
+}
+
+sub parse_access_controls {
+    my ($access_item) = @_;
+    my %content;
+    my $token;
+    my $parser=HTML::TokeParser->new(\$access_item);
+    while ($token=$parser->get_token) {
+        if ($token->[0] eq 'S')  {
+            my $entry=$token->[1];
+            if ($entry eq 'scope') {
+                my $type = $token->[2]{'type'};
+            } else {
+                my $value=$parser->get_text('/'.$entry);
+                $content{$entry}=$value;
             }
         }
-        if (ref($value) eq "ARRAY") {
-            foreach my $stored_what (@{$value}) {
-                if (ref($stored_what) eq 'HASH') {
-                    $access{$file_name} = $$stored_what{'access'};
+    }
+    return %content;
+}
+
+sub modify_access_controls {
+    my ($file_name,$changes,$domain,$user)=@_;
+    my ($outcome,$deloutcome);
+    my %store_permissions;
+    my %new_values;
+    my %new_control;
+    my %translation;
+    my @deletions = ();
+    my $now = time;
+    if (exists($$changes{'activate'})) {
+        if (ref($$changes{'activate'}) eq 'HASH') {
+            my @newitems = sort(keys(%{$$changes{'activate'}}));
+            my $numnew = scalar(@newitems);
+            for (my $i=0; $i<$numnew; $i++) {
+                my $newkey = $newitems[$i];
+                my $newid = &Apache::loncommon::get_cgi_id();
+                $newkey =~ s/^(\d+)/$newid/;
+                $translation{$1} = $newid;
+                $new_values{$file_name."\0".$newkey} = 
+                                          $$changes{'activate'}{$newitems[$i]};
+                $new_control{$newkey} = $now;
+            }
+        }
+    }
+    my %todelete;
+    my %changed_items;
+    foreach my $action ('delete','update') {
+        if (exists($$changes{$action})) {
+            if (ref($$changes{$action}) eq 'HASH') {
+                foreach my $key (keys(%{$$changes{$action}})) {
+                    my ($itemnum) = ($key =~ /^([^:]+):/);
+                    if ($action eq 'delete') { 
+                        $todelete{$itemnum} = 1;
+                    } else {
+                        $changed_items{$itemnum} = $key;
+                    }
                 }
             }
         }
     }
-    return %access;
+    # get lock on access controls for file.
+    my $lockhash = {
+                  $file_name."\0".'locked_access_records' => $env{'user.name'}.
+                                                       ':'.$env{'user.domain'},
+                   }; 
+    my $tries = 0;
+    my $gotlock = &newput('file_permissions',$lockhash,$domain,$user);
+   
+    while (($gotlock ne 'ok') && $tries <3) {
+        $tries ++;
+        sleep 1;
+        $gotlock = &newput('file_permissions',$lockhash,$domain,$user);
+    }
+    if ($gotlock eq 'ok') {
+        my %curr_permissions = &dump('file_permissions',$domain,$user,$file_name);
+        my ($tmp)=keys(%curr_permissions);
+        if ($tmp=~/^error:/) { undef(%curr_permissions); }
+        if (exists($curr_permissions{$file_name."\0".'accesscontrol'})) {
+            my $curr_controls = $curr_permissions{$file_name."\0".'accesscontrol'};
+            if (ref($curr_controls) eq 'HASH') {
+                foreach my $control_item (keys(%{$curr_controls})) {
+                    my ($itemnum) = ($control_item =~ /^([^:]+):/);
+                    if (defined($todelete{$itemnum})) {
+                        push(@deletions,$file_name."\0".$control_item);
+                    } else {
+                        if (defined($changed_items{$itemnum})) {
+                            $new_control{$changed_items{$itemnum}} = $now;
+                            push(@deletions,$file_name."\0".$control_item);
+                            $new_values{$file_name."\0".$changed_items{$itemnum}} = $$changes{'update'}{$changed_items{$itemnum}};
+                        } else {
+                            $new_control{$control_item} = $$curr_controls{$control_item};
+                        }
+                    }
+                }
+            }
+        }
+        $deloutcome = &del('file_permissions',\@deletions,$domain,$user);
+        $new_values{$file_name."\0".'accesscontrol'} = \%new_control;
+        $outcome = &put('file_permissions',\%new_values,$domain,$user);
+        #  remove lock
+        my @del_lock = ($file_name."\0".'locked_access_records');
+        my $dellockoutcome = &del('file_permissions',\@del_lock,$domain,$user);
+    } else {
+        $outcome = "error: could not obtain lockfile\n";  
+    }
+    return ($outcome,$deloutcome,\%new_values,\%translation);
 }
 
 #------------------------------------------------------Get Marked as Read Only
@@ -4723,9 +4817,7 @@ sub get_marked_as_readonly {
         if (ref($value) eq "ARRAY"){
             foreach my $stored_what (@{$value}) {
                 my $cmp2=$stored_what;
-                if (ref($stored_what eq 'HASH')) {
-                    next;
-                } elsif (ref($stored_what eq 'ARRAY')) {
+                if (ref($stored_what eq 'ARRAY')) {
                     $cmp2=join('',@{$stored_what});
                 }
                 if ($cmp1 eq $cmp2) {
@@ -4785,9 +4877,7 @@ sub unmark_as_readonly {
         if (ref($current_locks) eq "ARRAY"){
             foreach my $locker (@{$current_locks}) {
                 my $compare=$locker;
-                if (!ref($locker) eq 'ARRAY') {
-                    push(@new_locks,$locker);
-                } else {   
+                if (ref($locker) eq 'ARRAY') {
                     $compare=join('',@{$locker});
                     if ($compare ne $symb_crs) {
                         push(@new_locks, $locker);
@@ -7580,6 +7670,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: <key>' -> failed to anything out of $storehash, as at
+                        least <key> already existed in the db (other
+                        requested keys may also already exist)
+ 'error: <msg>' -> 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)
@@ -7814,6 +7929,103 @@ 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 (keys are file names) of hashes containing
+        keys are: path to file/file_name\0uniqueID:scope_end_start (see below)
+        values are XML containing access control settings (see below) 
+
+Internal notes:
+
+ access controls are stored in file_permissions.db as key=value pairs.
+    key -> path to file/file_name\0uniqueID:scope_end_start
+        where scope -> public,guest,course,group,domains or users.
+              end -> UNIX time for end of access (0 -> no end date)
+              start -> UNIX time for start of access
+
+    value -> XML description of access control
+           <scope type=""> (type =1 of: public,guest,course,group,domains,users">
+            <start></start>
+            <end></end>
+
+            <password></password>  for scope type = guest
+
+            <domain></domain>     for scope type = course or group
+            <number></number>
+            <roles id="">
+             <role></role>
+             <access></access>
+             <section></section>
+             <group></group>
+            </roles>
+
+            <dom></dom>         for scope type = domains
+
+            <users>             for scope type = users
+             <user>
+              <uname></uname>
+              <udom></udom>
+             </user>
+            </users>
+           </scope> 
+              
+ Access data is also aggregated for each file in an additional key=value pair:
+ key -> path to file/file_name\0accesscontrol 
+ value -> reference to hash
+          hash contains key = value pairs
+          where key = uniqueID:scope_end_start
+                value = UNIX time record was last updated
+
+          Used to improve speed of look-ups of access controls for each file.  
+ 
+ Locks on files (resulting from submission of portfolio file to a homework problem stored in array of arrays.
+
+parse_access_controls():
+
+Parses XML of an access control record
+Args
+1. Text string (XML) of access comtrol record
+
+Returns:
+1. Hash of access control settings. 
+
+modify_access_controls():
+
+Modifies access controls for a portfolio file
+Args
+1. file name
+2. reference to hash of required changes,
+3. domain
+4. username
+  where domain,username are the domain of the portfolio owner 
+  (either a user or a course) 
+
+Returns:
+1. result of additions or updates ('ok' or 'error', with error message). 
+2. result of deletions ('ok' or 'error', with error message).
+3. reference to hash of any new or updated access controls.
+4. reference to hash used to map incoming IDs to uniqueIDs assigned to control.
+   key = integer (inbound ID)
+   value = uniqueID  
+
 =back
 
 =head2 HTTP Helper Routines