!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: redolog.gs,v 1.7 2008-01-09 22:50:14 stever Exp $
!
! Superclass Hierarchy:
!   RedoLog, Object.
!
!=========================================================================

! Create the class RedoLog, if it does not already exist

expectvalue %String
run
  Object _newKernelSubclass: 'RedoLog'
  instVarNames: #('conflictObjects' 'redoObjects')
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: 743
%

removeallmethods RedoLog
removeallclassmethods RedoLog

category: 'For Documentation Installation only'
classmethod: RedoLog
installDocumentation

| doc |
doc := GsClassDocumentation _newForPrivateGsClass: self.

doc documentClassWith: (GsDocText new).

self description: doc.
%

! ------------------- Class methods for RedoLog
category: 'Instance Creation'
classmethod: RedoLog
new

"Create a new initialized instance."

^ self basicNew initialize
%

! ------------------- Instance methods for RedoLog
category: 'Logging'
method: RedoLog
addLogEntry: aLogEntry

"Add the given log entry to the log.  Update the redo object dictionary."

| redoObj logArray |
redoObj := aLogEntry receiver.

logArray := redoObjects at: redoObj otherwise: nil.
logArray == nil
    ifTrue: [ logArray := redoObjects at: redoObj put: Array new ].

logArray add: aLogEntry
%

category: 'Logging'
method: RedoLog
addConflictObject: aConflictObject for: aRedoObject

"Add an entry in the conflictObjects dictionary, mapping the given
 conflictObject to the given redo object."

(conflictObjects at: aConflictObject otherwise: nil) == nil
    ifTrue: [ conflictObjects at: aConflictObject put: aRedoObject ].
%

category: 'Logging'
method: RedoLog
addLargeConflictObject: aConflictObject for: aRedoObject

"Add an entry in the conflictObjects dictionary, mapping the given
 conflictObject (and all internal nodes for large objects) to the given redo object."

| ar |
aConflictObject _isLarge
  ifFalse: [ ^ self addConflictObject: aConflictObject for: aRedoObject ].

"Get all internal nodes for aConflictObject (including aConflictObject) and add aRedoObject for each of them"
ar := aConflictObject _getInternalNodes.
ar do: [:each |
  (conflictObjects at: each otherwise: nil) == nil
    ifTrue: [ conflictObjects at: each put: aRedoObject ].
].
%

category: 'Logging'
method: RedoLog
addLogEntry: aLogEntry forConflictObject: aConflictObject

"Add the given log entry to the log.  Update the conflict objects and redo
 object dictionary."

| redoObj logArray val |
redoObj := aLogEntry receiver.

val := conflictObjects at: aConflictObject otherwise: nil.
nil == val
    ifTrue: [ conflictObjects at: aConflictObject put: redoObj ].

logArray := redoObjects at: redoObj otherwise: nil.
logArray == nil
    ifTrue: [
        logArray := Array new.
        redoObjects at: redoObj put: logArray
    ].

logArray add: aLogEntry
%

category: 'Logging'
method: RedoLog
clear

"Clear all recorded entries in the dictionaries."

conflictObjects keys do: [ :conflictObj |
    conflictObjects removeKey: conflictObj
].
redoObjects keys do: [ :redoObj |
    redoObjects removeKey: redoObj
].
%

category: 'Accessing'
method: RedoLog
conflictObjects

"Returns the value of the instance variable 'conflictObjects'."

^conflictObjects
%

category: 'Updating'
method: RedoLog
conflictObjects: newValue

"Modify the value of the instance variable 'conflictObjects'."

conflictObjects := newValue
%

category: 'Accessing'
method: RedoLog
conflictObjectsSet

"Returns a set of all conflict objects that were written.  These are the
 objects of possible conflict with other sessions."

^ conflictObjects keys
%

category: 'Commit Processing'
method: RedoLog
getRedoObjectForConflictingObject: aConflictObject

"Returns the redo object that contains the given conflict object that
 conflicted on a commit operation."

| obj |
" first see if a mapping is located in the conflictObjects dictionary "
obj := conflictObjects at: aConflictObject otherwise: nil.
obj == nil
    ifTrue: [
        " if there is a mapping in the redoObjects dictionary,
          returns the argument "
        (redoObjects at: aConflictObject otherwise: nil) ~~ nil
            ifTrue: [ ^ aConflictObject ]
    ].
^ obj
%

category: 'Initializing'
method: RedoLog
initialize

"Initialize the conflictObjects and redoObjects instance variables to new
 Dictionaries."

conflictObjects := IdentityKeyValueDictionary new: 53.
conflictObjects collisionLimit: SmallInteger maximumValue .
redoObjects := IdentityKeyValueDictionary new: 53.
redoObjects collisionLimit: SmallInteger maximumValue .
%

category: 'Accessing'
method: RedoLog
redoObjects

"Returns the value of the instance variable 'redoObjects'."

^redoObjects
%

category: 'Updating'
method: RedoLog
redoObjects: newValue

"Modify the value of the instance variable 'redoObjects'."

redoObjects := newValue
%

! redoOperationsFor deleted, use _redoOperationsForEntries:
category: 'Commit Processing'
method: RedoLog
_redoOperationsForEntries: logEntries
" caller must ensure logEntries is non-nil "
1 to: logEntries size do: [ :i |
    (logEntries at: i) redo ifFalse: [ ^ false ]
].
^ true
%


category: 'Testing'
method: RedoLog
getLogEntriesFor: aRedoObject

"Returns the Array of log entries for the give redo object.  If there
 are none, returns nil."

^ redoObjects at: aRedoObject otherwise: nil.
%

category: 'Formatting'
method: RedoLog
printOn: aStream

"Puts a displayable representation of the receiver on the given stream."

aStream nextPutAll: 'Conflicts ('.
aStream cr.
conflictObjects keysAndValuesDo: [:conflictObj :redoObj | 
    aStream nextPutAll: '[', conflictObj class printString, ', ', conflictObj asOop printString, ']'.
    aStream nextPutAll: '->'.
    aStream nextPutAll: '[', redoObj class printString, ', ', redoObj asOop printString, ']'.
  ].
aStream nextPutAll: ')'; cr.
aStream nextPutAll: 'Redo ('.
aStream cr.
redoObjects keysAndValuesDo: [:redoObj :logEntries| 
    aStream nextPutAll: '[', redoObj class printString, ', ', redoObj asOop printString, ']'.
    aStream cr.
    logEntries do: [:logEntry |
      aStream nextPutAll: logEntry printString
    ].
  ].
aStream nextPutAll: ')'.
%
