package TWiki::Prefs::PrefsCache;


=pod

---++ PrefsCache Package Functions

The PrefsCache package holds a cache of topics that have been read in, using
the TopicPrefs class.  These functions manage that cache.

---++ PrefsCache Object

This defines an object used internally by the functions in TWiki::Prefs to hold
preferences.  This object handles the cascading of preferences from site, to
web, to topic/user.

---+++ sub $config->{TWiki}->{Prefs}->{PrefsCache}->new ( $type, $parent, @target )

| Description: | Creates a new Prefs object. |
| Parameter: =$type= | Type of prefs object to create, see notes. |
| Parameter: =$parent= | Prefs object from which to inherit higher-level settings. |
| Parameter: =@target= | What this object stores preferences for, see notes. |

*Notes:* =$type= should be one of "global", "web", "request", or "copy". If the
type is "global", no parent or target should be specified; the object will
cache sitewide preferences.  If the type is "web", =$parent= should hold global
preferences, and @target should contain only the web's name.  If the type is
"request", then $parent should be a "web" preferences object for the current
web, and =@target= should be ( $topicName, $userName ).  $userName should be
just the WikiName, with no web specifier.  If the type is "copy", the result is
a simple copy of =$parent=; no =@target= is needed.

Call like this: =$mainWebPrefs = TWiki::Prefs->new("web", "Main");=

=cut

sub new
{
 
	my $dummy = shift;
	my $config = shift;
	unshift @_,$dummy ;

    my ($theClass, $theType, $theParent, @theTarget) = @_;
    
    my $self;
    
    if ($theType eq "copy") {
	$self = { %$theParent };

	$self->{config}=$config;
	bless $self, $theClass;


	$self->inheritPrefs($theParent);
    } else {
	$self = {};

	$self->{config}=$config;
	bless $self, $theClass;


	$self->{type} = $theType;
	$self->{parent} = $theParent;
	$self->{web} = $theTarget[0] if ($theType eq "web");
	
	if ($theType eq "request") {
	    $self->{topic} = $theTarget[0];
	    $self->{user} = $theTarget[1];
	}

	$self->loadPrefs( 1 );
    }

    return $self;
}

=pod

---+++ sub $config->{TWiki}->{Prefs}->{PrefsCache}->loadPrefs ( $allowCache )

Requests for Prefs object to load preferences from its defining topics,
re-cascading the overrides.  If =$allowCache= is set, the topic cache will be
used to load preferences when applicable.  Topics that must be read will be
placed in the cache regardless of the setting of $allowCache.

=cut

sub loadPrefs
{
    my ($self, $allowCache) = @_;
	my $config = $self->{config} ;

    
    $self->{prefsKeys} = [];
    $self->{prefsVals} = [];
    $self->{prefsHash} = {};
    $self->{finalHash} = {};

    $self->inheritPrefs($self->{parent}) if defined $self->{parent};
    
    if ($self->{type} eq "global") {
	# global prefs
        $self->loadPrefsFromTopic($config->{TWiki}->{twikiWebname}, $config->{TWiki}->{wikiPrefsTopicname}, "", $allowCache);
        $self->loadPrefsFromTopic($config->{TWiki}->{mainWebname}, $config->{TWiki}->{wikiPrefsTopicname}, "", $allowCache);

    } elsif ($self->{type} eq "web") {
	# web prefs
	$self->loadPrefsFromTopic( $self->{web}, $config->{TWiki}->{webPrefsTopicname}, "", $allowCache);

    } elsif ($self->{type} eq "request") {
	# request prefs - read topic and user
	my $parent = $self->{parent};
	my $topicPrefsSetting = $parent->getPreferenceFlag("READTOPICPREFS");
	my $topicPrefsOverride = $parent->getPreferenceFlag("TOPICOVERRIDESUSER");
	if ($topicPrefsSetting && !$topicPrefsOverride) {
	    # topic prefs overridden by user prefs
	    $self->loadPrefsFromTopic( $parent->{web}, $self->{topic}, "", $allowCache);
	}
	$self->loadPrefsFromTopic( $config->{TWiki}->{mainWebname}, $self->{user}, "", $allowCache );
	if ($topicPrefsSetting && $topicPrefsOverride) {
	    # topic prefs override user prefs
	    $self->loadPrefsFromTopic( $parent->{web}, $self->{topic}, "", $allowCache );
	}
    }
}

=pod

---+++ sub $config->{TWiki}->{Prefs}->{PrefsCache}->loadPrefsFromTopic ( $web, $topic, $keyPrefix, $allowCache )

Loads preferences from a topic.  If =$allowCache= is set then cached
settings are used where available.  All settings loaded are prefixed
with =$keyPrefix=.

=cut

