Simple database: Difference between revisions

Content added Content deleted
m (Formatting)
(→‎Tcl: Added implementation)
Line 650:
{"fields":["event_title","start_time","stop_time","location","event_description"],"items":{"6dd02195-1efe-40d1-b43e-c2efd852cd1d":{"event_title":"Wife's Birthday","start_time":"2011-11-01","stop_time":"2011-11-01","location":"","event_description":"happy 39th"},"0190b835-401d-42da-9ed3-1d335d27b83c":{"event_title":"Parent-Teacher Conference","start_time":"2011-11-03 19:30","stop_time":"2011-11-03 20:00","location":"school","event_description":"desc"},"4023e6f1-bcc1-49e5-a59f-138157b413f4":{"event_title":"Buy gift for wife","start_time":"2011-10-31 16:00","stop_time":"2011-10-31 16:30","location":"the mall","event_description":"hmm, maybe jewelery?"}},"history":[[1320349951.000625,"6dd02195-1efe-40d1-b43e-c2efd852cd1d"],[1320350045.4736252,"0190b835-401d-42da-9ed3-1d335d27b83c"],[1320350102.9486248,"4023e6f1-bcc1-49e5-a59f-138157b413f4"]],"tags":{"birthday":["6dd02195-1efe-40d1-b43e-c2efd852cd1d"],"family":["6dd02195-1efe-40d1-b43e-c2efd852cd1d","0190b835-401d-42da-9ed3-1d335d27b83c","4023e6f1-bcc1-49e5-a59f-138157b413f4"],"school":["0190b835-401d-42da-9ed3-1d335d27b83c"],"last-minute":["4023e6f1-bcc1-49e5-a59f-138157b413f4"]}}
</pre>
 
=={{header|Tcl}}==
The format used is that of a Tcl dictionary, where each entry uses the title as a key and the remaining information (category, date and miscellaneous metadata) is the value associated with it. The only variation from the standard internal format is that entries are separated by newlines instead of spaces; this is still a legal value, but is a non-canonical.
<lang tcl>#!/usr/bin/env tclsh8.6
package require Tcl 8.6
namespace eval udb {
variable db {}
 
proc Load {filename} {
variable db
if {[catch {set f [open $filename]}]} {
set db {}
return
}
set db [read $f]
close $f
}
proc Store {filename} {
variable db
if {[catch {set f [open $filename w]}]} return
dict for {nm inf} $db {
puts $f [list $nm $inf]
}
close $f
}
 
proc add {title category {date "now"} args} {
variable db
if {$date eq "now"} {
set date [clock seconds]
} else {
set date [clock scan $date]
}
dict set db $title [list $category $date $args]
return
}
proc Rec {nm cat date xtra} {
dict create description $nm category $cat date [clock format $date] \
{*}$xtra _names [dict keys $xtra]
}
proc latest {{category ""}} {
variable db
if {$category eq ""} {
set d [lsort -stride 2 -index {1 1} -integer -decreasing $db]
dict for {nm inf} $d break
return [list [Rec $nm {*}$inf]]
}
set latestbycat {}
dict for {nm inf} [lsort -stride 2 -index {1 1} -integer $db] {
dict set latestbycat [lindex $inf 0] [list $nm {*}$inf]
}
return [list [Rec {*}[dict get $latestbycat $category]]]
}
proc latestpercategory {} {
variable db
set latestbycat {}
dict for {nm inf} [lsort -stride 2 -index {1 1} -integer $db] {
dict set latestbycat [lindex $inf 0] [list $nm {*}$inf]
}
set result {}
dict for {- inf} $latestbycat {
lappend result [Rec {*}$inf]
}
return $result
}
proc bydate {} {
variable db
set result {}
dict for {nm inf} [lsort -stride 2 -index {1 1} -integer $db] {
lappend result [Rec $nm {*}$inf]
}
return $result
}
 
namespace export add latest latestpercategory bydate
namespace ensemble create
}
 
if {$argc < 2} {
puts stderr "wrong # args: should be \"$argv0 db subcommand args...\""
exit 1
}
udb::Load [lindex $argv 0]
set separator ""
if {[catch {udb {*}[lrange $argv 1 end]} msg]} {
puts stderr $msg
exit 1
}
foreach row $msg {
puts -nonewline $separator
apply {row {
dict with row {
puts "Title: $description"
puts "Category: $category"
puts "Date: $date"
foreach v $_names {
puts "${v}: [dict get $row $v]"
}
}
}} $row
set separator [string repeat - 70]\n
}
 
udb::Store [lindex $argv 0]</lang>
 
=={{header|UNIX Shell}}==