# copyright (C) 1997-2006 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: record.tcl,v 2.75 2006/01/28 19:16:59 jfontain Exp $


class record {

    proc record {this args} switched {$args} {
        switched::complete $this
    }

    proc ~record {this} {
        if {[info exists ($this,root)]} {
            dom::destroy $($this,root)                                                                           ;# cleanup XML data
        }
    }

    proc options {this} {
        return [list\
            [list -file {} {}]\
        ]
    }

    proc set-file {this value} {}

if {$global::withGUI} { ;# >8                                                                                   used only for saving

    # flag viewers requiring initialization configuration special treatment for options that actually are lists:
    array set series {
        ::store,comments {} ::thresholds,addresses {} ::dataTable,columnwidths {} ::freeText,cellindices {}
        ::summaryTable,cellrows {} ::summaryTable,columns {} ::summaryTable,columnwidths {} ::data2DPieChart,cellcolors {}
        ::data3DPieChart,cellcolors {} ::dataGraph,cellcolors {} ::dataStackedGraph,cellcolors {} ::dataBarChart,cellcolors {}
        ::dataSideBarChart,cellcolors {} ::dataStackedBarChart,cellcolors {} ::dataOverlapBarChart,cellcolors {}
        ::formulas::table,cellindexes {} ::formulas::table,cells {} ::formulas::table,rows {} ::currentValueTable,cellrows {}
        ::peer::table,cellrows {} ::predictor,cellcolors {}
    }
    # Note: this method is more appropriate than using special names or characters in configuration switches, since that would imply
    # that the object would have to know that its configuration is to be saved in a special way. It is better to assume that the
    # code responsible for saving data knows about the nature of the data to be saved.
    # Note: all viewers options with switches ending with "text" are stored in text form so that embedded new lines are preserved

    # Warning: options with name ending with "text" or "data" have a special treatment
    proc write {this} {                     ;# save current configuration in XML form (synchronize code with currentConfiguration{})
        variable series

        if {[string length $switched::($this,-file)] == 0} {
            error {-file option undefined}
        }
        set document [dom::create]
        set root [dom::document createElement $document moodssConfiguration]
        dom::document createTextNode [dom::document createElement $root version] $global::applicationVersion
        set seconds [clock seconds]
        dom::document createTextNode [dom::document createElement $root date] [clock format $seconds -format %D]
        dom::document createTextNode [dom::document createElement $root time] [clock format $seconds -format %T]
        set node [dom::document createElement $root configuration]
        foreach name [configuration::variables 0] {
            if {[string equal $name viewerColors]} continue                                                            ;# skip lists
            dom::element setAttribute $node $name [set ::global::$name]
        }
        nodeFromList $node viewerColors $::global::viewerColors                                                    ;# list of colors
        # main window coordinates are not saved as it would be bad manners to force initial window placement
        # use main window size to ignore tool bar presence interference:
        dom::document createTextNode [dom::document createElement $root width] [winfo width $widget::($global::scroll,path)]
        dom::document createTextNode [dom::document createElement $root height] [winfo height $widget::($global::scroll,path)]
        dom::document createTextNode [dom::document createElement $root pollTime] $global::pollTime
        if {[info exists databaseInstances::singleton]} {                                                   ;# database history mode
            set node [dom::document createElement $root databaseRange]
            foreach {from to} [databaseInstances::cursorsRange] {}
            dom::element setAttribute $node from $from
            dom::element setAttribute $node to $to
            set node [dom::document createElement $root databaseViewer]
            set path $widget::($databaseInstances::singleton,path)
            foreach {x y width height} [canvasWindowManager::getGeometry $global::windowManager $path] {}
            foreach {xIcon yIcon} [canvasWindowManager::iconCoordinates $global::windowManager $path] {}
            dom::element setAttribute $node x $x; dom::element setAttribute $node y $y
            dom::element setAttribute $node width $width; dom::element setAttribute $node height $height
            dom::element setAttribute $node xIcon $xIcon; dom::element setAttribute $node yIcon $yIcon
        }
        set modules [dom::document createElement $root modules]
        foreach instance $modules::(instances) {                             ;# note: in modules list, modules are in creation order
            # peer and formulas modules are created by their respective tables viewers
            switch $modules::instance::($instance,module) {formulas - peer continue}
            set namespace $modules::instance::($instance,namespace)
            set module [dom::document createElement $modules module]
            dom::element setAttribute $module namespace $namespace
            dom::document createTextNode [dom::document createElement $module arguments] $modules::instance::($instance,arguments)
            set tables [dom::document createElement $module tables]
            foreach table $dataTable::(list) {                                 ;# note: in tables list, tables are in creation order
                # filter other module tables
                if {![string equal $namespace [namespace qualifiers [composite::cget $table -data]]]} continue
                foreach {x y width height} [canvasWindowManager::getGeometry $global::windowManager $widget::($table,path)] {}
                set level [canvasWindowManager::getStackLevel $global::windowManager $widget::($table,path)]
                foreach {xIcon yIcon} [canvasWindowManager::iconCoordinates $global::windowManager $widget::($table,path)] {}
                # note: icon coordinates are empty if table is not minimized
                set node [dom::document createElement $tables table]
                dom::element setAttribute $node x $x; dom::element setAttribute $node y $y
                dom::element setAttribute $node width $width; dom::element setAttribute $node height $height
                dom::element setAttribute $node level $level
                dom::element setAttribute $node xIcon $xIcon; dom::element setAttribute $node yIcon $yIcon
                set list [dataTable::initializationConfiguration $table]
                if {[llength $list] > 0} {
                    set options [dom::document createElement $node configuration]
                    foreach {switch value} $list {
                        set switch [string trimleft $switch -]      ;# remove heading dash (invalid name start) and restore it later
                        if {[info exists series(::dataTable,$switch)]} {                                    ;# it is actually a list
                            nodeFromList $options $switch $value                                      ;# so store as an encoded list
                        } else {
                            dom::element setAttribute $options $switch $value
                        }
                    }
                }
            }
        }
        set viewers [dom::document createElement $root viewers]
        foreach viewer $viewer::(list) {                                     ;# note: in viewers list, viewers are in creation order
            if {![viewer::saved $viewer]} continue                                               ;# viewer does not want to be saved
            set node [dom::document createElement $viewers viewer]
            set class [classof $viewer]
            dom::element setAttribute $node class $class
            if {[viewer::manageable $viewer]} {      ;# some viewers, such as the thresholds viewer, handle their display themselves
                foreach {x y width height} [canvasWindowManager::getGeometry $global::windowManager $widget::($viewer,path)] {}
                set level [canvasWindowManager::getStackLevel $global::windowManager $widget::($viewer,path)]
                dom::element setAttribute $node x $x; dom::element setAttribute $node y $y
                dom::element setAttribute $node width $width; dom::element setAttribute $node height $height
                dom::element setAttribute $node level $level
                foreach {xIcon yIcon} [canvasWindowManager::iconCoordinates $global::windowManager $widget::($viewer,path)] {}
                if {[string length $xIcon] > 0} {                                        ;# iconfied viewer (such as formulas table)
                    dom::element setAttribute $node xIcon $xIcon; dom::element setAttribute $node yIcon $yIcon
                }
            }
            nodeFromList $node cells [viewer::cells $viewer]                                                        ;# list of cells
            set list [viewer::initializationConfiguration $viewer]
            if {[llength $list] > 0} {
                catch {unset configurationNode}
                foreach {switch value} $list {
                    set switch [string trimleft $switch -]          ;# remove heading dash (invalid name start) and restore it later
                    if {[string equal $switch configurations]} {
                        # some viewers, such as thresholds, need to save several arguments lists instead of just one, so they pass
                        # them as a list of lists under the -configurations switch, which is reserved for that particular usage
                        foreach sublist $value {                    ;# use one entry per list otherwise it looks ugly in a XML sense
                            # use configurations reserved word as a flag so the list of lists can be regenerated at read time:
                            set options [dom::document createElement $node configurations]
                            foreach {switch value} $sublist {
                                set switch [string trimleft $switch -]                   ;# remove heading dash and restore it later
                                if {[info exists series($class,$switch)]} {                                 ;# it is actually a list
                                    nodeFromList $options $switch $value                              ;# so store as an encoded list
                                } else {                                     ;# handle text with embedded new lines and base 64 data
                                    switch -glob [string tolower $switch] {
                                        *text {dom::document createTextNode [dom::document createElement $options $switch] $value}
                                        *data\
                                            {dom::document createCDATASection [dom::document createElement $options $switch] $value}
                                        default {dom::element setAttribute $options $switch $value}
                                    }
                                }
                            }
                        }
                    } else {
                        if {![info exists configurationNode]} {
                            set configurationNode [dom::document createElement $node configuration]
                        }
                        set options $configurationNode
                        if {[info exists series($class,$switch)]} {                                         ;# it is actually a list
                            nodeFromList $options $switch $value                                      ;# so store as an encoded list
                        } else {                                             ;# handle text with embedded new lines and base 64 data
                            switch -glob [string tolower $switch] {
                                *text {dom::document createTextNode [dom::document createElement $options $switch] $value}
                                *data {dom::document createCDATASection [dom::document createElement $options $switch] $value}
                                default {dom::element setAttribute $options $switch $value}
                            }
                        }
                    }
                }
            }
        }
        set images [dom::document createElement $root images]
        foreach {file format data} [images::values] {
            set node [dom::document createElement $images image]
            dom::element setAttribute $node file $file
            dom::element setAttribute $node format $format
            dom::document createCDATASection $node \n$data\n                                             ;# save in a separate block
        }
        set file [open $switched::($this,-file) w+]                                                           ;# create or overwrite
        dom::document configure $document -encoding [fconfigure $file -encoding]                  ;# use fine automatic Tcl encoding
        set data [serialize $document]
        dom::destroy $root                                                                                                ;# cleanup
        puts $file $data
        close $file
    }

} ;# >8