sub loadPrefsFromTopic
{
    my ($self, $theWeb, $theTopic, $theKeyPrefix, $allowCache) = @_;
	my $config = $self->{config} ;


    my $topicPrefs;
    
    if ($allowCache && exists( $topicCache{$theWeb}{$theTopic} )) {
	$topicPrefs = $topicCache{$theWeb}{$theTopic};
    } else {
	$topicPrefs = TWiki::Prefs::TopicPrefs->new($config, $theWeb, $theTopic);
    }

    my ($topicKeys, $topicVals) = $topicPrefs->getTopicPrefs();
    
    $theKeyPrefix = "" unless defined $theKeyPrefix;
    for ( my $i = 0; $i < @$topicVals; $i++) {
	$self->_insertPreference($theKeyPrefix . $topicKeys->[$i], $topicVals->[$i]);
    }

    if (exists($self->{prefsHash}{$config->{TWiki}->{Prefs}->{finalPrefsName}})) {
	my $finalPrefsRef = $self->{prefsHash}{$config->{TWiki}->{Prefs}->{finalPrefsName}};
	my @finalPrefsList = split /[\s,]+/, $$finalPrefsRef;
	$self->{finalHash} = { map { $_ => 1 } @finalPrefsList };
    }
    
}

# Private function to insert a value into a PrefsCache object
sub _insertPreference
{
    my ($self, $theKey, $theValue) = @_;
	my $config = $self->{config} ;


    return if (exists $self->{finalHash}{$theKey}); # $theKey is in FINALPREFERENCES, don't update it
    
    if (exists $self->{prefsHash}{$theKey}) {
	# key exists, need to deal with existing preference
	my $valueRef = $self->{prefsHash}{$theKey};
	if ($theKey eq $config->{TWiki}->{Prefs}->{finalPrefsName}) {
	    $$valueRef .= ", $theValue"; # merge final preferences lists
	} else {
	    $$valueRef = $theValue; # simply replace all other values
	}
    } else {
	# new preference setting, no previous value
	my $newIndex = scalar @{ $self->{prefsKeys} };
	$self->{prefsKeys}[$newIndex] = $theKey;
	$self->{prefsVals}[$newIndex] = $theValue;
	$self->{prefsHash}{$theKey} = \$self->{prefsVals}[$newIndex];
    }
    
}

=pod

---+++ sub $config->{TWiki}->{Prefs}->{PrefsCache}->inheritPrefs ( $otherPrefsObject )

Simply copies the preferences contained in the $otherPrefsObject into the
current one, discarding anything that may currently be there.

=cut

sub inheritPrefs
{
    my ($self, $otherPrefsObject) = @_;
	my $config = $self->{config} ;

    $self->{prefsKeys} = [ @{ $otherPrefsObject->{prefsKeys} } ];
    $self->{prefsVals} = [ @{ $otherPrefsObject->{prefsVals} } ];
    $self->{finalHash} = { %{ $otherPrefsObject->{finalHash} } };
    
    for (my $i = 0; $i < @{ $self->{prefsKeys} }; $i++) {
	$self->{prefsHash}{$self->{prefsKeys}[$i]} = \$self->{prefsVals}[$i];
    }
}

=pod

---+++ sub $config->{TWiki}->{Prefs}->{PrefsCache}->replacePreferencesTags ( $text )

Substitutes preferences values for =%PREF%= tags in =$text=, modifying that
parameter in-place.

=cut

sub replacePreferencesTags
{
    my $self = shift;
	my $config = $self->{config} ;


    my $x;
    my $term;

    my $keys = $self->{prefsKeys};
    my $vals = $self->{prefsVals};
    
    for( $x = 0; $x < @$keys; $x++ ) {
        $term = qr/%\Q$keys->[$x]\E%/;
        $_[0] =~ s/$term/$vals->[$x]/ge;
    }
}

=pod

---+++ sub $config->{TWiki}->{Prefs}->{PrefsCache}->getPreferenceValue ( $key )

Returns the stored preference with key =$key=, or "" if no such preference
exists.

=cut

sub getPreferenceValue
{
    my ($self, $theKey) = @_;
	my $config = $self->{config} ;

    if (exists($self->{prefsHash}{$theKey})) {
	return ${ $self->{prefsHash}{$theKey} }; #double dereference
    } else {
	return "";
    }
}

=pod

---+++ sub $config->{TWiki}->{Prefs}->{PrefsCache}->getPreferenceFlag ( $key )

Returns a preference as a flag.  See
=[[#sub_formatAsFlag_prefValue][Prefs::formatAsFlag]]= for details on how
preference values are converted to flags.

=cut

sub getPreferenceFlag
{
    my ( $self, $theKey  ) = @_;
	my $config = $self->{config} ;


    my $value = $self->getPreferenceValue( $theKey );
    return $config->{TWiki}->{Prefs}->formatAsFlag ( $value );
}

# =============================================================================

1;
