dhis2-devs team mailing list archive
-
dhis2-devs team
-
Mailing list archive
-
Message #13332
[Branch ~dhis2-devs-core/dhis2/trunk] Rev 4246: removed some junk
------------------------------------------------------------
revno: 4246
committer: Bob Jolliffe bobjolliffe@xxxxxxxxx
branch nick: dhis2
timestamp: Tue 2011-08-02 20:26:09 +0100
message:
removed some junk
removed:
tools/datamart/scratch/
tools/datamart/scratch/Export_meta.zip
tools/datamart/scratch/bob.tcl
tools/datamart/scratch/hello.tcl
tools/datamart/scratch/http.tcl
tools/datamart/scratch/httpguitest.tcl
tools/datamart/scratch/httptest.tcl
tools/datamart/scratch/inplace.tcl
tools/datamart/scratch/loggerdialog.tcl
tools/datamart/scratch/scratch.tcl
tools/datamart/scratch/sqldisp.tcl
tools/datamart/scratch/test.xlsx
tools/datamart/scratch/transform.tcl
tools/datamart/scratch/view.tcl
--
lp:dhis2
https://code.launchpad.net/~dhis2-devs-core/dhis2/trunk
Your team DHIS 2 developers is subscribed to branch lp:dhis2.
To unsubscribe from this branch go to https://code.launchpad.net/~dhis2-devs-core/dhis2/trunk/+edit-subscription
=== removed directory 'tools/datamart/scratch'
=== removed file 'tools/datamart/scratch/Export_meta.zip'
Binary files tools/datamart/scratch/Export_meta.zip 2011-08-02 19:21:56 +0000 and tools/datamart/scratch/Export_meta.zip 1970-01-01 00:00:00 +0000 differ
=== removed file 'tools/datamart/scratch/bob.tcl'
--- tools/datamart/scratch/bob.tcl 2011-08-02 19:21:56 +0000
+++ tools/datamart/scratch/bob.tcl 1970-01-01 00:00:00 +0000
@@ -1,30 +0,0 @@
-
-lappend auto_path datamart.vfs/libext
-lappend auto_path datamart.vfs/libdhis
-
-package require dhisweb
-package require dhisdb
-package require vfs::zip
-
-source datamart.vfs/transform.tcl
-
-set mntfile [vfs::zip::Mount Export_meta.zip Export_meta.zip]
-file copy -force Export_meta.zip/Export.xml ./Export.xml
-vfs::zip::Unmount $mntfile Export_meta.zip
-set xsltdir datamart.vfs/xslt
-file copy -force $xsltdir/dxf2sql.xsl dxf2sql.xsl
-
-proc readHandler {datard userdata} {
- fconfigure $datard -blocking 1
- set ::data [read $datard]
- close $datard
-}
-
-set data ""
-
-puts "starting"
-transform::transform dxf2sql.xsl Export.xml "test" ::readHandler
-puts "running"
-vwait ::data
-
-puts [expr [string length $::data]/1000]
=== removed file 'tools/datamart/scratch/hello.tcl'
--- tools/datamart/scratch/hello.tcl 2011-08-02 19:21:56 +0000
+++ tools/datamart/scratch/hello.tcl 1970-01-01 00:00:00 +0000
@@ -1,97 +0,0 @@
-package require Tk
- package require BWidget
-
- proc appCreate { } {
-
- # Menu description
- set descmenu {
- "&File" all file 0 {
- {command "&New" {} "New Blank Document" {} -command appNew}
- {command "&Open" {} "Open" {} -command appOpen}
- {command "&Save" {} "Save" {} -command appSave}
- {command "E&xit" {} "Exit Application" {} -command appExit}
- }
- "&Edit" all edit 0 {
- {command "Cu&t" {} "Cut" {Ctrl x} -command appCut}
- {command "&Copy" {} "Copy" {Ctrl c} -command appCopy}
- {command "&Paste" {} "Paste" {Ctrl v} -command appPaste}
- }
- "&Help" all help 0 {
- {command "&About" {} "" {} -command appHelpAbout}
- }
- }
-
- # Create main frame
- set mainframe [MainFrame .mainframe -menu $descmenu]
-
- # toolbar 1 creation
- set tb1 [$mainframe addtoolbar]
- set bbox [ButtonBox $tb1.bbox1 -spacing 0 -padx 1 -pady 1]
- $bbox add -image [Bitmap::get new] -command appNew \
- -highlightthickness 0 -takefocus 0 -relief link \
- -borderwidth 1 -padx 1 -pady 1 \
- -helptext "Create Blank Document"
- $bbox add -image [Bitmap::get open] -command appOpen \
- -highlightthickness 0 -takefocus 0 -relief link \
- -borderwidth 1 -padx 1 -pady 1 \
- -helptext "Open an existing file"
- $bbox add -image [Bitmap::get save] -command appSave \
- -highlightthickness 0 -takefocus 0 -relief link \
- -borderwidth 1 -padx 1 -pady 1 \
- -helptext "Save file"
- pack $bbox -side left -anchor w
-
- set sep [Separator $tb1.sep -orient vertical]
- pack $sep -side left -fill y -padx 4 -anchor w
-
- set bbox [ButtonBox $tb1.bbox2 -spacing 0 -padx 1 -pady 1]
- $bbox add -image [Bitmap::get cut] -command appCut \
- -highlightthickness 0 -takefocus 0 -relief link \
- -borderwidth 1 -padx 1 -pady 1 \
- -helptext "Cut selection"
- $bbox add -image [Bitmap::get copy] -command appCopy \
- -highlightthickness 0 -takefocus 0 -relief link \
- -borderwidth 1 -padx 1 -pady 1 \
- -helptext "Copy selection"
- $bbox add -image [Bitmap::get paste] -command appPaste \
- -highlightthickness 0 -takefocus 0 -relief link \
- -borderwidth 1 -padx 1 -pady 1 \
- -helptext "Paste selection"
- pack $bbox -side left -anchor w
-
- wm protocol . WM_DELETE_WINDOW { appExit }
-
- pack $mainframe -fill both -expand yes
- update idletasks
- }
-
- proc appNew {} {
- }
- proc appOpen {} {
- tk_getOpenFile
- }
- proc appSave {} {
- }
- proc appExit {} {
- exit
- }
- proc appCut {} {
- event generate [focus] <<Cut>>
- }
- proc appCopy {} {
- event generate [focus] <<Copy>>
- }
- proc appPaste {} {
- event generate [focus] <<Paste>>
- }
- proc appHelpAbout {} {
- tk_messageBox -message "Application Template"
- }
-
- proc main {} {
- wm withdraw .
- appCreate
- wm deiconify .
- }
-
- main
\ No newline at end of file
=== removed file 'tools/datamart/scratch/http.tcl'
--- tools/datamart/scratch/http.tcl 2011-08-02 19:21:56 +0000
+++ tools/datamart/scratch/http.tcl 1970-01-01 00:00:00 +0000
@@ -1,44 +0,0 @@
-# exp oo http
-
-package require TclOO
-package require http
-
-oo::class create Httpcon {
-
- variable name token
-
- constructor {pname} {
- set name $pname
- }
-
- method data {socket token} {
- puts "in data handler for $name"
- set d [read $socket]
- set nchars [string length $d]
- puts "data: $d nchars"
- return $nchars
- }
-
- method startfetch {url {timeout 10000} } {
- set token [http::geturl $url -command [list my finished] -handler [self method data] -timeout $timeout]
- }
-
- method dump {} {
- puts "name: $name"
- puts "token: $token"
- upvar \#0 $token state
- parray state
- }
-}
-
-Httpcon create datacon1 "demo login"
-Httpcon create datacon2 "kenya"
-
-datacon1 startfetch http://www.google.com
-
-after 1000 {
- datacon1 dump
-}
-
-vwait forever
-
=== removed file 'tools/datamart/scratch/httpguitest.tcl'
--- tools/datamart/scratch/httpguitest.tcl 2011-08-02 19:21:56 +0000
+++ tools/datamart/scratch/httpguitest.tcl 1970-01-01 00:00:00 +0000
@@ -1,96 +0,0 @@
-lappend auto_path mydatamart.vfs/libext
-lappend auto_path mydatamart.vfs/libdhis
-
-package require sqlite3
-package require dhisweb
-
-sqlite3 db ":memory:"
-db eval "
- DROP TABLE IF EXISTS aggregateddatavalue;
- CREATE TABLE aggregateddatavalue (
- period character varying(8),
- organisationunitid integer,
- dataelementid integer,
- categoryoptioncomboid integer,
- \"value\" double precision,
- periodtype CHAR( 1 ),
- PRIMARY KEY ( period, organisationunitid, dataelementid, categoryoptioncomboid )
- );
-
- DROP TABLE IF EXISTS aggregatedindicatorvalue;
- CREATE TABLE aggregatedindicatorvalue (
- period character varying(8),
- organisationunitid integer,
- indicatorid integer,
- factor double precision,
- numeratorvalue double precision,
- denominatorvalue double precision,
- periodtype CHAR( 1 ),
- PRIMARY KEY ( period, organisationunitid, indicatorid )
- ); "
-
-${::dhisweb::log}::setlevel info
-${::dhisweb::log}::debug "Hello from the logger"
-
-set testhost http://192.168.1.11:8082
-set username admin
-set password district
-# set testhost http://hiskenya.org
-# set username bobjolliffe
-# set password
-
-proc http::Log {args} {
- puts $args
-}
-
-# db eval "BEGIN TRANSACTION"
-proc go {} {
- set tok [::dhisweb::fetchValues $::testhost 3 18 DataValues monthly 20080101 20100331 db]
-
- if {$tok ne 0} {
- parray $tok
- puts "state: [array get $tok state] status: [::http::status $tok] error: [::http::error $tok]"
- } else {
- puts "couldn't connect to $testhost"
- }
- #trace add variable [set tok](valuesRead) write "[list httpreactor $tok]"
-}
-
-proc httpreactor {tok state posterror write} {
- upvar \#0 $tok httpstate
- puts "trace : $state $posterror $write"
- puts "$httpstate(valuesRead) of $httpstate(valuesToRead)"
- #parray httpstate
- if {$httpstate(status) ne ""} {
- set ::done 1
- }
- .p configure -maximum $httpstate(valuesToRead) -value $httpstate(valuesRead)
- update idletasks
-}
-
-proc login {} {
- set logintok [::dhisweb::login $::testhost $::username $::password ]
-}
-
-console show
-button .l -text login -command login
-button .g -text go -command go
-
-ttk::progressbar .p
-
-pack .l .g .p
-
-# while {[::http::status $tok] eq ""} {
-# puts "waiting"
-# vwait $tok
-# puts "state: [array get $tok state]"
-# }
-
-# set done 0
-# vwait done
-
-# db eval "COMMIT TRANSACTION"
-
-# puts "status: [::http::status $tok] error: [::http::error $tok]"
-# puts "[db eval "select count() from aggregateddatavalue"] data values inserted"
-# puts "[db eval "select count() from aggregatedindicatorvalue"] indicator values inserted"
\ No newline at end of file
=== removed file 'tools/datamart/scratch/httptest.tcl'
--- tools/datamart/scratch/httptest.tcl 2011-08-02 19:21:56 +0000
+++ tools/datamart/scratch/httptest.tcl 1970-01-01 00:00:00 +0000
@@ -1,82 +0,0 @@
-lappend auto_path mydatamart.vfs/libext
-lappend auto_path mydatamart.vfs/libdhis
-
-package require sqlite3
-package require dhisweb
-
-sqlite3 db ":memory:"
-db eval "
- DROP TABLE IF EXISTS aggregateddatavalue;
- CREATE TABLE aggregateddatavalue (
- period character varying(8),
- organisationunitid integer,
- dataelementid integer,
- categoryoptioncomboid integer,
- \"value\" double precision,
- periodtype CHAR( 1 ),
- PRIMARY KEY ( period, organisationunitid, dataelementid, categoryoptioncomboid )
- );
-
- DROP TABLE IF EXISTS aggregatedindicatorvalue;
- CREATE TABLE aggregatedindicatorvalue (
- period character varying(8),
- organisationunitid integer,
- indicatorid integer,
- factor double precision,
- numeratorvalue double precision,
- denominatorvalue double precision,
- periodtype CHAR( 1 ),
- PRIMARY KEY ( period, organisationunitid, indicatorid )
- ); "
-
-${::dhisweb::log}::setlevel debug
-${::dhisweb::log}::debug "Hello from the logger"
-
-#set testhost http://192.168.1.11:8082
-#set username admin
-#set password district
- set testhost http://hiskenya.org
- set username bobjolliffe
- set password Easter1916
-
-set logintok [::dhisweb::login $testhost $username $password ]
-
-puts "logging in"
-vwait [set logintok](status)
-
-# db eval "BEGIN TRANSACTION"
-set tok [::dhisweb::fetchValues $testhost 3 18 DataValues monthly 20050101 20110331 db]
-
-if {$tok ne 0} {
- parray $tok
- puts "state: [array get $tok state] status: [::http::status $tok] error: [::http::error $tok]"
-} else {
- puts "couldn't connect to $testhost"
-}
-
-proc httpreactor {tok state posterror write} {
- upvar \#0 $tok httpstate
- puts "trace : $state $posterror $write"
- puts "$httpstate(valuesRead) of $httpstate(valuesToRead)"
- #parray httpstate
- if {$httpstate(status) ne ""} {
- set ::done 1
- }
-}
-
-trace add variable [set tok](valuesRead) write "[list httpreactor $tok]"
-
-while {[::http::status $tok] eq ""} {
- puts "waiting"
- vwait $tok
-# puts "state: [array get $tok state]"
- }
-
-# set done 0
-# vwait done
-
-# db eval "COMMIT TRANSACTION"
-
-# puts "status: [::http::status $tok] error: [::http::error $tok]"
-# puts "[db eval "select count() from aggregateddatavalue"] data values inserted"
-# puts "[db eval "select count() from aggregatedindicatorvalue"] indicator values inserted"
\ No newline at end of file
=== removed file 'tools/datamart/scratch/inplace.tcl'
--- tools/datamart/scratch/inplace.tcl 2011-08-02 19:21:56 +0000
+++ tools/datamart/scratch/inplace.tcl 1970-01-01 00:00:00 +0000
@@ -1,282 +0,0 @@
-# BSD license
-package require Tk 8.5
-
-package provide xtreeview 1.2
-
-namespace eval xtreeview {
- # intercept all the events changing focus
- bind XTreeview <<TreeviewSelect>> "+::xtreeview::checkFocus %W"
- bind XTreeview <ButtonRelease-1> "+::xtreeview::checkFocus %W %x %y"
- bind XTreeview <KeyRelease> "+::xtreeview::checkFocus %W"
- bind XTreeview <ButtonPress-4> "+after idle ::xtreeview::updateWnds %W"
- bind XTreeview <ButtonPress-5> "+after idle ::xtreeview::updateWnds %W"
- bind XTreeview <MouseWheel> "+after idle ::xtreeview::updateWnds %W"
- bind XTreeview <B1-Motion> {+if {$ttk::treeview::State(pressMode)=="resize"} { ::xtreeview::updateWnds %W }}
- bind XTreeview <Configure> "+after idle ::xtreeview::updateWnds %W"
- bind XTreeview <Home> {%W focus [lindex [%W children {}] 0]}
- bind XTreeview <End> {%W focus [lindex [%W children {}] end]}
-
- # images indicating sort order
- image create bitmap ::xtreeview::arrow(0) -data {
- #define arrowUp_width 7
- #define arrowUp_height 4
- static char arrowUp_bits[] = {
- 0x08, 0x1c, 0x3e, 0x7f
- };
- }
- image create bitmap ::xtreeview::arrow(1) -data {
- #define arrowDown_width 7
- #define arrowDown_height 4
- static char arrowDown_bits[] = {
- 0x7f, 0x3e, 0x1c, 0x08
- };
- }
- image create bitmap ::xtreeview::arrowBlank -data {
- #define arrowBlank_width 7
- #define arrowBlank_height 4
- static char arrowBlank_bits[] = {
- 0x00, 0x00, 0x00, 0x00
- };
- }
-
-
- variable curfocus
-
- # check, if focus has changed
- proc checkFocus {w {X {}} {Y {}} } {
- variable curfocus
- if {![info exists curfocus($w)]} {
- set changed 1
- } elseif {$curfocus($w)!=[$w focus]} {
- _clear $w $curfocus($w)
- set changed 1
- } else {
- set changed 0
- }
- set newfocus [$w focus]
- if {$changed} {
- if {$newfocus!=""} {
- _focus $w $newfocus
- if {$X!=""} {
- set col [$w identify column $X $Y]
- if {$col!=""} {
- if {$col!="#0"} {
- set col [$w column $col -id]
- }
- }
- catch {focus $w.$col}
- }
- }
- set curfocus($w) $newfocus
- updateWnds $w
- }
- }
- # update inplace edit widgets positions
- proc updateWnds {w} {
- variable curfocus
- if {![info exists curfocus($w)]} { return }
- set item $curfocus($w)
- if {$item==""} { return }
- foreach col [concat [$w cget -columns] #0] {
- set wnd $w.$col
- if {[winfo exists $wnd]} {
- set bbox [$w bbox $item $col]
- if {$bbox==""} {
- place forget $wnd
- } else {
- place $wnd -x [lindex $bbox 0] -y [lindex $bbox 1] -width [lindex $bbox 2] -height [lindex $bbox 3]
- }
- }
- }
- }
- # remove all inplace edit widgets
- proc _clear {w item} {
- foreach col [concat [$w cget -columns] #0] {
- set wnd $w.$col
- if {[winfo exists $wnd]} {
- destroy $wnd
- }
- }
- }
- # called when focus item has changed
- proc _focus {w item} {
- set cols [$w cget -displaycolumns]
- if {$cols=="#all"} {
- set cols [concat #0 [$w cget -columns]]
- }
- foreach col $cols {
- event generate $w <<TreeviewInplaceEdit>> -data [list $col $item]
- if {[winfo exists $w.$col]} {
- bind $w.$col <Key-Tab> {focus [tk_focusNext %W]}
- bind $w.$col <Shift-Key-Tab> {focus [tk_focusPrev %W]}
- }
- }
- }
- # hierarchical sorting procedure
- proc _sorttree {tree col direction {isroot 1} {root {}} } {
- if {$isroot} {
- if {$col!="#0"} {
- set col [$tree column $col -id]
- }
- set selection [$tree selection]
- $tree selection remove $selection
- set focus [$tree focus]
- $tree focus {}
- checkFocus $tree
- }
- # Build something we can sort
- set data {}
- if {$col=="#0"} {
- foreach row [$tree children $root] {
- lappend data [list [$tree item $row -text] $row]
- }
- } else {
- foreach row [$tree children $root] {
- lappend data [list [$tree set $row $col] $row]
- }
- }
- if {$data!=""} {
- set dir [expr {$direction ? "-decreasing" : "-increasing"}]
- set r -1
- # Now reshuffle the rows into the sorted order
- foreach info [lsort -dictionary -index 0 $dir $data] {
- $tree move [lindex $info 1] $root [incr r]
- if {[$tree item [lindex $info 1] -open]} {
- _sorttree $tree $col $direction 0 [lindex $info 1]
- }
- }
- }
- if {$isroot} {
- # Switch the heading so that it will sort in the opposite direction
- variable curfocus
- catch {
- eval [lindex [after info $curfocus($tree,sorticon)] 0]
- after cancel $curfocus($tree,sorticon)
- }
- set curfocus($tree,sorticon) [after 3000 [list catch [list $tree heading $col -image ::xtreeview::arrowEmpty]]]
- $tree heading $col -command [namespace code [list _sorttree $tree $col [expr {1-$direction}]]] -image ::xtreeview::arrow($direction)
- $tree selection set $selection
- $tree focus $focus
- checkFocus $tree
- }
- }
- # installs in-place edit bindings, adjusts tree header columns width, assigns column names, installs sorting handlers
- proc _treeheaders {path {sort true} {treecolumnname {}} } {
- set tags [bindtags $path]
- if {[lsearch -exact $tags XTreeview]<0} {
- bindtags $path [linsert $tags [lsearch -exact $tags Treeview]+1 XTreeview]
- }
- set font [::ttk::style lookup [$path cget -style] -font]
- if {$font==""} {
- set font TkTextFont
- }
- foreach col [$path cget -columns] {
- if {$col!=""} {
- if {$sort} {
- $path heading $col -text $col -command [namespace code [list _sorttree $path $col 0]]
- } else {
- $path heading $col -text $col
- }
- $path column $col -width [font measure $font @@@@$col]
- }
- }
- if {$treecolumnname!=""} {
- $path heading #0 -text $treecolumnname
- $path column #0 -width [font measure $font @@@@$treecolumnname]
- if {$sort} {
- $path heading #0 -command [namespace code [list _sorttree $path #0 0]]
- }
- }
- }
- # helper functions for inplace edit
- proc _get_value {w column item} {
- if {$column=="#0"} {
- return [$w item $item -text]
- } else {
- return [$w set $item $column]
- }
- }
- proc _set_value {w column item value} {
- if {$column=="#0"} {
- $w item $item -text $value
- } else {
- $w set $item $column $value
- }
- }
- proc _update_value {w column item} {
- variable curfocus
- set value [_get_value $w $column $item]
- set newvalue $curfocus($w,$column)
- if {$value!=$newvalue} {
- _set_value $w $column $item $newvalue
- }
- }
- # these functions create widgets for in-place edit, use them in your in-place edit handler
- proc _inplaceEntry {w column item} {
- variable curfocus
- set wnd $w.$column
- ttk::entry $wnd -textvariable [namespace current]::curfocus($w,$column) -width 3
- set curfocus($w,$column) [_get_value $w $column $item]
- bind $wnd <Destroy> [namespace code [list _update_value $w $column $item]]
- }
- proc _inplaceEntryButton {w column item script} {
- variable curfocus
- set wnd $w.$column
- ttk::frame $wnd
- pack [ttk::entry $wnd.e -width 3 -textvariable [namespace current]::curfocus($w,$column)] -side left -fill x -expand true
- pack [ttk::button $wnd.b -style Toolbutton -text "..." -command [string map [list %v [namespace current]::curfocus($w,$column)] $script]] -side left -fill x
- set curfocus($w,$column) [_get_value $w $column $item]
- bind $wnd <Destroy> [namespace code [list _update_value $w $column $item]]
- }
- proc _inplaceCheckbutton {w column item {onvalue 1} {offvalue 0} } {
- variable curfocus
- set wnd $w.$column
- ttk::checkbutton $wnd -variable [namespace current]::curfocus($w,$column) -onvalue $onvalue -offvalue $offvalue
- set curfocus($w,$column) [_get_value $w $column $item]
- bind $wnd <Destroy> [namespace code [list _update_value $w $column $item]]
- }
- proc _inplaceList {w column item values} {
- variable curfocus
- set wnd $w.$column
- ttk::combobox $wnd -textvariable [namespace current]::curfocus($w,$column) -values $values -state readonly
- set curfocus($w,$column) [_get_value $w $column $item]
- bind $wnd <Destroy> [namespace code [list _update_value $w $column $item]]
- }
- proc _inplaceSpinbox {w column item min max step} {
- variable curfocus
- set wnd $w.$column
- spinbox $wnd -textvariable [namespace current]::curfocus($w,$column) -from $min -to $max -increment $step
- set curfocus($w,$column) [_get_value $w $column $item]
- bind $wnd <Destroy> [namespace code [list _update_value $w $column $item]]
- }
-}
-
-if { $argv0 eq [info script] } {
- catch {console show}
- pack [ttk::treeview .tv -columns {bool int list} -show {tree headings} -selectmode extended -yscrollcommand {.sb set}] -fill both -expand true -side left
- pack [ttk::scrollbar .sb -orient v -command {after idle ::xtreeview::updateWnds .tv;.tv yview}] -fill y -side left
- xtreeview::_treeheaders .tv true text
-
- .tv insert {} end -text {Sample text} -values {true 15 {Letter B}}
- set i0 [.tv insert {} end -text {Sample text} -values {false 25 {Letter C}}]
- .tv insert {} end -text {Sample text} -values {true 35 {Letter D}}
- .tv insert $i0 end -text {Sample subitem} -values {true 45 {Letter A}}
- for {set i 0} {$i<50} {incr i} {
- .tv insert $i0 end -text "Subitem $i" -values [list true $i {Letter B}]
- }
-
- bind .tv <<TreeviewInplaceEdit>> {
- if {[%W children [lindex %d 1]]==""} {
- switch [lindex %d 0] {
- {#0} { xtreeview::_inplaceEntry %W {*}%d }
- {bool} { xtreeview::_inplaceCheckbutton %W {*}%d true false}
- {int} { xtreeview::_inplaceSpinbox %W {*}%d 0 100 1 }
- {list} { xtreeview::_inplaceList %W {*}%d {"Letter A" "Letter B" "Letter C" "Letter D"} }
- }
- } elseif {[lindex %d 0]=="list"} {
- xtreeview::_inplaceEntryButton %W {*}%d {
- set %%v "tree: %W, column,item=%d"
- }
- }
- }
-}
\ No newline at end of file
=== removed file 'tools/datamart/scratch/loggerdialog.tcl'
--- tools/datamart/scratch/loggerdialog.tcl 2011-08-02 19:21:56 +0000
+++ tools/datamart/scratch/loggerdialog.tcl 1970-01-01 00:00:00 +0000
@@ -1,240 +0,0 @@
-#
-# $Id:$
-#
-# Requirements:
-# - Tcl/tk 8.5
-# - logger package
-# - inplace.tcl from http://wiki.tcl.tk/23475
-#
-# SYNOPSIS
-# logger::show pathname args
-#
-# DESCRIPTION
-# Show a dialog with a list of logger services and allow
-# to change the log level of each service
-#
-# SPECIFIC OPTIONS
-# -title
-# -parent
-##
-
-package require Tk 8.5
-package require Ttk
-
-lappend auto_path datamart.vfs/libext
-
-package require logger
-
-set dir [file dirname [info script]]
-source [file join $dir inplace.tcl]
-
-#
-#
-#
-##
-proc ::logger::show { w args } {
-
- array set defaults [list -parent "" -title "Logger Options"]
- array set options [array get defaults]
-
- foreach {option value} $args {
- if { $option ni [array names defaults] } {
- error "unknown option \"$option\""
- }
- }
- if { ([llength $args] % 2) != 0 } {
- error "value missing for \"[lindex $args [llength $args]]\""
- }
-
- array set options $args
-
- toplevel $w -class LoggerUI
- wm title $w $options(-title)
- wm iconname $w $options(-title)
- wm withdraw $w
-
- if { $options(-parent) ne "" } {
- wm transient $w $options(-parent)
- wm group $w $options(-parent)
- }
- set xf [ttk::frame $w.f]
-
- set headings [list Service Level]
- set columns [list text list]
- set f [ttk::frame $xf.f]
- set tv [ttk::treeview $f.tv -show headings \
- -columns $columns \
- ]
- set vsb [ttk::scrollbar $f.vsb -orient vertical \
- -command [list logger::UpdateTreeview $tv] \
- ]
-
- FillTreeview $tv
- xtreeview::_treeheaders $tv true $headings
- bind $tv <<TreeviewInplaceEdit>> [list logger::EditTreeviewItem %W %d]
- set col 1
- foreach h $headings {
- set column #$col
- $tv heading $column -text $h
- incr col
- }
-
- grid $tv -row 0 -column 0 -sticky news
- grid $vsb -row 0 -column 1 -sticky ns
- grid rowconfigure $f 0 -weight 1
- grid columnconfigure $f 0 -weight 1
-
- set bf [ttk::frame $xf.bf]
- set btnOk [ttk::button $bf.btnOk -text " Ok " \
- -command [list logger::OnButtonClick $w $tv ok] \
- ]
- set btnCancel [ttk::button $bf.btnCancel -text " Cancel " \
- -command [list logger::OnButtonClick $w $tv cancel] \
- ]
- bind $btnOk <Key-Return> [list logger::OnButtonClick $w $tv ok]
- bind $btnCancel <Key-Escape> [list logger::OnButtonClick $w $tv cancel]
-
- grid $btnCancel $btnOk -sticky news -padx 10 -pady 5
-
- grid $f -row 0 -column 0 -sticky news
- grid $bf -row 1 -column 0 -sticky ew
- grid rowconfigure $xf 0 -weight 1
- grid columnconfigure $xf 0 -weight 1
-
- pack $xf -expand 1 -fill both
-
- wm protocol $w WM_DELETE_WINDOW [list logger::OnButtonClick $w $tv cancel]
-
- Place $w $options(-parent)
-}
-
-#
-#
-#
-##
-proc logger::Place { w parent } {
-
- update idletasks
- if { $parent eq "" } {
- set parent "."
-
- set W [winfo screenwidth $parent]
- set H [winfo screenheight $parent]
- set X 0
- set Y 0
- } else {
- set W [winfo width $parent]
- set H [winfo height $parent]
- set X [winfo rootx $parent]
- set Y [winfo rooty $parent]
- }
- set xpos "+[ expr {$X+($W-[winfo reqwidth $w])/2}]"
- set ypos "+[ expr {$Y+($H-[winfo reqheight $w])/2}]"
-
- wm geometry $w "$xpos$ypos"
- wm deiconify $w
-}
-
-#
-#
-#
-##
-proc logger::FillTreeview { tv } {
-
- foreach svc [logger::services] {
- set svccmd [logger::servicecmd $svc]
-
- set lvl [${svccmd}::currentloglevel]
-
- $tv insert {} end -values [list $svc $lvl]
- }
-
-}
-
-#
-#
-#
-##
-proc logger::UpdateTreeview { tv args } {
- ::xtreeview::updateWnds $tv
- $tv yview
-}
-
-#
-#
-#
-##
-proc logger::EditTreeviewItem { tv data } {
-
- puts [info level 0]
- if {[$tv children [lindex $data 1]] eq ""} {
- switch [lindex $data 0] {
- {#0} {
- xtreeview::_inplaceEntry $tv {*}$data
- }
- {bool} {
- xtreeview::_inplaceCheckbutton $tv {*}$data true false
- }
- {int} {
- xtreeview::_inplaceSpinbox $tv {*}$data 0 100 1
- }
- {list} {
- set a [xtreeview::_inplaceList $tv {*}$data [logger::levels]]
- }
- }
- } elseif {[lindex $data 0] eq "list"} {
- puts "list"
- xtreeview::_inplaceEntryButton $tv {*}$data {
- #set %%v "tree: %W, column,item=%d"
- puts "list: tree: $tv, item '$data'"
- }
- }
-}
-
-#
-#
-#
-##
-proc logger::Close { w } {
- destroy $w
-}
-
-#
-#
-#
-##
-proc logger::OnButtonClick { w tv action } {
-
- if { $action eq "cancel" } {
- Close $w
- return
- }
-
- # update last changed item
- set item [$tv focus]
- xtreeview::_clear $tv $item
- xtreeview::_update_value $tv list $item
-
-
- # set new log levels foreach service
- foreach item [$tv children {}] {
- set values [$tv item $item -values]
- lassign $values svc lvl
-
- set svccmd [logger::servicecmd $svc]
- ${svccmd}::setlevel $lvl
- }
-
- Close $w
-}
-
-# Demo code
-if { $argv0 eq [info script] } {
-
- catch {console show}
- for { set i 0 } { $i < 5 } { incr i } {
- set log($i) [logger::init L$i]
- }
-
- logger::show .logUI
-}
\ No newline at end of file
=== removed file 'tools/datamart/scratch/scratch.tcl'
--- tools/datamart/scratch/scratch.tcl 2011-08-02 19:21:56 +0000
+++ tools/datamart/scratch/scratch.tcl 1970-01-01 00:00:00 +0000
@@ -1,37 +0,0 @@
-lappend auto_path datamart.vfs/libext
-lappend auto_path datamart.vfs/libdhis
-
-package require sqlite3
-
-try {
- sqlite3 db "db.sdb"
-} on error err {
- puts "error: $err"
-} finally {}
-
-try {
- db eval "
-create table names (name varchar(10),age int);
-insert into names values('Bob',48);
-insert into names values('Ken',50);
-" res {parray res}
- #puts "result: $res"
-} on error err {
- puts "error: $err"
-} finally {
- puts "changes: [db changes]"
-}
-
-proc callback {name age} {
- puts "name=$name; age=$age"
-}
-
-try {
- set result [db eval "select * from names"]
- puts "result: $result"
-} on error err {
- puts "error: $err"
-} finally {
- puts "changes: [db changes]"
-}
-
=== removed file 'tools/datamart/scratch/sqldisp.tcl'
--- tools/datamart/scratch/sqldisp.tcl 2011-08-02 19:21:56 +0000
+++ tools/datamart/scratch/sqldisp.tcl 1970-01-01 00:00:00 +0000
@@ -1,57 +0,0 @@
-lappend auto_path datamart.vfs/libext .
-
-package require treectrl
-package require sqlite3
-
-set offset 0
-
-set container [ttk::frame .c]
-set z1 [ttk::treeview .c.t1 -columns {0 1 2 3} -show headings -yscrollcommand {.c.y1 set}
-]
-$z1 tag configure 0 -background lightblue
-scrollbar .c.y1 -ori vert -command ".c.t1 yview"
-foreach col {0 1 2 3} name {OrgUnit Gender Period Value} {
- $z1 heading $col -text $name
- }
-
-
-set z2 [treectrl .c.t2 -yscrollcommand {.c.y2 set}]
-scrollbar .c.y2 -ori vert -command ".c.t2 yview"
-foreach name {OrgUnit Gender Period Value} {
- $z2 column create -text $name
- }
-
-
-set go [ttk::button .b -text "Next" -command {
- dbupdate $::offset
- incr ::offset 500
-}]
-
-
-sqlite3 db ../../dhislib/db/datamart.sdb
-
-pack $z1 -side left
-pack .c.y1 -side left -fill y
-pack $z2 -side left
-pack .c.y2 -side left -fill y
-
-pack .c
-pack $go
-
-
-set colour 0
-
-proc dbupdate {offset} {
- $::z1 delete [$::z1 children {}]
- db eval "select * from pivotsource_routinedata_ou3_all limit $offset,100" {
- set id [$::z1 insert {} 0 -values [list $orgunit3 $gender $period $value] -tag $::colour]
- set ::colour [expr ($::colour+1) % 2 ]
- }
-}
-
-proc dbupdate2 {offset} {
- #$::z2 delete [$::z2 children {}]
- db eval "select * from pivotsource_routinedata_ou3_all limit $offset,1000" {
- set item [$::z2 item create]
- }
-}
\ No newline at end of file
=== removed file 'tools/datamart/scratch/test.xlsx'
Binary files tools/datamart/scratch/test.xlsx 2011-08-02 19:21:56 +0000 and tools/datamart/scratch/test.xlsx 1970-01-01 00:00:00 +0000 differ
=== removed file 'tools/datamart/scratch/transform.tcl'
--- tools/datamart/scratch/transform.tcl 2011-08-02 19:21:56 +0000
+++ tools/datamart/scratch/transform.tcl 1970-01-01 00:00:00 +0000
@@ -1,96 +0,0 @@
-namespace eval transform {
-
- variable result
-
- # Wrapper around exec to xsltproc
- # @proc transform
- # @param stylesheet filename of xslt
- # @param userdata something which will available again in callbacks
- # @param data filename of doc to be transformed
- # @param datahandler callback (optional)
- # @param msghandler callback (optional)
- proc transform {stylesheet data {userdata ""} {datahandler transform::datah} {msghandler transform::msgh} } {
- try {
- # create two pipes - one for messages and one for data
- lassign [chan pipe] msgrd msgwr
- lassign [chan pipe] datard datawr
-
- puts "spawned xsltproc in background"
- exec -ignorestderr xsltproc $stylesheet $data 2>@$msgwr >@$datawr &
-
- } on ok res {
- #close write end of pipes in parent process
- close $msgwr
- close $datawr
-
- # connect handlers to stdin and stderr
- fconfigure $datard -buffering full -blocking 0
- fileevent $datard readable [list $datahandler $datard $userdata]
-
- fconfigure $msgrd -buffering full -blocking 0
- fileevent $msgrd readable [list $msghandler $msgrd $userdata]
- } on error err {
- close $msgwr
- close $datawr
- close $msgrd
- close $datard
- error $err
- } finally {}
- }
-
- # callbacks
-
- proc datah {datard userdata} {
- if [eof $datard] {
- close $datard
- finished $datard $userdata
- } else {
- puts "$userdata: [gets $datard]]"
- }
- }
-
- proc msgh {msgrd userdata} {
- if [eof $msgrd] {
- close $msgrd
- } else {
- puts stderr "$userdata msg: [gets $msgrd]"
- }
- }
-
- proc finished {datard userdata} {
- puts "$userdata transform done"
- }
-
- proc transform2db {dbfilename metafile } {
- try {
- # copy files into tmp directory
- set tmpdir [file normalize [file dirname $dbfilename]/tmp]
- file delete -force $tmpdir
- try {
- set mnt_file [vfs::zip::Mount $metafile metafile]
- if {![file exists metafile/Export.xml]} {
- error "Metadata file is missing Export.xml!"
- }
- file mkdir $tmpdir
- file copy metafile/Export.xml $tmpdir/Export.xml
- file copy $::xsltdir/dxf2sql.xsl $tmpdir/dxf2sql.xsl
- } on error err {
- error $err
- } finally {
- if {[file exists metafile]} {
- vfs::zip::Unmount $mnt_file metafile
- }
- }
-
- # run transform
- set ::dhis(status) "starting transform"
- transform::transform $tmpdir/Export.xml $tmpdir/dxf2sql.xsl \
- ::dhisdb::insertdata $db
- } on error err {
- return [list DB_ERR $err]
- } finally { }
-
- return DB_OK
- }
-}
-
=== removed file 'tools/datamart/scratch/view.tcl'
--- tools/datamart/scratch/view.tcl 2011-08-02 19:21:56 +0000
+++ tools/datamart/scratch/view.tcl 1970-01-01 00:00:00 +0000
@@ -1,77 +0,0 @@
-proc showviews {parent} {
- # remove current contents of parent
- foreach w [winfo children $parent] {
- destroy $w
- }
-
- set views [ttk::treeview $parent.views -columns viewname -show {}]
-
- db eval "select id,name from dataview" {
- $views insert {} end -id $id -values $name
- }
-
- ttk::labelframe $parent.view -text [mc "Detail"]
- $views column viewname -width 100
- grid $views -row 0 -column 0
- grid $parent.view -row 0 -column 1
-
- # bind to selecting an item in tree
- bind $views <<TreeviewSelect>> {
- set tree [focus]
- showview [winfo parent $tree].view [$tree selection]
- }
-}
-
-# widget for showing a view
-proc showview {parent view} {
- # remove current contents of parent
- foreach w [winfo children $parent] {
- destroy $w
- }
-
- # read into viewparams array
- db eval "select * from dataview where id='$view'" ::viewparams {}
- set dimensions [db eval "select dimension from dimensions_in_view where dataview='$view'"]
-
- parray ::viewparams
- puts $dimensions
-
- set paramframe [ttk::labelframe $parent.pf -text [mc "View parameters"]]
- grid [ttk::label $paramframe.lname -text [mc "Name "]] -row 0 -column 0 -sticky e
- grid [ttk::entry $paramframe.ename -textvariable ::viewparams(name) ] -row 0 -column 1 -sticky ew
- grid [ttk::label $paramframe.ldesc -text [mc "Description "]] -row 0 -column 2 -sticky e
- grid [ttk::entry $paramframe.edesc -textvariable ::viewparams(description) -width 50] -row 0 -column 3 -sticky ew
- grid [ttk::label $paramframe.ltype -text [mc "Type "]] -row 1 -column 0 -sticky e
- grid [ttk::combobox $paramframe.ctype -textvariable ::viewparams(datatype) -values [list [mc "Indicator"] [mc "DataElement"]] ] -row 1 -column 1
- grid [ttk::label $paramframe.lperiod -text [mc "Period type "]] -row 2 -column 0 -sticky e
- grid [ttk::combobox $paramframe.cperiod -textvariable ::viewparams(periodType) -values [list [mc "M"] [mc "Y"]] ] -row 2 -column 1
-
- pack $paramframe -fill x -padx 10 -pady 5
-
- set row 0
-
-
- db eval "select id as dimid, name as dimname from dimensiontype" {
- set dimframe [ttk::labelframe $parent.df$dimid -text $dimname]
-
- set col 0
- db eval "select dimension.*,dimensiontype.name as dimensiontype from dimension join dimensiontype where dimtype=$dimid AND dimension.dimtype=dimensiontype.id" {
- grid [ttk::label $dimframe.l$name -text $name ] -column $col -row $row -sticky e
- incr col
- grid [ttk::checkbutton $dimframe.$id ] -column $col -row $row -padx 5 -sticky e
- set col [expr [incr col]%8]
- if {$col==0} {incr row}
- if {[lsearch $dimensions $id]>-1} {
- puts "$id selected"
- $dimframe.$id state selected
- } else {
- puts "$id unselected"
- $dimframe.$id state
- }
- }
-
- pack $dimframe -fill x -padx 10 -pady 5
- }
- update
-
-}
\ No newline at end of file