    proc read {this} {
        if {[string length $switched::($this,-file)] == 0} {
            error {-file option undefined}
        }
        if {$switched::($this,-file) eq "-"} {                                                                     ;# standard input
            set file stdin
        } elseif {[catch {set file [open $switched::($this,-file)]} message]} {
            puts stderr $message
            exit 1
        }
        if {[catch {set ($this,root) [dom::parse [::read $file]]} message]} {
            puts stderr "file $switched::($this,-file) is not a valid moodss configuration file:\n$message"
            exit 1
        }
        close $file
        # moodss before 19.0 saved namespace of the first instance of a module without its number suffix (<0>)
        set ($this,convertNamespaces) [expr {[package vcompare [version $this] 19.0] < 0}]
    }

    proc modules {this} {
        set list {}
        foreach node [dom::selectNode $($this,root) /moodssConfiguration/modules/module] {   ;# modules were saved in creation order
            set namespace [dom::element getAttribute $node namespace]
            if {$($this,convertNamespaces)} {
                foreach {name index} [modules::decoded $namespace] {}
                if {[string length $index] == 0} {append namespace <0>}                                     ;# non indexed namespace
            }
            lappend list $namespace
        }
        return $list
    }

    proc modulesWithArguments {this {validateCommand {}}} {  ;# validate command allows filtering out some modules, such as instance
        set list {}
        foreach node [dom::selectNode $($this,root) /moodssConfiguration/modules/module] {
            # not evaluated because namespace may contain interpreted characters, such as ;, $, ...:
            set namespace [dom::element getAttribute $node namespace]
            if {([string length $validateCommand] > 0) && ![uplevel #0 $validateCommand $namespace]} continue
            lappend list $namespace
            eval lappend list [dom::node stringValue [dom::selectNode $node arguments]]
        }
        return $list                                            ;# format: module [-option [value] -option ...] module [-option ...]
    }

    proc pollTime {this} {
        return [dom::node stringValue [dom::selectNode $($this,root) /moodssConfiguration/pollTime]]
    }

    proc sizes {this} {
        return [list\
            [dom::node stringValue [dom::selectNode $($this,root) /moodssConfiguration/width]]\
            [dom::node stringValue [dom::selectNode $($this,root) /moodssConfiguration/height]]\
        ]
    }

    # Note: all viewers options with switches ending with "text" were stored in text form so that embedded new lines are preserved,
    # so apply corresponding special processing.
    # Warning: options with name ending with "text" or "data" have a special treatment
    proc viewersData {this} {
        set list {}
        foreach viewerNode [dom::selectNode $($this,root) /moodssConfiguration/viewers/viewer] {
            set class [dom::element getAttribute $viewerNode class]
            if {$($this,convertNamespaces)} {
                set cells [convertedCells [listFromNode $viewerNode cells]]
            } else {
                set cells [listFromNode $viewerNode cells]
            }
            # note: coordinates, sizes and level may be empty (for thresholds viewer for example)
            lappend list $class $cells [dom::element getAttribute $viewerNode x] [dom::element getAttribute $viewerNode y]\
                [dom::element getAttribute $viewerNode width] [dom::element getAttribute $viewerNode height]\
                [dom::element getAttribute $viewerNode level] [dom::element getAttribute $viewerNode xIcon]\
                [dom::element getAttribute $viewerNode yIcon]    ;# note: icon attributes values returned empty if they do not exist
            set options {}                                                                 ;# in case configuration(s) is(are) empty
            set node [dom::selectNode $viewerNode configuration]
            if {[string length $node] > 0} {                                                          ;# simple viewer configuration
                foreach {name value} [array get [dom::node cget $node -attributes]] {
                    if {$($this,convertNamespaces)} {                      ;# single cell type option for data graphs, bars and pies
                        switch $name totalcell - ymaximumcell {set value [converted $value]}
                    }
                    lappend options -$name $value                                       ;# heading dashes were stripped at save time
                }
                foreach node [dom::selectNode $node *] {                ;# if there are children, they are list or text type options
                    set name [dom::node cget $node -nodeName]                 ;# handle text with embedded new lines or base 64 data
                    switch -glob [string tolower $name] {
                        *text - *data {lappend options -$name [dom::node stringValue $node]}
                        default {lappend options -$name [listFromNode $node]}
                    }
                }
            }
            set nodes [dom::selectNode $viewerNode configurations]
            if {[llength $nodes] > 0} {                             ;# viewer (such as thresholds) with multiple configuration lists
                set lists {}
                foreach node $nodes {
                    set append {}
                    foreach {name value} [array get [dom::node cget $node -attributes]] {
                        lappend append -$name $value                                    ;# heading dashes were stripped at save time
                    }
                    foreach node [dom::selectNode $node *] {                         ;# if there are children, they are list options
                        set name [dom::node cget $node -nodeName]                    ;# text with embedded new lines or base 64 data
                        switch -glob [string tolower $name] {
                            *text - *data {lappend append -$name [dom::node stringValue $node]}
                            default {
                                if {\
                                    $($this,convertNamespaces) &&\
                                    [string equal $class ::formulas::table] && [string equal $name cells]\
                                } {
                                    lappend append -$name [convertedCells [listFromNode $node]]
                                } else {
                                    lappend append -$name [listFromNode $node]
                                }
                            }
                        }
                    }
                    lappend lists $append
                }
                lappend options -configurations $lists
            }                                                               ;# else there may not be any switched configuration data
            lappend list $options
        }
        return $list
    }

    proc tableNode {this namespace creationIndex} {                             ;# index is module data table creation index, from 0
        if {$($this,convertNamespaces) && [string match *<0> $namespace]} {
            # remove trailing namespace index for reading recorded data of the first instance of a module, saved without index
            regsub {<0>$} $namespace {} namespace
        }
        set node [dom::selectNode $($this,root) /moodssConfiguration/modules/module\[@namespace=\"$namespace\"\]]
        if {[string length $node] == 0} {error {internal error: please report to author}}
        # note: table entry may not exist if new views were added to module after the file was saved
        return [lindex [dom::selectNode $node tables/table] $creationIndex]                    ;# tables are saved in creation order
    }

    proc tableWindowManagerData {this namespace creationIndex} {       ;# index is module data table creation index, starting with 0
        if {[string length [set node [tableNode $this $namespace $creationIndex]]] == 0} {
            return {}
        }
        array set data [array get [dom::node cget $node -attributes]]
        return [list $data(x) $data(y) $data(width) $data(height) $data(level) $data(xIcon) $data(yIcon)]
    }

    proc tableOptions {this namespace creationIndex} {                 ;# index is module data table creation index, starting with 0
        if {[string length [set node [tableNode $this $namespace $creationIndex]]] == 0} {
            return {}
        }
        set options {}
        set node [dom::selectNode $node configuration]
        if {[string length $node] > 0} {                                               ;# some switched configuration data was saved
            foreach {name value} [array get [dom::node cget $node -attributes]] {
                lappend options -$name $value                                           ;# heading dashes were stripped at save time
            }
            foreach node [dom::selectNode $node *] {                                 ;# if there are children, they are list options
                lappend options -[dom::node cget $node -nodeName] [listFromNode $node]
            }
        }
        return $options
    }

    proc configurationData {this} {                                                             ;# return a global name / value list
        set node [dom::selectNode $($this,root) /moodssConfiguration/configuration]
        set list [array get [dom::node cget $node -attributes]]
        lappend list viewerColors [listFromNode $node viewerColors]
        return $list
    }

    proc version {this} {                                      ;# return the version of the application that generated the save file
        return [dom::node stringValue [dom::selectNode $($this,root) /moodssConfiguration/version]]
    }

    proc databaseRange {this} {                                               ;# return a list of 2 integers: from and to in seconds
        set node [dom::selectNode $($this,root) /moodssConfiguration/databaseRange]
        if {[string length $node] == 0} {return {}}                                       ;# that must be a real-time type dashboard
        array set data [array get [dom::node cget $node -attributes]]
        return [list $data(from) $data(to)]
    }

    proc databaseViewerWindowManagerData {this} {
        set node [dom::selectNode $($this,root) /moodssConfiguration/databaseViewer]
        if {[string length $node] == 0} {return {}}                                       ;# that must be a real-time type dashboard
        array set data [array get [dom::node cget $node -attributes]]
        return [list $data(x) $data(y) $data(width) $data(height) $data(xIcon) $data(yIcon)]
    }

    proc converted {cell} {      ;# convert cell with non indexed namespace (moodss before 19.0) to cell with namespace indexed at 0
        if {[string length $cell] == 0} {return {}}
        viewer::parse $cell array row column ignore
        set namespace [namespace qualifiers $array]
        foreach {name index} [modules::decoded $namespace] {}
        if {[string length $index] == 0} {                                                                  ;# non indexed namespace
            set cell $namespace<0>::[namespace tail $array]($row,$column)
        }
        return $cell
    }
    proc convertedCells {list} {
        set cells {}
        foreach cell $list {lappend cells [converted $cell]}
        return $cells
    }

if {$global::withGUI} { ;# >8                                                                                   used only for saving

    proc imagesData {this} {                                                                       ;# note: used from moodss 18.2 on
        set list {}
        foreach node [dom::selectNode $($this,root) /moodssConfiguration/images/image] {
            lappend list [dom::element getAttribute $node file] [string trim [dom::node stringValue $node]]     ;# remove formatting
            dom::destroy $node                                                                        ;# free potentially big memory
        }
        return $list
    }

    # Warning: options with name ending with "data" have a special treatment
    proc currentConfiguration {} {       ;# current configuration in a high performance data storage (synchronize code with write{})
        set root [new container]
        # ignore version, data and time which always change between snapshots
        container::bind $root [set container [new container configuration]]
        foreach name [configuration::variables 0] {
            container::set $container $name [set ::global::$name]
        }
        container::set $root width [winfo width $widget::($global::scroll,path)]
        container::set $root height [winfo height $widget::($global::scroll,path)]
        container::set $root pollTime $global::pollTime
        if {[info exists databaseInstances::singleton]} {                                                   ;# database history mode
            container::bind $root [set container [new container databaseRange]]
            foreach {from to} [databaseInstances::cursorsRange] {}
            container::set $container from $from
            container::set $container to $to
            container::bind $root [set container [new container databaseViewer]]
            set path $widget::($databaseInstances::singleton,path)
            foreach {x y width height} [canvasWindowManager::getGeometry $global::windowManager $path] {}
            foreach {xIcon yIcon} [canvasWindowManager::iconCoordinates $global::windowManager $path] {}
            container::set $container x $x; container::set $container y $y
            container::set $container width $width; container::set $container height $height
            container::set $container xIcon $xIcon; container::set $container yIcon $yIcon
        }
        container::bind $root [set modules [new container modules]]
        foreach instance $modules::(instances) {                             ;# note: in modules list, modules are in creation order
            set namespace $modules::instance::($instance,namespace)
            container::bind $modules [set module [new container module]]
            container::set $module namespace $namespace
            container::set $module arguments $modules::instance::($instance,arguments)
            container::bind $module [set tables [new container tables]]
            foreach table $dataTable::(list) {                                 ;# note: in tables list, tables are in creation order
                # filter other module tables
                if {![string equal $namespace [namespace qualifiers [composite::cget $table -data]]]} continue
                foreach {x y width height} [canvasWindowManager::getGeometry $global::windowManager $widget::($table,path)] {}
                set level [canvasWindowManager::getStackLevel $global::windowManager $widget::($table,path)]
                foreach {xIcon yIcon} [canvasWindowManager::iconCoordinates $global::windowManager $widget::($table,path)] {}
                # note: icon coordinates are empty if table is not minimized
                container::bind $tables [set container [new container table]]
                container::set $container x $x; container::set $container y $y
                container::set $container width $width; container::set $container height $height
                container::set $container level $level
                container::set $container xIcon $xIcon; container::set $container yIcon $yIcon
                set list [dataTable::initializationConfiguration $table]
                if {[llength $list] > 0} {
                    container::bind $container [set options [new container configuration]]
                    foreach {switch value} $list {
                        container::set $options $switch $value
                    }
                }
            }
        }
        container::bind $root [set viewers [new container viewers]]
        foreach viewer $viewer::(list) {                                     ;# note: in viewers list, viewers are in creation order
            if {![viewer::saved $viewer]} continue                                               ;# viewer does not want to be saved
            container::bind $viewers [set container [new container viewer]]
            container::set $container class [classof $viewer]
            if {[viewer::manageable $viewer]} {      ;# some viewers, such as the thresholds viewer, handle their display themselves
                foreach {x y width height} [canvasWindowManager::getGeometry $global::windowManager $widget::($viewer,path)] {}
                set level [canvasWindowManager::getStackLevel $global::windowManager $widget::($viewer,path)]
                container::set $container x $x; container::set $container y $y
                container::set $container width $width; container::set $container height $height
                container::set $container level $level
                foreach {xIcon yIcon} [canvasWindowManager::iconCoordinates $global::windowManager $widget::($viewer,path)] {}
                if {[string length $xIcon] > 0} {                                        ;# iconfied viewer (such as formulas table)
                    container::set $container xIcon $xIcon; container::set $container yIcon $yIcon
                }
            }
            container::set $container cells [viewer::cells $viewer]
            set list [viewer::initializationConfiguration $viewer]
            if {[llength $list] > 0} {
                container::bind $container [set options [new container configuration]]
                foreach {switch value} $list {
                    if {[string match -nocase *data $switch]} continue                                          ;# skip base 64 data
                    if {[string equal $switch -configurations]} {
                        foreach list $value {
                            container::bind $options [set configurations [new container configurations]]
                            foreach {switch value} $list {
                                container::set $configurations $switch $value
                            }
                        }
                    } else {
                        container::set $options $switch $value
                    }
                }
            }
        }
        container::bind $root [set images [new container images]]
        foreach file [images::names] {                                                                          ;# ignore image data
            container::bind $images [set container [new container image]]
            container::set $container file $file
        }
        return $root
    }

    proc snapshot {} {                                                                             ;# remember current configuration
        if {[info exists (data)]} {delete $(data)}
        set (data) [currentConfiguration]
    }

    proc changed {} {                                                        ;# see if configuration has changed since last snapshot
        if {[info exists (data)]} {
            set container [currentConfiguration]
            set equal [container::equal $(data) $container]
            delete $container
            return [expr {!$equal}]
        } else {    ;# snapshot was not yet taken, assume there was no change (can happen when user closes window right after start)
            return 0
        }
    }

} ;# >8

}
