[interchange] New UserDB option for read-only attribute

[Mark Johnson]

commit d36488397ae357ec4ecaa0362da9cca56f7ed834
Author: Mark Johnson <mark at endpoint.com>
Date:   Tue Jan 29 10:30:53 2013 -0500

    New UserDB option for read-only attribute
    
    * Identifies fields for which the session value will not overwrite
      the database value. Useful for protected fields that are only to
      be managed by site administrators, particularly for outboard fields
      where you don't want [userdb] to try to create an outboard record
      at all.
    
    * Syntax similar to UserDB 'scratch' attribute, but only valid for keys:
    
      UserDb default  read_only  'field1, field2, field3'

 lib/Vend/UserDB.pm |   10 ++++++++++
 1 files changed, 10 insertions(+), 0 deletions(-)
---
diff --git a/lib/Vend/UserDB.pm b/lib/Vend/UserDB.pm
index 94ef5d0..7e6c776 100644
--- a/lib/Vend/UserDB.pm
+++ b/lib/Vend/UserDB.pm
@@ -951,6 +951,12 @@ sub set_values {
 	my %scratch;
 	my %constant;
 	my %session_hash;
+    my %read_only;
+
+	if ($self->{OPTIONS}{read_only}) {
+		my (@s) = grep /\w/, split /[\s,]+/, $self->{OPTIONS}{read_only} ;
+		$read_only{$_} = 1 for @s;
+	}
 
 	if($self->{OPTIONS}->{scratch}) {
 		my (@s) = grep /\w/, split /[\s,]+/, $self->{OPTIONS}{scratch} ;
@@ -1013,6 +1019,10 @@ sub set_values {
 #::logDebug("set_values saving $_ as $valref->{$_}\n");
 		my $val;
 		my $k;
+        if ($read_only{$_}) {
+            # Pull from get_values only; never write through set_values
+            next;
+        }
 		if ($k = $scratch{$_}) {
 			$val = $scratchref->{$k}
 				if defined $scratchref->{$k};