loging.tcl

Linux下的MSN聊天程序源码

#
#	Logging procedures
#
################################################################################

# TODO Implement some sort of log file size limit or date limit (remove any log entries older than date)
# TODO Save to LOG (if logging disabled, allows to log certain conversations only)
# TODO "Clear all logs" button
# TODO Selective logging (only log or don't log certain users)
# TODO Compress log files with optimal algorithm for text files
# TODO Logging syntax options (timestamps, email or nics, etc)

namespace eval ::log {

	#///////////////////////////////////////////////////////////////////////////////
	# StartLog (email)
	# Opens the log file by email address, called from WriteLog
	# WriteLog has to check if fileid already exists before calling this proc
	
	proc StartLog { email } {


		# if we got no profile, set fileid to 0
		if { [LoginList exists 0 [::config::getKey login]] == 0 } {
			LogArray $email set 0
		} else {
			LogArray $email set [CheckLogDate $email]

			if { [::config::getKey lineflushlog] == 1 } {
				fconfigure [LogArray $email get] -buffering none -encoding utf-8 
			} else {
				fconfigure [LogArray $email get] -buffersize 1024 -encoding utf-8
			}
		}
	}


	#///////////////////////////////////////////////////////////////////////////////
	# CheckLogDate (email)
	# Opens the log file by email address, called from StartLog
	# Checks if the date the file was created is older than a month, and moves file if necessary
	#

	proc CheckLogDate {email} {
		global log_dir webcam_dir

		#status_log "Opening file\n"
		create_dir $log_dir

		if { ![file exists [file join $log_dir date]] } {
			status_log "Date file not found, creating\n\n"
			set fd [open "[file join ${log_dir} date]" w]
			close $fd
			return [open "[file join ${log_dir} ${email}.log]" a+]
		} 

		if { [::config::getKey logsbydate] == 0 } {
			return [open "[file join ${log_dir} ${email}.log]" a+]
		}



		file stat [file join  $log_dir date] datestat

		#status_log "stating file $log_dir/date = [array get datestat]\n"

		set months "0 January February March April May June July August September October November December"
		set month [clock format $datestat(mtime) -format "%m"]
		if { [string range $month 0 0] == "0" } {
			set month [string range $month 1 1]
		}
		set month [lindex $months $month]
		set year [clock format $datestat(mtime) -format "%Y"]

		set date "$month $year"
		
		set clockmonth [clock format [clock seconds] -format "%m"]
		if { [string range $clockmonth 0 0] == "0" } {
			set clockmonth [string range $clockmonth 1 1]
		}
		set clockmonth [lindex $months $clockmonth]
		set clockyear [clock format [clock seconds] -format "%Y"]
		
		set clock "$clockmonth $clockyear"
		

		#status_log "Found date : $date\n" red

		if {  $date != $clock } {
			status_log "Log was begun in a different month, moving logs\n" red
			
			set to $date
			set idx 0
			while {[file exists [file join ${log_dir} $to]] } {
				status_log "Directory already used.. .bug? anyways, we don't want to overwrite\n"
				set to "${date}.$idx"
				incr idx
			}
			
			set cam_to $date
			set idx 0
			while {[file exists [file join ${webcam_dir} $cam_to]] } {
				status_log "Directory already used.. .bug? anyways, we don't want to overwrite\n"
				set cam_to "${date}.$idx"
				incr idx
			}

			catch {file delete [file join ${log_dir} date]}
			
			create_dir [file join ${log_dir} $to]
			create_dir [file join ${webcam_dir} $cam_to]

			foreach file [glob -nocomplain -types f "${log_dir}/*.log"] {
				status_log "moving $file\n" blue
				if {[catch {file rename $file [file join ${log_dir} $to]} res]} {
					status_log "moving file error $res \n"
				}
			}
			
			foreach file [glob -nocomplain -types f "${webcam_dir}/*.cam"] {
				status_log "moving $file\n" blue
				if {[catch {file rename $file [file join ${webcam_dir} $cam_to]} res]} {
					status_log "moving file error $res \n"
				}
			}

			foreach file [glob -nocomplain -types f "${webcam_dir}/*.dat"] {
				status_log "moving $file\n" blue
				if {[catch {file rename $file [file join ${webcam_dir} $cam_to]} res]} {
					status_log "moving file error $res \n"
				}
			}
			
			
			set fd [open "[file join ${log_dir} date]" w]
			close $fd
			
			
			
		}
		
		return [open "[file join ${log_dir} ${email}.log]" a+]
		
	}


	#///////////////////////////////////////////////////////////////////////////////
	# LogArray (email action [sockid])
	# Controls information about array for chosen user
	# action can be :
	#	set : Sets new fileid for certain user
	#	get : Returns fileid for certain user, returns 0 if no fileid open
	#	unset : Unsets fileid for certain user.

