Page MenuHomeDevCentral
Files F4640667

D1394.id3556.diff
No OneTemporary
Actions

D1394.id3556.diff
View Options

diff --git a/Daeghrefn/Bureautique.tcl b/Daeghrefn/Bureautique.tcl
--- a/Daeghrefn/Bureautique.tcl
+++ b/Daeghrefn/Bureautique.tcl
@@ -3,6 +3,7 @@
bind dcc - days dcc:days
bind dcc - quux dcc:quux
bind dcc - paypal dcc:paypal
+bind dcc - +db dcc:db
#
# Dates calculation
@@ -197,3 +198,184 @@
format %0.2f [expr $gross * (100 + $rate) / 100 + 0.35]
}
}
+
+#
+# Database
+#
+
+namespace eval ::datacube {
+ proc get_table {cube} {
+ set table [dict get $cube db]
+ append table .
+ append table [dict get $cube table]
+ }
+
+ proc insert_data_into_cube {cube} {
+ set fields [dict get $cube fields]
+ set values [dict get $cube values]
+
+ if {[llength $fields] != [llength $values]} {
+ error "Datacube: count mismatch between fields and values"
+ }
+
+ sqladd [get_table $cube] $fields $values
+ }
+
+ proc is_cube_title_exists {title} {
+ set title [sqlescape $title]
+ sqlscalar "SELECT count(*) FROM db_datacubes WHERE title = '$title'"
+ }
+
+ proc get_cube {title} {
+ set cube [get_cube_properties $title]
+ dict set cube fields_current -1
+ }
+
+ proc get_cube_properties {title} {
+ sqlscalar "SELECT properties FROM db_datacubes WHERE title = 'lyrics'"
+ }
+
+ proc get_current_field_type {cube} {
+ get_current_field_info $cube type
+ }
+
+ proc get_current_field_prompt {cube} {
+ get_current_field_info $cube prompt
+ }
+
+ proc get_current_field_info {cube info} {
+ set fields_info [dict get $cube fields_${info}s]
+ set current_position [dict get $cube fields_current]
+
+ if {$current_position >= [llength $fields_info]} {
+ error "Datacube: out of range position"
+ }
+
+ lindex $fields_info $current_position
+ }
+
+ proc is_cube_in_last_position {cube} {
+ set len_types [llength [dict get $cube fields_types]]
+ set current_position [dict get $cube fields_current]
+
+ if {$current_position >= $len_types} {
+ error "Datacube: out of range position"
+ }
+
+ expr $current_position == $len_types - 1
+ }
+
+ proc fill_buffer {cube_variable_name text} {
+ upvar 1 $cube_variable_name cube
+
+ if {[dict exists $cube buffer]} {
+ dict append cube buffer \n
+ }
+ dict append cube buffer $text
+ }
+
+ # Returns 1 if the current field is full and we can go forward
+ # 0 if the buffer has been used (multiline mode)
+ proc fill_cube_data {cube_variable_name text} {
+ upvar 1 $cube_variable_name cube
+
+ set type [get_current_field_type $cube]
+
+ if {$type == "multiline"} {
+ fill_buffer cube $text
+ } elseif {$type == "line"} {
+ dict lappend cube values $text
+ return 1
+ } else {
+ error "Unknown type for datacube value: $type"
+ }
+
+ return 0
+ }
+
+ proc fill_cube_data_from_buffer {cube_variable_name} {
+ upvar 1 $cube_variable_name cube
+
+ dict lappend cube values [dict get $cube buffer]
+ dict unset cube buffer
+ }
+
+ # Controls database new entry process
+ # Returns 0 when we need to keep control, 1 when we're done
+ proc control_handle {idx text} {
+ global db
+
+ if {$text == "+"} {
+ fill_cube_data_from_buffer db($idx)
+ if {[is_cube_in_last_position $db($idx)]} {
+ control_save_cube $idx
+ return 1
+ } {
+ control_forward_cube $idx
+ }
+ } elseif {$text == "-"} {
+ control_abort $idx
+ return 1
+ } else {
+ # Fill datacube
+ control_append $idx $text
+ }
+
+ return 0
+ }
+
+ proc control_append {idx text} {
+ global db
+
+ set done [fill_cube_data db($idx) $text]
+ if {$done} {
+ control_forward_cube $idx
+ }
+ }
+
+ proc control_abort {idx} {
+ global db
+
+ unset db($idx)
+ putdcc $idx "Ok, le cube est laissé intact, retour sur la party line."
+ }
+
+ proc control_forward_cube {idx} {
+ global db
+
+ dict incr db($idx) fields_current
+
+ putdcc $idx \002[get_current_field_prompt $db($idx)]\002
+
+ set type [get_current_field_type $db($idx)]
+ if {$type == "multiline"} {
+ putdcc $idx "Pour valider, entre une ligne ne contenant que ceci: \002+\002"
+ }
+ }
+
+ proc control_save_cube {idx} {
+ global db
+
+ insert_data_into_cube $db($idx)
+ unset db($idx)
+ putdcc $idx "Ajouté dans le cube :-)"
+ }
+
+ proc control_launch {idx title} {
+ global db
+ set db($idx) [get_cube $title]
+
+ control_forward_cube $idx
+ control $idx control_handle
+ }
+}
+
+proc dcc:db {handle idx arg} {
+ if {![datacube::is_cube_title_exists $arg]} {
+ putdcc $idx "Unknown datacube: $arg"
+ return 0
+ }
+
+ datacube::control_launch $idx $arg
+ return 1
+}

File Metadata

Mime Type
text/plain
Expires
Sat, Feb 22, 13:20 (4 h, 51 m)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
2432381
Default Alt Text
D1394.id3556.diff (5 KB)

Event Timeline

Nasqueron DevCentral · If it had been much bigger the moon would have had a core of ice. · Powered by Phabricator