[Tkabber-dev] r840 - in trunk/tkabber: . plugins/chat plugins/general

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Mon Dec 25 20:33:59 MSK 2006


Author: sergei
Date: 2006-12-25 20:33:55 +0300 (Mon, 25 Dec 2006)
New Revision: 840

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/plugins/chat/logger.tcl
   trunk/tkabber/plugins/general/session.tcl
Log:
	* plugins/general/session.tcl: Renamed session to state (only in
	  user messages yet). Added menu for controlling save/load state
	  options.

	* plugins/chat/logger.tcl: Added new conversion scheme between JIDs
	  and log filenames. Added procedure, which converts old log directory
	  structure to a new one. New log directory structure is not used yet,
	  it's only for testing.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2006-12-24 21:40:56 UTC (rev 839)
+++ trunk/tkabber/ChangeLog	2006-12-25 17:33:55 UTC (rev 840)
@@ -1,3 +1,14 @@
+2006-12-25  Sergei Golovan  <sgolovan at nes.ru>
+
+	* plugins/general/session.tcl: Renamed session to state (only in
+	  user messages yet). Added menu for controlling save/load state
+	  options.
+
+	* plugins/chat/logger.tcl: Added new conversion scheme between JIDs
+	  and log filenames. Added procedure, which converts old log directory
+	  structure to a new one. New log directory structure is not used yet,
+	  it's only for testing.
+
 2006-12-24  Sergei Golovan  <sgolovan at nes.ru>
 
 	* ifacetk/idefault.tcl, ifacetk/iface.tcl: Use named font instead

Modified: trunk/tkabber/plugins/chat/logger.tcl
===================================================================
--- trunk/tkabber/plugins/chat/logger.tcl	2006-12-24 21:40:56 UTC (rev 839)
+++ trunk/tkabber/plugins/chat/logger.tcl	2006-12-25 17:33:55 UTC (rev 840)
@@ -1,5 +1,7 @@
 # $Id$
 
+#############################################################################
+
 namespace eval ::logger {
     custom::defgroup Logging [::msgcat::mc "Logging options."] -group Chat
 
@@ -20,6 +22,8 @@
     }
 }
 