	proc LogArray { email action {fileid 0}} {

		variable LogInfo

		switch $action {
			set {
				if { [info exists LogInfo($email)] } {
					status_log "DEBUG: Closing old Log fileid in set (this shouldn't happen)\n"
					StopLog $LogInfo($email)
					set LogInfo($email) $fileid
				} else {
					set LogInfo($email) $fileid
				}
			}

			unset {
				if { [info exists LogInfo($email)] } {
					unset LogInfo($email)
				} else {
					status_log "DEBUG: Calling unset on an unexisting variable\n"
				}
			}

			get {
				if { [info exists LogInfo($email)] } {
					return $LogInfo($email)
				} else {
					return 0
				}
			}
		}
	}

	#///////////////////////////////////////////////////////////////////////////////
	# ConfArray (email action [conf])
	# Controls information for array for chosen user for conference/conversation messages
	# action can be :
	#	newset : Sets new conf if doesn't exist already
	#	set : Sets new conf number for certain user only if never set before
	#	get : Returns conf number for certain user, returns 0 if no conf number set yet
	#	unset : Unsets conf number for certain user.

	proc ConfArray { email action {conf 0}} {

		variable ConfInfo

		switch $action {
			newset {
				if { [info exists ConfInfo($email)] == 0 } {
					set ConfInfo($email) $conf
				}
			}

			set {
				if { [info exists ConfInfo($email)] } {
					set ConfInfo($email) $conf
				}
			}

			unset {
				if { [info exists ConfInfo($email)] } {
					unset ConfInfo($email)
				} else {
					status_log "DEBUG: Calling unset on an unexisting variable\n"
				}
			}

			get {
				if { [info exists ConfInfo($email)] } {
					return $ConfInfo($email)
				} else {
					return 0
				}
			}
		}
	}


	
	#///////////////////////////////////////////////////////////////////////////////
	# StopLog (email (who))
	# Closes the log file for given user, called when closing chat window or when
	# user leaves conference
	# If user leaves conference and already has a chat window open, it'll close and
	# reopen file on next message send/receive
	# If who = 1 means user leaves conference
	# If who = 0 means YOU have closed window
	proc StopLog {email {who 0} } {

		status_log "DEBUG: Closing log file for $email\n"
		if { [LogArray $email get] != 0 } {
			if { $who == 1 } {
				puts -nonewline [LogArray $email get] "\|\"LRED\[[trans lclosedwin $email [clock format [clock seconds] -format "%d %b %Y %T"]]\]\n\n"
			} else {
				puts -nonewline [LogArray $email get] "\|\"LRED\[[trans luclosedwin [clock format [clock seconds] -format "%d %b %Y %T"]]\]\n\n"
			}
			close [LogArray $email get]
		}
		LogArray $email unset
		ConfArray $email unset
	}


	#///////////////////////////////////////////////////////////////////////////////
	# PutLog (chatid user msg)
	# Writes messages sent to PutMessage into the appropriate log files
	# Checks for conferences and fixes conflicts if we have 2 windows for same user (1 private 1 conference)
	# chatid : the chatid where the message was typed/sent
	# user : user who sent message
	# msg : msg

	proc PutLog { chatid user msg {fontformat ""}} {
		
		if {$fontformat == ""} {
			set color "NOR"
		} else {
			set color "C[lindex $fontformat 2]"
		}

		set user_list [::MSN::usersInChat $chatid]
		foreach user_info $user_list {
			set user_login [lindex $user_info 0]
			if { [llength $user_list] > 1 } {
				::log::WriteLog $user_login "\|\"LITA$user :\|\"L$color $msg\n" 1 $user_list
			} else {
				# for 2 windows (1 priv 1 conf)
				# if conf exists for current user & current chatid is not a conf
				if { [ConfArray $user_login get] == 1 && $chatid == $user_login} {
					::log::WriteLog $user_login "\|\"LITA\[[trans linprivate]\] $user :\|\"L$color $msg\n" 2 $user_list
				} else {
					::log::WriteLog $user_login "\|\"LITA$user :\|\"L$color $msg\n" 0 $user_list
				}
			}
		}
	}

	
	#///////////////////////////////////////////////////////////////////////////////
	# WriteLog (email txt (conf) (userlist))
	# Writes txt to logfile of user given by email
	# Checks if a fileid for current user already exists before writing
	# conf 1 is used for conference messages

