- Home»
- Cod sursa: Date.tcl
Date.tcl
Date.tcl
Storing birthdays and events and checking in how many days it is. The script also sets a topic when it`s someones birthday. The script CAN use stats.mod for recognising people, but it should work well without it. Use !date --help for all the commands.
| Postat de | Copyright | Categorie | Review user | Vizualizari | Data |
|---|---|---|---|---|---|
| btc | Evo|ver | games | Cod netestat | 486 | 2023-12-25 00:25:25 |
#### Date.tcl by Evo|ver @ ircnet
#### Last update Feb 15 2001
####
#### Purpose of the script:
#### Storing birthdays and events and checking in how many days it is.
#### The script also sets a topic when it's someones birthday.i
#### The script CAN use stats.mod for recognising people, but it should
#### work well without it.
#### Use !date --help for all the commands.
####
#### Comments, suggestions, fanmail, marriage proposals: evolver@blue.penguin.nl
####
#### Thanks to HCl for testing.
#### Thanks to webmind for some advise about programming.
#### Thanks to #eggdrop @ircnet for... ehm.. the lame times between sleep.
#### Thanks to G`quann for coding stats.mod
#### Thanks to the people at #mainsource @irc.pulltheplug.com for letting me
#### debug the script with HCl.
####
#### Version 1.2 The year of an event wasn't handled correctly, it
#### took the current year. This caused a bug for events in
#### future years. ;-)
#### Version 1.1 Had some putlogs that I used for debugging.. forgot
#### to take them out...
#### With an event, the script now also shows the date...
#### people found that that was usefull....
#### Version 1.0 Releasing the script, tested it for a month, no
#### errors so I thought it could be released.
#### Only some changes in the comment.
#### Version 0.7 Finally found a strange bug.. BitchX adds a " " after
#### a nickcompletion (<tab>).
#### Version 0.6 I think it should be wise if I read the manual.
#### Made a stupid mistake with clock scan....
#### Version 0.5 It's know possible to set a time for
#### an event. Changes something in the filetype for it.
#### Fixed a bug, there was no check for the year. So you
#### could just enter no year and you didn't know nothing
#### happened. :-)
#### If someone's birthday is today, the script will say that
#### in stead of 52 week... when you do !date.
#### Version 0.4 I forgot something in the help.
#### Script now supports a # in the description of an event.
#### Script now says in the channel when it's someones
#### birthday and it can't set the topic.
#### Script now sets the topic back after one day.
#### Version 0.3.5 I didn't fix the timedate bug, now I did!
#### Version 0.3 Cleaned up a bit of my code.
#### Found and fixed a bug in timedate.
#### Fixed another bug in nick2suser
#### Version 0.2 Fixed a bug with 29 Febuary
#### Fixed a bug in my nick2suser replacement
#### Version 0.1 Initial script.
#### Coded from scratch since my own (non-released)
#### bday.tcl would work anymore with stats.mod1.3.x
####
#### Todo A warning msg a few days/weeks/months/etc before
#### a date. So you can send your birthday card on time ;-)
#### To be really nice, I should make !channel support,
#### but who uses those ;-)
#### There should be more features, if someone has an idea..
## put here the name of the file where the script stores the data
set datafile .datafile
set notefile .notefile
## the flag someone must have to be able to remove ALL data.
## NOTE: if someone has the same hostmask of the person who set the date
## he will be able to remove the date too, therefor someone IS able to change
## or remove his/her own birthday or an event he/she set, and someone with
## this flag can always do that.
set date_remove_flag n
## Don't change anything below, unless you know what you're doing.
## All guarentee will be lost when changing anything :-P
bind pub - !date pub_date
## proc to handle everything with one bind
proc pub_date {nick host hand chan arg} {
global botnick
if {[llength $arg] == 0} {
set reply [getdate [string tolower [nick2suser $nick $chan]]]
if {[lindex $reply 0] == "pub"} {
putserv "PRIVMSG $chan :[lrange $reply 1 end]"
} else {
putserv "PRIVMSG $nick :[lrange $reply 1 end]"
}
return 1
}
if {[lindex $arg 0] == "--help"} {
datehelp $nick
return 1
}
if {[llength $arg] == 1} {
set arg [string trimright $arg " "]
if {[nick2suser $arg $chan] != "\*"} {
set arg [nick2suser $arg $chan]
}
set reply [getdate [string tolower $arg]]
if {[lindex $reply 0] == "pub"} {
putserv "PRIVMSG $chan :[lrange $reply 1 end]"
} else {
putserv "PRIVMSG $nick :[lrange $reply 1 end]"
}
return 1
}
if {[llength $arg] == 2} {
if {[lindex $arg 0] == "remove"} {
putserv "PRIVMSG $nick :[deldate [string tolower [lindex $arg 1]] $nick $host]"
return 1
}
if {[lindex $arg 0] == "whoset"} {
set reply [whodate [lindex [string tolower $arg] 1]]
if {[lindex $reply 0] == "pub"} {
putserv "PRIVMSG $chan :[lrange $reply 1 end]"
} else {
putserv "PRIVMSG $nick :[lrange $reply 1 end]"
}
return 1
}
putserv "PRIVMSG $nick :[lindex $arg 0] not a known command. Try !date --help"
return 1
}
if {[llength $arg] == 3} {
if {[lindex $arg 0] == "-remember"} {
set targ [lindex $arg 1]
if {[nick2suser $targ $chan] != "\*"} {
set targ [nick2suser $arg $chan]
}
putserv "PRIVMSG $nick :[telldate $nick $host [string tolower $targ] [lindex $arg 2]]"
}
putserv "PRIVMSG $nick :[setdate [string tolower [nick2suser $nick $chan]] 00 00 [string toupper [lindex $arg 0]] [lindex $arg 1] [lindex $arg 2] b $nick $host $chan]"
return 1
}
set len [llength [lrange $arg 3 end]]
set numhash 0
foreach args [lrange $arg 3 end] {
if {[regexp (#) $args]} {
set numhash [expr $numhash + 1]
}
}
if {$numhash == $len} {
if {[lsearch [string tolower [lrange $arg 3 end]] $chan] == -1} {
set chans "[lrange $arg 3 end] $chan"
} else {
set chans [lrange $arg 3 end]
}
putserv "PRIVMSG $nick :[setdate [string tolower [nick2suser $nick $chan]] 00 00 [string toupper [lindex $arg 0]] [lindex $arg 1] [lindex $arg 2] b $nick $host $chans]"
return 1
}
if {[lindex $arg 4] == ""} {
putserv "PRIVMSG $nick :Please enter a desciption"
return 0
}
if {[regexp {:} [lindex $arg 4]]} {
regsub {:} [lindex $arg 4] { } time
putserv "PRIVMSG $nick :[setdate [string tolower [lindex $arg 0]] [lindex $time 1] [lindex $time 0] [string toupper [lindex $arg 1]] [lindex $arg 2] [lindex $arg 3] e $nick $host [lrange $arg 5 end]]"
return 1
}
putserv "PRIVMSG $nick :[setdate [string tolower [lindex $arg 0]] 00 00 [string toupper [lindex $arg 1]] [lindex $arg 2] [lindex $arg 3] e $nick $host [lrange $arg 4 end]]"
return 1
}
## proc which provides the help
proc datehelp {nick} {
global evdatever
putserv "NOTICE $nick :Help of Date.tcl version $evdatever"
putserv "NOTICE $nick :To input your birthday: !date <month> <day> <year> \[other chan\]"
putserv "NOTICE $nick :To input an event: !date <event> <month> <day> <year> [time] <description>"
putserv "NOTICE $nick :<month> like Jan, Feb, etc. The other chans that you can input are chans where I put your birthday in the topic."
putserv "NOTICE $nick :example 1: You're birthday is October 2 1981 and you want it in the topic of #foo and #bar (note: I must be ops in those chans to let me set the topic :-)). You say in #foo: !date Oct 2 1981 #bar"
putserv "NOTICE $nick :example 2: You're channelmeeting is Febuary 10 2001 at 19:30. You say: !date mychanmeeting Feb 10 2001 19:00 Meeting of #mychan (Note: the time is in an 24-hour clock. 3pm doesn't work, 15:00 does. The time isn't necessary, but might be handy :-))"
putserv "NOTICE $nick :To request a date: !date <birthday\\event>"
putserv "NOTICE $nick :To remove a date: !date remove <birthday\\event>"
putserv "NOTICE $nick :To see who set the date: !date whoset <birthday\\event>"
return 1
}
## proc for setting the date
proc setdate {name min hr mm dd yy type snick shost rest} {
global datafile
if {[file exists $datafile]} {
set datedata [open $datafile r]
while {![eof $datedata]} {
set curline [gets $datedata]
if {[lindex $curline 0] == $name} {
if {$type == "e"} {
return "Event already known by me. Remove it first to re-input it."
}
if {$type == "b"} {
return "Your birthday is already known by me. Remove it first to re-input it."
}
putlog "Somethings wrong... $name is not a birthday AND not an event."
}
}
close $datedata
}
regsub -all {[0-9]} $yy {1} myresult
if {$myresult != 1111} {
return "Wrong year. Please use a year like 2001, 1984, 1945, etc."
}
set nmm [lsearch "JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC" $mm]
if {$nmm == "-1"} {
return "Wrong month. Please input a month like: Jan, Feb, Mar, etc..."
}
if {[expr $yy % 4] == 0} {
set days "31 29 31 30 31 30 31 31 30 31 30 31"
} else {
set days "31 28 31 30 31 30 31 31 30 31 30 31"
}
if {[lindex $days $nmm] < $dd || $dd == 0} {
return "Wrong day. There is no $dd th day in $mm."
}
regsub -all {[0-9]} $min {1} myresult
if {$myresult != 11} {
return "Wrong kind of minutes.... a minute is a number between 00 and 60"
}
if {$min >= 60} {
return "Wrong kind of minutes.... a minute is a number between 00 and 60"
}
regsub -all {[0-9]} $hr {1} myresult
if {$myresult != 11} {
return "Wrong kind of hours.... an hour is a number between 00 and 24"
}
if {$hr >= 24} {
return "Wrong kind of hours.... an hour is a number between 00 and 24"
}
## writing the data to the file
set datedata [open $datafile a]
puts $datedata "$name $min $hr $mm $dd $yy $type $snick $shost $rest"
flush $datedata
close $datedata
if {$type == "b"} {
return "$name 's birthday is $mm $dd $yy"
}
if {$type == "e"} {
return "$name is $mm $dd $yy at $hr:$min, $rest"
}
## if you ever see such a line, you really have a problem :-)
return "Housten, we have a problem."
}
## proc for finding the date
proc getdate {target} {
global datafile
if {![file exists $datafile]} {
return "msg $target is not set \/ $target has no birthday set"
}
set rline ""
set datedata [open $datafile r]
while {![eof $datedata]} {
set curline [gets $datedata]
if {[lindex $curline 0] == $target} {
set rline $curline
}
}
close $datedata
if {$rline == ""} {
return "msg $target is not set \/ $target has no birthday set"
}
if {[lindex $rline 6] == "b"} {
set thisyear [lindex [ctime [unixtime]] 4]
} else {
set thisyear [lindex $rline 5]
}
## If someone is born on 29 Feb. you also need a check for that in this proc. Tcl doesn't like [clock scan "Feb 29 2001"] :-)
if {[lindex $rline 3] == "FEB" && [lindex $rline 4] == "29" && (![expr $thisyear %4] == 0) } {
set thisdate [clock scan "MAR 1 [lindex $rline 2]:[lindex $rline 1] $thisyear"]
} else {
set thisdate [clock scan "[lrange $rline 3 4] [lindex $rline 2]:[lindex $rline 1] $thisyear"]
}
if {[lindex $rline 6] == "b"} {
if {$thisdate < [unixtime]} {
if {[clock scan "[lindex $rline 3] [expr [lindex $rline 4] + 1] [lindex $rline 2]:[lindex $rline 1] $thisyear"] > [unixtime]} {
return "pub $target 's birthday is TODAY!!! $target is now [expr $thisyear - [lindex $rline 5]]"
} else {
set thisyear [expr $thisyear + 1]
if {[lindex $rline 3] == "FEB" && [lindex $rline 4] == "29" && (![expr $thisyear %4] == 0) } {
set thisdate [clock scan "MAR 1 [lindex $rline 2]:[lindex $rline 1] $thisyear"]
} else {
set thisdate [clock scan "[lrange $rline 3 4] [lindex $rline 2]:[lindex $rline 1] $thisyear"]
}
}
}
return "pub $target 's birthday in [duration [expr $thisdate - [unixtime]]]. $target will be [expr $thisyear - [lindex $rline 5]]"
} else {
if {$thisdate < [unixtime]} {
return "pub $target was [duration [expr [unixtime] - $thisdate]] ago. ([lrange $rline 3 4] [lindex $rline 2]:[lindex $rline 1]) [lrange $rline 9 end]."
} else {
return "pub $target is in [duration [expr $thisdate - [unixtime]]]. ([lrange $rline 3 4] [lindex $rline 2]:[lindex $rline 1]) [lrange $rline 9 end]."
}
}
## Next line is a quote from "Something's wrong" from K's Choice
return "msg Your pubic hair 's on fire!"
}
## proc for deleting date
proc deldate {target nick host} {
global datafile date_remove_flag
if {![file exists $datafile]} {
return "$target is not set \/ $target has no birthday set"
}
set dates ""
set datedata [open $datafile r]
while {![eof $datedata]} {
set curline [gets $datedata]
if {$curline != ""} {
set dates [linsert $dates end $curline]
}
}
close $datedata
set line "-1"
set checkthis ""
foreach date $dates {
set line [expr $line + 1]
if {[lindex $date 0] == $target} {
set checkthis $date
break
}
}
if {$checkthis == "" } {return "$target is not set \/ $target has no birthday set"}
if {[maskhost $host] == [maskhost [lindex $date 8]] || [matchattr [nick2hand $nick] $date_remove_flag]} {
if {[expr $line >= 0] && [expr $line < [llength $dates]]} {
set newdata [lreplace $dates $line $line]
set datedata [open $datafile w]
foreach newdate $newdata {
puts $datedata $newdate
}
flush $datedata
close $datedata
return "$target is deleted"
}
}
putlog "You are not allowed to remove that date."
}
## proc wich looks everyday for a birthday
bind time - "00 00 * * *" timedate
proc timedate {min hr day month year} {
global datafile evdtopics
if {![file exists $datafile]} {
return 0
}
set dates ""
set datedata [open $datafile r]
while {![eof $datedata]} {
set curline [gets $datedata]
if {$curline != ""} {
set dates [linsert $dates end $curline]
}
}
close $datedata
set bdays ""
foreach date $dates {
if {[lindex $date 6] == "b"} {
if {[string trimleft $day 0] == [string trimleft [lindex $date 4] 0]} {
set month [string trimleft $month 0]
if {$month == ""} {set month 0}
set mnth [lindex "JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC" $month]
if {$mnth == [string toupper [lindex $date 3]]} {
set bdays [linsert $bdays end $date]
}
}
}
}
if {$bdays == ""} {return 0}
set chans ""
foreach bday $bdays {
foreach chan [lrange $bday 9 end] {
lappend name($chan) "[lindex $bday 0],"
lappend age($chan) "[expr $year - [lindex $bday 5]],"
}
}
foreach chan [array names name] {
if {[llength $name($chan)] == 1} {
putserv "TOPIC $chan :[string trimright $name($chan) ,] 's birthday! [string trimright $name($chan) ,] is now [string trimright $age($chan) ,]"
return 1
}
if {(![regexp {t} [lindex [getchanmode $chan] 0]]) || [botisop $chan]} {
set evdtopics($chan-b) [topic $chan]
putserv "TOPIC $chan :Happy birthday: [string trimright $name($chan) ,]. They are now [string trimright $age($chan) ,]!"
set evdtopics($chan-a) "Happy birthday: [string trimright $name($chan) ,]. They are now [string trimright $age($chan) ,]!"
timer 1438 "evdresettopic $chan"
} else {
putserv "PRIVMSG $chan :\002Happy birthday: [string trimright $name($chan) ,]. They are now [string trimright $age($chan) ,]!\002"
}
}
}
proc evdresettopic {chan} {
global evdtopics
putlog "[topic $chan] == $evdtopics($chan-a)"
if {"[topic $chan]" == "$evdtopics($chan-a)"} {
putserv "TOPIC $chan :$evdtopics($chan-b)"
}
}
## proc which looksup who set the date
proc whodate {target} {
global datafile
if {![file exists $datafile]} {
return "msg $target is not set \/ $target has no birthday set"
}
set rline ""
set datedata [open $datafile r]
while {![eof $datedata]} {
set curline [gets $datedata]
if {[lindex $curline 0] == $target} {
set rline $curline
}
}
close $datedata
if {$rline == ""} {
return "msg $target is not set \/ $target has no birthday set"
}
return "pub $target was set by [lindex $rline 7]![lindex $rline 8]"
}
proc telldate {nick host target when} {
global datafile notefile
}
## proc which is called if you don't run stats.mod 1.3.*
## I use the tcl-command from stats.mod because it autoadds hostnames.
set modcheck "1"
foreach mod [modules] {
if {[lindex $mod 0] == "stats" && [lindex $mod 1] >= 1.3} {set modcheck "0"}
}
if {$modcheck} {
proc nick2suser {nick chan} {
if {[nick2hand $nick $chan] == "\*" || [nick2hand $nick $chan] == ""} {
return $nick
} else {
return [nick2hand $nick $chan]
}
}
}
set evdatever "1.2"
putlog "Date.tcl version $evdatever by Evo|ver loaded"
IRC Snippets