+#############################################################################
+
 proc ::logger::add_menu_item {state category m connid jid} {
     switch -- $category {
 	roster {
@@ -37,15 +41,191 @@
            -command [list logger::show_log $jid -connection $connid]
 }
 
-hook::add chat_create_user_menu_hook [list ::logger::add_menu_item normal chat] 65
-hook::add chat_create_conference_menu_hook [list ::logger::add_menu_item normal group] 65
-hook::add roster_create_groupchat_user_menu_hook [list ::logger::add_menu_item normal grouproster] 65
-hook::add roster_conference_popup_menu_hook [list ::logger::add_menu_item normal roster] 65
-hook::add roster_service_popup_menu_hook [list ::logger::add_menu_item disabled roster] 65
-hook::add roster_jid_popup_menu_hook [list ::logger::add_menu_item normal roster] 65
-hook::add message_dialog_menu_hook [list ::logger::add_menu_item disabled message] 65
-hook::add search_popup_menu_hook [list ::logger::add_menu_item disabled search] 65
+#############################################################################
 
+hook::add chat_create_user_menu_hook \
+    [list ::logger::add_menu_item normal chat] 65
+hook::add chat_create_conference_menu_hook \
+    [list ::logger::add_menu_item normal group] 65
+hook::add roster_create_groupchat_user_menu_hook \
+    [list ::logger::add_menu_item normal grouproster] 65
+hook::add roster_conference_popup_menu_hook \
+    [list ::logger::add_menu_item normal roster] 65
+hook::add roster_service_popup_menu_hook \
+    [list ::logger::add_menu_item disabled roster] 65
+hook::add roster_jid_popup_menu_hook \
+    [list ::logger::add_menu_item normal roster] 65
+hook::add message_dialog_menu_hook \
+    [list ::logger::add_menu_item disabled message] 65
+hook::add search_popup_menu_hook \
+    [list ::logger::add_menu_item disabled search] 65
+
+#############################################################################
+
+proc ::logger::jid_to_filename {jid} {
+    set utf8_jid [encoding convertto utf-8 $jid]
+    set len [string length $utf8_jid]
+    set filename ""
+    for {set i 0} {$i < $len} {incr i} {
+	binary scan $utf8_jid @${i}c sym
+	set sym [expr {$sym & 0xFF}]
+	switch $sym {
+	    34 - 37 - 39 - 42 - 43 - 47 - 58 - 59 - 63 - 92 - 124 {
+		# 34 " 37 % 39 ' 42 * 43 + 47 / 58 : 59 ; 63 ? 92 \ 124 |
+		append filename [format "%%%02X" $sym]
+	    }
+	    default {
+		if {$sym >= 128 || $sym <= 32} {
+		    append filename [format "%%%02X" $sym]
+		} else {
+		    append filename [binary format c $sym]
+		}
+	    }
+	}
+    }
+    return $filename
+}
+
+#############################################################################
+
+proc ::logger::filename_to_jid {filename} {
+    set len [string length $filename]
+    set utf8_jid ""
+    for {set i 0} {$i < $len} {incr i} {
+	catch {
+	    binary scan $filename @${i}a sym
+	    switch $sym {
+		"%" {
+		    incr i
+		    binary scan $filename @${i}a2 num
+		    append utf8_jid [binary format c 0x$num]
+		    incr i
+		}
+		default {
+		    append utf8_jid $sym
+		}
+	    }
+	}
+    }
+    return [encoding convertfrom utf-8 $utf8_jid]
+}
+
+#############################################################################
+
+proc ::logger::convert_root_log {dirfrom dirto filename jid} {
+    set logfile [file join $dirfrom $filename]
+    set fd [open $logfile r]
+    fconfigure $fd -encoding utf-8
+    set hist [read $fd]
+    close $fd
+
+    foreach vars $hist {
+	array unset tmp
+	array set tmp $vars
+	if {[info exists tmp(timestamp)]} {
+	    set seconds [clock scan $tmp(timestamp) -gmt 1]
+	    set ym [clock format $seconds -format %Y-%m]
+	    lappend newhist($ym) $vars
+	}
+    }
+
+    foreach ym [array names newhist] {
+	regexp {^(\d+)-(\d+)} $ym -> year month
+	set dir [file join $dirto $year $month]
+	set newlog [file join $dir [jid_to_filename $jid]]
+	file mkdir $dir
+
+	puts $newlog
+	set fd [open $newlog a]
+	fconfigure $fd -encoding utf-8
+	foreach vars $newhist($ym) {
+	    puts $fd [list $vars]
+	}
+	close $fd
+	update
+    }
+}
+
+proc ::logger::convert_logs {dirfrom dirto} {
+    # Heuristically reconstruct JIDs
+    set fnlist {}
+    foreach subdir [glob -nocomplain -type d -directory $dirfrom *] {
+	set dir [file tail $subdir]
+	if {![regexp {^(\d\d\d\d)-(\d\d)$} $dir -> year month]} continue
+
+	foreach filepath [glob -nocomplain -type f -directory $subdir *] {
+	    lappend fnlist [file tail $filepath]
+	}
+    }
+    foreach filepath [glob -nocomplain -type f -directory $dirfrom *] {
+	lappend fnlist [file tail $filepath]
+    }
+    # Sort the list. It's important not only because it removes duplicates
+    set fnlist [lsort -unique $fnlist]
+
+    foreach fn $fnlist {
+	# Set prefix (for processing groupchats)
+	if {![info exists prefix] || ([string first $prefix $fn] != 0)} {
+	    set prefix $fn
+	}
+
+	# Simple case: no or one underscore in the filename
+	set idx [string first _ $fn]
+	if {($idx < 0) || ([string first _ $fn [expr {$idx + 1}]] < 0)} {
+	    set JID($fn) [string map {_ @} $fn]
+	    continue
+	}
+
+	# JID without a resource (very likely)
+	# Since underscore is not allowed in domain names, just replace
+	# the last one by @. It's the best guess we can do
+	if {$prefix == $fn} {
+	    set idx [string last _ $fn]
+	    set pr [string range $fn 0 [expr {$idx - 1}]]
+	    set sf [string range $fn [expr {$idx + 1}] end]
+	    set JID($fn) $pr@$sf
+	    continue
+	}
+
+	# JID with a resource is a private chat with someone in the
+	# conference room. Take room JID from the $prefix and add
+	# resource (don't replace _ in the resource)
+	set idx [expr {[string length $prefix] + 1}]
+	set sf [string range $fn $idx end]
+	set JID($fn) $JID($prefix)/$sf
+    }
+    puts [join [array get JID] "\n"]
+
+    # Create dir for new logs
+    if {![file exists $dirto]} {
+	file mkdir $dirto
+    }
+
+    # Process all subdirs YYYY-MM
+    foreach subdir [glob -nocomplain -type d -directory $dirfrom *] {
+	set dir [file tail $subdir]
+	if {![regexp {^(\d\d\d\d)-(\d\d)$} $dir -> year month]} continue
+
+	foreach filepath [glob -nocomplain -type f -directory $subdir *] {
+	    set jid $JID([file tail $filepath])
+	    set filename [jid_to_filename $jid]
+	    set fdir [file join $dirto $year $month]
+	    file mkdir $fdir
+	    puts "$filepath [file join $fdir $filename]"
+	    file copy -force -- $filepath [file join $fdir $filename]
+	}
+    }
+
+    # Process all files in log dir itself
+    foreach filepath [glob -nocomplain -type f -directory $dirfrom *] {
+	puts $filepath
+	convert_root_log $dirfrom $dirto \
+			 [file tail $filepath] $JID([file tail $filepath])
+    }
+}
+
+#############################################################################
+
 proc ::logger::log_file {jid} {
     variable options
 
@@ -53,6 +233,8 @@
     return [file join ${options(logdir)} $filename]
 }
 
+#############################################################################
+
 proc ::logger::log_message {chatid from type body x} {
     variable options
 
@@ -93,12 +275,15 @@
 
 hook::add draw_message_hook ::logger::log_message 15
 
+#############################################################################
 
 proc ::logger::winid {name} {
     set allowed_name [jid_to_tag $name]
     return .log_$allowed_name
 }
 
+#############################################################################
+
 proc ::logger::show_log {jid args} {
     global font
     global tcl_platform
@@ -212,6 +397,8 @@
     }
 }
 
+#############################################################################
+
 proc ::logger::get_subdirs {logfile} {
     set subdirs {}
     foreach subdir [glob -nocomplain -directory [file dirname $logfile] */] {
@@ -222,6 +409,8 @@
     return $subdirs
 }
 
+#############################################################################
+
 proc ::logger::draw_messages {l hist mynick} {
     $l configure -state normal
     $l delete 0.0 end
@@ -229,6 +418,8 @@
     add_messages $l $hist $mynick
 }
 
+#############################################################################
+
 proc ::logger::add_messages {l hist mynick} {
     $l configure -state normal
 
@@ -266,6 +457,7 @@
     $l configure -state disabled
 }
 
+#############################################################################
 
 proc ::logger::change_month {mcombo logfile l mynick} {
     set month [$mcombo cget -text]
@@ -283,6 +475,8 @@
     $l see end
 }
 
+#############################################################################
+
 proc ::logger::read_hist_from_file {logfile month} {
     if {$month == [::msgcat::mc "Current"]} {
 	set filename $logfile
@@ -305,6 +499,8 @@
     return $hist
 }
 
+#############################################################################
+
 proc ::logger::get_last_messages {jid max interval} {
     if {$max == 0 || $interval == 0} {
 	return {}
@@ -349,6 +545,8 @@
     return $messages
 }
 
+#############################################################################
+
 proc ::logger::filter_old_history {logfile hist} {
     set newhist {}
     set curym [clock format [clock seconds] -format %Y-%m]
@@ -390,6 +588,8 @@
     return $newhist
 }
 
+#############################################################################
+
 proc ::logger::export {lw mcombo logfile mynick} {
     set month [$mcombo cget -text]
 
@@ -398,7 +598,8 @@
 	foreach m [lsort -increasing [get_subdirs $logfile]] {
 	    set hist [concat $hist [read_hist_from_file $logfile $m]]
 	}
-	set hist [concat $hist [read_hist_from_file $logfile [::msgcat::mc "Current"]]]
+	set hist [concat $hist [read_hist_from_file $logfile \
+						    [::msgcat::mc "Current"]]]
     } else {
 	set hist [read_hist_from_file $logfile $month]
     }
@@ -476,6 +677,8 @@
     write_css $lw [file join [file dirname $filename] tkabber-logs.css]
 }
 
+#############################################################################
+
 proc ::logger::write_css {lw filename} {
     set fd [open $filename w]
 
@@ -501,4 +704,5 @@
     close $fd
 }
 
+#############################################################################
 

Modified: trunk/tkabber/plugins/general/session.tcl
===================================================================
--- trunk/tkabber/plugins/general/session.tcl	2006-12-24 21:40:56 UTC (rev 839)
+++ trunk/tkabber/plugins/general/session.tcl	2006-12-25 17:33:55 UTC (rev 840)
@@ -8,14 +8,14 @@
 namespace eval session {
     variable session_file [file join ~ .tkabber session.tcl]
 
-    custom::defgroup Sessions [::msgcat::mc "Tkabber session options."] \
+    custom::defgroup State [::msgcat::mc "Tkabber save state options."] \
 	-group Tkabber
     custom::defvar options(save_on_exit) 0 \
-	[::msgcat::mc "Save session on Tkabber exit."] \
-	-type boolean -group Sessions
+	[::msgcat::mc "Save state on Tkabber exit."] \
+	-type boolean -group State
     custom::defvar options(open_on_start) 0 \
-	[::msgcat::mc "Open session on Tkabber start."] \
-	-type boolean -group Sessions
+	[::msgcat::mc "Load state on Tkabber start."] \
+	-type boolean -group State
 }
 
 #############################################################################
@@ -23,10 +23,9 @@
 proc session::save_session {} {
     variable session_file
 
+    set session {}
     hook::run save_session_hook session
 
-    if {![info exists session]} return
-
     set fd [open $session_file w]
     fconfigure $fd -encoding utf-8
     puts $fd $session
@@ -89,3 +88,27 @@
 
 #############################################################################
 
+proc session::setup_menu {} {
+    if {![cequal $::interface tk] && ![cequal $::interface ck]} return
+
+    catch {
+	set m [.mainframe getmenu tkabber]
+	set ind [expr {[$m index [::msgcat::mc "Chats"]] + 1}]
+
+	set mm .session_menu
+	menu $mm -tearoff $::ifacetk::options(show_tearoffs)
+	$mm add command -label [::msgcat::mc "Save state"] \
+	    -command [namespace current]::save_session
+	$mm add checkbutton -label [::msgcat::mc "Save state on exit"] \
+	    -variable [namespace current]::options(save_on_exit)
+	$mm add checkbutton -label [::msgcat::mc "Load state on start"] \
+	    -variable [namespace current]::options(open_on_start)
+
+	$m insert $ind cascade -label [::msgcat::mc "State"] -menu $mm
+    }
+}
+
+hook::add finload_hook [namespace current]::session::setup_menu 60
+
+#############################################################################
+



More information about the Tkabber-dev mailing list