Page MenuHomeDevCentral
Files F3716761

D1393.diff
No OneTemporary
Actions

D1393.diff
View Options

diff --git a/Daeghrefn/Bureautique.tcl b/Daeghrefn/Bureautique.tcl
--- a/Daeghrefn/Bureautique.tcl
+++ b/Daeghrefn/Bureautique.tcl
@@ -1,8 +1,8 @@
-bind dcc - antidater dcc:antidater
-bind dcc - postdater dcc:postdater
-bind dcc - days dcc:days
+bind dcc - antidater dcc:antidater
+bind dcc - postdater dcc:postdater
+bind dcc - days dcc:days
bind dcc - quux dcc:quux
-bind dcc - paypal dcc:paypal
+bind dcc - paypal dcc:paypal
#
# Dates calculation
@@ -10,175 +10,175 @@
#Removes $days from $date or if unspecified, current unixtime
proc antidater {days {date ""}} {
- postdater [expr $days * -1] $date
+ postdater [expr $days * -1] $date
}
#Adds $days from $date or if unspecified, current unixtime
proc postdater {days {date ""}} {
- if {$date == ""} {
- set date [unixtime]
- }
- incr date [expr 86400 * $days]
+ if {$date == ""} {
+ set date [unixtime]
+ }
+ incr date [expr 86400 * $days]
}
#.antidater 15
#.antidater 2011-01-29 4
proc dcc:antidater {handle idx arg} {
- set argc [llength $arg]
- if {$argc == 0} {
- putdcc $idx "De combien de jours dois-je antidater ?"
- return
- }
- if {$argc == 1} {
- set date ""
- set days $arg
- } {
- if [catch {set date [clock scan [lindex $arg 0]]} err] {
- putdcc $idx $err
- return
- }
- set days [lindex $arg 1]
- }
- if ![isnumber $days] {
- putdcc $idx "$days n'est pas un nombre de jours"
- return
- }
- putdcc $idx [clock format [antidater $days $date] -format "%Y-%m-%d"]
- return 1
+ set argc [llength $arg]
+ if {$argc == 0} {
+ putdcc $idx "De combien de jours dois-je antidater ?"
+ return
+ }
+ if {$argc == 1} {
+ set date ""
+ set days $arg
+ } {
+ if [catch {set date [clock scan [lindex $arg 0]]} err] {
+ putdcc $idx $err
+ return
+ }
+ set days [lindex $arg 1]
+ }
+ if ![isnumber $days] {
+ putdcc $idx "$days n'est pas un nombre de jours"
+ return
+ }
+ putdcc $idx [clock format [antidater $days $date] -format "%Y-%m-%d"]
+ return 1
}
#.postdater 15
#.postdater 2011-01-29 4
proc dcc:postdater {handle idx arg} {
- set argc [llength $arg]
- if {$argc == 0} {
- putdcc $idx "De combien de jours dois-je postdater ?"
- return
- }
- if {$argc == 1} {
- set date ""
- set days $arg
- } {
- if [catch {set date [clock scan [lindex $arg 0]]} err] {
- putdcc $idx $err
- return
- }
- set days [lindex $arg 1]
- }
- if ![isnumber $days] {
- putdcc $idx "$days n'est pas un nombre de jours"
- return
- }
- putdcc $idx [clock format [postdater $days $date] -format "%Y-%m-%d"]
- return 1
+ set argc [llength $arg]
+ if {$argc == 0} {
+ putdcc $idx "De combien de jours dois-je postdater ?"
+ return
+ }
+ if {$argc == 1} {
+ set date ""
+ set days $arg
+ } {
+ if [catch {set date [clock scan [lindex $arg 0]]} err] {
+ putdcc $idx $err
+ return
+ }
+ set days [lindex $arg 1]
+ }
+ if ![isnumber $days] {
+ putdcc $idx "$days n'est pas un nombre de jours"
+ return
+ }
+ putdcc $idx [clock format [postdater $days $date] -format "%Y-%m-%d"]
+ return 1
}
namespace eval ::quux:: {
- ## Adds a quux
- ##
- ## @param $userid The user id
- ## @param $category The quux category
- ## @param $content The quux content
- ## @param $tags The quux tags [optional]
- proc add {userid category content {tags ""}} {
- global username
- lappend tags client:$username
- sqladd quux "user_id quux_date quux_category quux_content quux_tags" [list $userid [unixtime] $category $content $tags]
- sqllastinsertid
- }
-
- ## Tags a quux
- ##
- ## @param $id The quux id
- ## @param $tags The tags to add
- proc tag {id tags} {
- if {![isnumber $id]} { error "bad id \"$id\": must be integer" }
- switch [sql "SELECT LENGTH(quux_tags) FROM quux WHERE quux_id = $id"] {
- "" { error "Not existing quux: $id" }
- 0 { set value '[sqlescape $tags]' }
- default { set value "CONCAT(quux_tags, ' ', '[sqlescape $tags]')" }
- }
- sql "UPDATE quux SET quux_tags = $value WHERE quux_id = $id"
- }
-
- ## Determines if the specified user is the quux's owner
- ##
- ## @param $id The quux id
- ## @param $userid The user id
- ## @return 1 if the quux exists and added by the specified user; otherwise, 0
- proc isauthor {id userid} {
- if {![isnumber $id]} { error "bad id \"$id\": must be integer" }
- if {![isnumber $userid]} { error "bad userid \"$userid\": must be integer" }
- sql "SELECT count(*) FROM quux WHERE quux_id = $id AND user_id = $userid"
- }
+ ## Adds a quux
+ ##
+ ## @param $userid The user id
+ ## @param $category The quux category
+ ## @param $content The quux content
+ ## @param $tags The quux tags [optional]
+ proc add {userid category content {tags ""}} {
+ global username
+ lappend tags client:$username
+ sqladd quux "user_id quux_date quux_category quux_content quux_tags" [list $userid [unixtime] $category $content $tags]
+ sqllastinsertid
+ }
+
+ ## Tags a quux
+ ##
+ ## @param $id The quux id
+ ## @param $tags The tags to add
+ proc tag {id tags} {
+ if {![isnumber $id]} { error "bad id \"$id\": must be integer" }
+ switch [sql "SELECT LENGTH(quux_tags) FROM quux WHERE quux_id = $id"] {
+ "" { error "Not existing quux: $id" }
+ 0 { set value '[sqlescape $tags]' }
+ default { set value "CONCAT(quux_tags, ' ', '[sqlescape $tags]')" }
+ }
+ sql "UPDATE quux SET quux_tags = $value WHERE quux_id = $id"
+ }
+
+ ## Determines if the specified user is the quux's owner
+ ##
+ ## @param $id The quux id
+ ## @param $userid The user id
+ ## @return 1 if the quux exists and added by the specified user; otherwise, 0
+ proc isauthor {id userid} {
+ if {![isnumber $id]} { error "bad id \"$id\": must be integer" }
+ if {![isnumber $userid]} { error "bad userid \"$userid\": must be integer" }
+ sql "SELECT count(*) FROM quux WHERE quux_id = $id AND user_id = $userid"
+ }
}
proc dcc:quux {handle idx arg} {
- #.quux
- if {[llength $arg] == 0} {
- #Prints categories
- putdcc $idx [sql "SELECT DISTINCT quux_category FROM quux WHERE user_id = [getuserid $idx] AND quux_deleted = 0"]
- return 1
- }
-
- #.quux <command>
- set command [lindex $arg 0]
- switch $command {
- "tag" {
- #.quux tag <quux id> <tag to add>
-
- set id [lindex $arg 1]
- set content [string range $arg [string length $id]+5 end]
-
- if {![isnumber $id]} {
- putdcc $idx "Not a number."
- } elseif {![quux::isauthor $id [getuserid $idx]]} {
- putdcc $idx "Not your quux."
- } {
- quux::tag $id $content
- putcmdlog "#$handle# quux tag ..."
- }
- return 0
- }
- }
-
- #.quux <category>
- if {[llength $arg] == 1} {
- global username
- set category $arg
- set i 0
- set dateformat [registry get date.formats.long]
- set sql "SELECT quux_id, quux_date, quux_category, quux_content, quux_tags FROM quux WHERE user_id = [getuserid $idx] AND quux_deleted = 0"
- if { $category != "*" } { append sql " AND quux_category = '[sqlescape $category]'" }
- append sql " ORDER BY quux_date DESC LIMIT 20"
- foreach row [sql $sql] {
- foreach "id date cat content tags" $row {}
- set text "[completestringright $id 3]. "
- if { $category == "*" } { append text "$cat - " }
- append text $content
-
- #Tags
- set tags [string trim [string map [list "client:$username" ""] $tags]]
- if {$tags != ""} {
- append text " \00314$tags\003"
- }
-
- putdcc $idx $text
- incr i
- }
- if {$i == 0} {
- putdcc $idx "$arg xuuQ."
- return 0
- }
- return 1
- }
-
- #.quux <category> <text to add>
- set category [lindex $arg 0]
- set content [string range $arg [string length $category]+1 end]
- putdcc $idx "Published under QX[quux::add [getuserid $idx] $category $content]"
- putcmdlog "#$handle# quux ..."
- return 0
+ #.quux
+ if {[llength $arg] == 0} {
+ #Prints categories
+ putdcc $idx [sql "SELECT DISTINCT quux_category FROM quux WHERE user_id = [getuserid $idx] AND quux_deleted = 0"]
+ return 1
+ }
+
+ #.quux <command>
+ set command [lindex $arg 0]
+ switch $command {
+ "tag" {
+ #.quux tag <quux id> <tag to add>
+
+ set id [lindex $arg 1]
+ set content [string range $arg [string length $id]+5 end]
+
+ if {![isnumber $id]} {
+ putdcc $idx "Not a number."
+ } elseif {![quux::isauthor $id [getuserid $idx]]} {
+ putdcc $idx "Not your quux."
+ } {
+ quux::tag $id $content
+ putcmdlog "#$handle# quux tag ..."
+ }
+ return 0
+ }
+ }
+
+ #.quux <category>
+ if {[llength $arg] == 1} {
+ global username
+ set category $arg
+ set i 0
+ set dateformat [registry get date.formats.long]
+ set sql "SELECT quux_id, quux_date, quux_category, quux_content, quux_tags FROM quux WHERE user_id = [getuserid $idx] AND quux_deleted = 0"
+ if { $category != "*" } { append sql " AND quux_category = '[sqlescape $category]'" }
+ append sql " ORDER BY quux_date DESC LIMIT 20"
+ foreach row [sql $sql] {
+ foreach "id date cat content tags" $row {}
+ set text "[completestringright $id 3]. "
+ if { $category == "*" } { append text "$cat - " }
+ append text $content
+
+ #Tags
+ set tags [string trim [string map [list "client:$username" ""] $tags]]
+ if {$tags != ""} {
+ append text " \00314$tags\003"
+ }
+
+ putdcc $idx $text
+ incr i
+ }
+ if {$i == 0} {
+ putdcc $idx "$arg xuuQ."
+ return 0
+ }
+ return 1
+ }
+
+ #.quux <category> <text to add>
+ set category [lindex $arg 0]
+ set content [string range $arg [string length $category]+1 end]
+ putdcc $idx "Published under QX[quux::add [getuserid $idx] $category $content]"
+ putcmdlog "#$handle# quux ..."
+ return 0
}
#
@@ -186,14 +186,14 @@
#
namespace eval ::paypal {
- # -rate% - 0.35 €
- # Default rate: 3.4% for EU
- proc gross2net {net {rate 3.4}} {
- format %0.2f [expr ($net - 0.35) / (100 + $rate) * 100]
- }
-
- # +rate% + 0.35 €
- proc net2gross {gross {rate 3.4}} {
- format %0.2f [expr $gross * (100 + $rate) / 100 + 0.35]
- }
-}
\ No newline at end of file
+ # -rate% - 0.35 €
+ # Default rate: 3.4% for EU
+ proc gross2net {net {rate 3.4}} {
+ format %0.2f [expr ($net - 0.35) / (100 + $rate) * 100]
+ }
+
+ # +rate% + 0.35 €
+ proc net2gross {gross {rate 3.4}} {
+ format %0.2f [expr $gross * (100 + $rate) / 100 + 0.35]
+ }
+}

File Metadata

Mime Type
text/plain
Expires
Wed, Nov 6, 19:48 (18 h, 7 m)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
2232216
Default Alt Text
D1393.diff (10 KB)

Event Timeline

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