	proc WriteLog { email txt {conf 0} {user_list ""}} {

		set fileid [LogArray $email get]

		ConfArray $email newset $conf
		set last_conf [ConfArray $email get]
		
		foreach user_info $user_list {
			if { [info exists users] } {
				set users "$users, [lindex $user_info 0]"
			} else {
				set users [lindex $user_info 0]
			}
		}	

		if { $fileid != 0 } {
			if { $last_conf != $conf && $conf != 2} {
				if { $conf == 1 } {
					puts -nonewline $fileid "\|\"LRED\[[trans lprivtoconf ${users}]\]\n"
					ConfArray $email set $conf
				} elseif { [llength $user_list] == 1 } {
					puts -nonewline $fileid "\|\"LRED\[[trans lconftopriv ${users}]\]\n"
					ConfArray $email set $conf
				}
			}
			puts -nonewline $fileid "\|\"LGRA[timestamp] $txt"
		} else {
			StartLog $email
			set fileid [LogArray $email get]
			if { $fileid != 0 } {
				if { $conf == 0 } {
					puts -nonewline $fileid "\|\"LRED\[[trans lconvstarted [clock format [clock seconds] -format "%d %b %Y %T"]]\]\n"
				} else {
					puts -nonewline $fileid "\|\"LRED\[[trans lenteredconf $email [clock format [clock seconds] -format "%d %b %Y %T"]] \(${users}\) \]\n"
				}
				puts -nonewline $fileid "\|\"LGRA[timestamp] $txt"
			}
		}
	}


	#///////////////////////////////////////////////////////////////////////////////
	# LeavesConf (usr_name user_list)
	# Handles loging for when a user leaves a conference
	# usr_name : email of person who has left

	proc LeavesConf { chatid usr_name } {

		set user_list [::MSN::usersInChat $chatid]
		# If was in conference before this user leaves
		if { [llength $user_list] >= 1 && $usr_name != [lindex [lindex $user_list 0] 0] } {
			foreach user_info $user_list {
				set fileid [LogArray [lindex $user_info 0] get]
				if { $fileid != 0 } {
					puts -nonewline $fileid "\|\"LRED\[[trans lleftconf $usr_name]\]\n"
				}
				if { [llength $user_list] == 1 } {
					ConfArray [lindex $user_info 0] set 3
				}
			}
			StopLog $usr_name 1
		}
	}	


	#///////////////////////////////////////////////////////////////////////////////
	# JoinsConf (usr_name user_list)
	# Handles loging for when a user joins a conference
	# usr_name : email of person who has joined

	proc JoinsConf { chatid usr_name } {

		set user_list [::MSN::usersInChat $chatid]
		# If there is already 1 user in chat
		if { [llength $user_list] > 1  } {
			foreach user_info $user_list {
				set login [lindex $user_info 0]
				set fileid [LogArray $login get]
				if { $login != $usr_name && $fileid != 0} {
					puts -nonewline $fileid "\|\"LRED\[[trans ljoinedconf $usr_name]\]\n"
				}
			}
		}
	}


	#///////////////////////////////////////////////////////////////////////////////
	# OpenLogWin (email)
	# Opens log window for user given by email, Called when History is chosen
	# Thinking of adding a button to chat window and History to right click in list
	#
	# I don't think I will refresh this window while user is chatting, since he has the
	# chat window open... So it will be static and contain what has been said before
	# history button was pressed

	proc OpenLogWin { {email ""} } {

		global log_dir langenc logvar

		#Get all the contacts
		foreach contact [::abook::getAllContacts] {
			#Selects the contacts who are in our list and adds them to the contact_list
			if {[string last "FL" [::abook::getContactData $contact lists]] != -1} {
				lappend contact_list $contact
			}
		}

		#Sorts contacts
		set sortedcontact_list [lsort -dictionary $contact_list]

		#Add the eventlog
		lappend sortedcontact_list eventlog

		#If there is no email defined, we remplace it by the first email in the dictionary order
		if {$email == ""} {
			set email [lindex $sortedcontact_list 0]
		}
		
		set fileid [LogArray $email get]
		if { $fileid != 0 && $fileid != "stdout"} {
			flush $fileid
		}
		unset fileid

		set wname [::log::wname $email]

		if { [catch {toplevel ${wname} -width 600 -height 400 -borderwidth 0 -highlightthickness 0 } res ] } {
			raise ${wname}
			focus ${wname}
			wm deiconify ${wname}
			return 0
		}

		wm group ${wname} .

		if { [file exists [file join ${log_dir} ${email}.log]] } {
			set size "[::amsn::sizeconvert [file size "[file join ${log_dir} ${email}.log]"]]o"
			wm title $wname "[trans history] (${email} - $size)"
		} else {
			wm title $wname "[trans history] (${email})"
		}

		wm geometry $wname 600x400

		frame $wname.top
		#No ugly blue frame on Mac OS X, system already put a border around windows
		if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
			frame $wname.blueframe
		} else {
			frame $wname.blueframe -background [::skin::getKey mainwindowbg]
		}
		frame $wname.blueframe.log -class Amsn -borderwidth 0
		frame $wname.buttons -class Amsn


		text $wname.blueframe.log.txt -yscrollcommand "$wname.blueframe.log.ys set" -font splainf \
		    -background white -relief flat -highlightthickness 0 -height 1 -exportselection 1 -selectborderwidth 1 \
		    -wrap word
		scrollbar $wname.blueframe.log.ys -command "$wname.blueframe.log.txt yview" -highlightthickness 0 \
		    -borderwidth 1 -elementborderwidth 2

		# Add search dialog
		searchdialog $wname.search -searchin $wname.blueframe.log.txt -title [trans find]