SVN: toys/stbr/stbr.tcl

shadzik shadzik at pld-linux.org
Wed Apr 29 20:55:26 CEST 2009


Author: shadzik
Date: Wed Apr 29 20:55:26 2009
New Revision: 10342

Modified:
   toys/stbr/stbr.tcl
Log:
- 0.8.1
- new CVS layout
- !stat command
- vips own request


Modified: toys/stbr/stbr.tcl
==============================================================================
--- toys/stbr/stbr.tcl	(original)
+++ toys/stbr/stbr.tcl	Wed Apr 29 20:55:26 2009
@@ -56,6 +56,13 @@
 	return [lindex $hands $whichone]
 }
 
+proc rthx {} {
+	set answer {"luz" "luzik" "nie ma sprawy" "spoko" "no problem" "n/p" "dla ciebie zawsze z mila checia"}
+	set range [llength $answer]
+	set whichone [expr {int(rand()*$range)}]
+	return [lindex $answer $whichone]
+}
+
 proc sendto {dist spec branch} {
 global cvsroot
 if {([string match ti $dist])} {
@@ -64,7 +71,10 @@
 	set reqbook "./scripts/requesters.txt"
 }
 if {([string match HEAD $branch])} {set cmd "-N"} {set cmd "-r$branch"}
-if {[catch {exec cvs -d $cvsroot log $cmd SPECS/$spec | awk {/author/{a = $5; sub(/;/, "", a); if (!seen[a]) print a; seen[a] = 1}}} results]} {return 0}
+set splited [split $spec "."]
+set pkg [lindex $splited 0]
+exec cvs -d $cvsroot get $cmd packages/$pkg/$spec &
+if {[catch {exec cvs -d $cvsroot log $cmd packages/$pkg/$spec | awk {/author/{a = $5; sub(/;/, "", a); if (!seen[a]) print a; seen[a] = 1}}} results]} {return 0}
 set file [open $reqbook r]
 gets $file lista
 close $file
@@ -76,6 +86,30 @@
 random $reqbook
 }
 
+proc pub:stat {nick host hand chan arg} {
+global cvsroot maintenance
+if {([file exists $maintenance]) && (![matchattr $hand n|m])} {
+	set plik [open $maintenance r]
+	gets $plik reason
+	close $plik
+	putcmdlog "Maintenance mode active"
+	putserv "privmsg $chan :$nick: I'm now in maintenance mode (reason: $reason). Only owners may perform real actions."
+	return 0
+	}
+if {[llength [lrange $arg 0 end]] < 2} {putserv "privmsg $chan :$nick: Usage: !stat spec branch";return 0}
+set spec [lindex $arg 0]
+set branch [lindex $arg 1]
+if {!([string match *.spec $spec])} { set pkg $spec;append spec ".spec" } else { set splited [split $spec "."]; set pkg [lindex $splited 0] }
+if {([string match HEAD $branch])} {set cmd "-N"} else {set cmd "-r$branch"}
+exec cvs -d $cvsroot get $cmd packages/$pkg/$spec &
+if {![file exists packages/$pkg/$spec]} {
+	putserv "privmsg $chan :$nick: There is no such spec ($spec) on branch $branch in PLD's repository."
+	return 0
+}
+	putserv "privmsg $chan :$nick: Spec ($spec) exists on branch $branch in PLD's repository."
+	return 0
+}
+
 proc banned_spec {spec} {
 global bannedspec
 set file [open $bannedspec r]
@@ -96,6 +130,7 @@
 bind pub * stbr: pub:stbr
 bind pub * stbr, pub:stbr
 bind pub * !del pub:del
+bind pub * !stat pub:stat
 
 proc pub:del {nick host hand chan arg} {
 global logfile cancellation
@@ -135,6 +170,9 @@
 set first [lindex $arg 0]
 if {([string match help $first])} {help $nick; return 0}
 if {([string match url $first])} {url $nick; return 0}
+if {([string match dzieki $first]) || ([string match dziekuje $first]) || ([string match thx $first]) || ([string match tx $first]) || ([string match thnx $first])} {
+	set answ [rthx]; putserv "privmsg $chan :$nick: $answ"; return 0
+}
 if {!([string match th $first] || [string match ti $first])} {
 	putserv "privmsg $chan :$nick: $usage"; return 0
 }
@@ -155,7 +193,7 @@
 if {([string match noupgrade $second])} {set second "test-build"}
 foreach spec $specs {
 if {([string match *:* $spec])} {set splited [split $spec ":"];set spec [lindex $splited 0]; set branch [lindex $splited 1]} {set branch "HEAD"}
-if {!([string match *.spec $spec])} { append spec ".spec"}
+if {!([string match *.spec $spec])} { set pkg $spec; append spec ".spec"} {set splited [split $spec "."]; set pkg [lindex $splited 0]}
 set towho [sendto $dist $spec $branch]
 if {($towho == 0)} {putserv "privmsg $chan :$nick: There is no such spec ($spec) on branch $branch in PLD's repository."; return 0}
 set isbanned [banned_spec $spec]
@@ -166,7 +204,7 @@
 	if {[utimer 5 "exec $makereq -d $dist -t $spec:$branch >/dev/null 2>&1"]==0} {putserv "privmsg $chan :$nick: An error occured. Couldn't send test-build request for $spec to builders."; return 1}
 	exec sqlite $logfile "INSERT INTO application VALUES('$date','$spec','$branch','stbr','$second','$dist');"
 } {
-	if {[exec $script $dist $nick $second $spec $branch $towho]==0} {putserv "privmsg $chan :$nick: An error occured. Couldn't send STBR Mail for $spec to $towho."; return 1}
+	if {[exec $script $dist $nick $second $pkg/$spec $branch $towho]==0} {putserv "privmsg $chan :$nick: An error occured. Couldn't send STBR Mail for $spec to $towho."; return 1}
 	exec sqlite $logfile "INSERT INTO application VALUES('$date','$spec','$branch','$towho','$second','$dist');"
 }
 }
@@ -183,4 +221,4 @@
 if {$cntr<1} {incr cntr} {utimer 30 "set cntr 0"; return 1}
 }
 
-putlog "Send To Builder Request TCL v0.8b by shadzik loaded."
+putlog "Send To Builder Request TCL v0.8.1 by shadzik loaded."


More information about the pld-cvs-commit mailing list