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

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Tue Dec 26 14:06:19 MSK 2006


Author: sergei
Date: 2006-12-26 14:06:16 +0300 (Tue, 26 Dec 2006)
New Revision: 841

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/plugins/chat/logger.tcl
Log:
	* plugins/chat/logger.tcl: Changed log directory structure and made
	  log file format more rliable. Since that the first Tkabber run
	  converts log files to new format. This conversion may take long
	  time, so it shows a dialog window with the conversion progress
	  during the conversion.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2006-12-25 17:33:55 UTC (rev 840)
+++ trunk/tkabber/ChangeLog	2006-12-26 11:06:16 UTC (rev 841)
@@ -1,3 +1,11 @@
+2006-12-26  Sergei Golovan  <sgolovan at nes.ru>
+
+	* plugins/chat/logger.tcl: Changed log directory structure and made
+	  log file format more rliable. Since that the first Tkabber run
+	  converts log files to new format. This conversion may take long
+	  time, so it shows a dialog window with the conversion progress
+	  during the conversion.
+
 2006-12-25  Sergei Golovan  <sgolovan at nes.ru>
 
 	* plugins/general/session.tcl: Renamed session to state (only in

Modified: trunk/tkabber/plugins/chat/logger.tcl
===================================================================
--- trunk/tkabber/plugins/chat/logger.tcl	2006-12-25 17:33:55 UTC (rev 840)
+++ trunk/tkabber/plugins/chat/logger.tcl	2006-12-26 11:06:16 UTC (rev 841)
@@ -6,20 +6,53 @@
     custom::defgroup Logging [::msgcat::mc "Logging options."] -group Chat
 
     custom::defvar options(logdir) [file join ~ .tkabber logs] \
-	    [::msgcat::mc "Directory to store logs."] \
+	[::msgcat::mc "Directory to store logs."] \
 	-type string -group Logging
 
     custom::defvar options(log_chat) 1 \
-	    [::msgcat::mc "Store private chats logs."] \
+	[::msgcat::mc "Store private chats logs."] \
 	-type boolean -group Logging
 
     custom::defvar options(log_groupchat) 1 \
-	    [::msgcat::mc "Store group chats logs."] \
+	[::msgcat::mc "Store group chats logs."] \
 	-type boolean -group Logging
 
+    variable version 1.0
+
     if {![file exists $options(logdir)]} {
 	file mkdir $options(logdir)
+    
+	# Storing version for possible future conversions
+	set fd [open [file join $options(logdir) version] w]
+	puts $fd $version
+	close $fd
     }
+
+    array set m2d [list [::msgcat::mc "January"]   01 \
+			[::msgcat::mc "February"]  02 \
+			[::msgcat::mc "March"]     03 \
+			[::msgcat::mc "April"]     04 \
+			[::msgcat::mc "May"]       05 \
+			[::msgcat::mc "June"]      06 \
+			[::msgcat::mc "July"]      07 \
+			[::msgcat::mc "August"]    08 \
+			[::msgcat::mc "September"] 09 \
+			[::msgcat::mc "October"]   10 \
+			[::msgcat::mc "November"]  11 \
+			[::msgcat::mc "December"]  12]
+
+    array set d2m [list 01 [::msgcat::mc "January"]   \
+			02 [::msgcat::mc "February"]  \
+			03 [::msgcat::mc "March"]     \
+			04 [::msgcat::mc "April"]     \
+			05 [::msgcat::mc "May"]       \
+			06 [::msgcat::mc "June"]      \
+			07 [::msgcat::mc "July"]      \
+			08 [::msgcat::mc "August"]    \
+			09 [::msgcat::mc "September"] \
+			10 [::msgcat::mc "October"]   \
+			11 [::msgcat::mc "November"]  \
+			12 [::msgcat::mc "December"]]
 }
 
 #############################################################################
@@ -62,6 +95,18 @@
 
 #############################################################################
 
+proc ::logger::str_to_log {str} {
+    return [string map {\\ \\\\ \r \\r \n \\n} $str]
+}
+
+#############################################################################
+
+proc ::logger::log_to_str {str} {
+    return [string map {\\\\ \\ \\r \r \\n \n} $str]
+}
+
+#############################################################################
+
 proc ::logger::jid_to_filename {jid} {
     set utf8_jid [encoding convertto utf-8 $jid]
     set len [string length $utf8_jid]
@@ -69,9 +114,9 @@
     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 |
+	switch -- $sym {
+	    34 - 37 - 39 - 42 - 43 - 47 - 58 - 59 - 60 - 62 - 63 - 92 - 124 {
+		# 34 " 37 % 39 ' 42 * 43 + 47 / 58 : 59 ; 60 < 62 > 63 ? 92 \ 124 |
 		append filename [format "%%%02X" $sym]
 	    }
 	    default {
@@ -112,129 +157,6 @@
 
 #############################################################################
 
-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
-
-    regsub -all {[:\\@/|*+?]} $jid _ filename 
-    return [file join ${options(logdir)} $filename]
-}
-
-#############################################################################
-
 proc ::logger::log_message {chatid from type body x} {
     variable options
 
@@ -248,7 +170,6 @@
 	set jid $nas
     }
 
-    set logfile [log_file $jid]
     set nick [chat::get_nick $connid $from $type]
 
     set seconds [clock seconds]
@@ -266,10 +187,12 @@
 	}
     }
     set ts [clock format $seconds -format "%Y%m%dT%H%M%S" -gmt 1]
+    set year [clock format $seconds -format %Y]
+    set month [clock format $seconds -format %m]
 
-    set fd [open $logfile a]
+    set fd [open [file join $options(logdir) $year $month [jid_to_filename $jid]] a]
     fconfigure $fd -encoding utf-8
-    puts $fd [list [list timestamp $ts jid $from nick $nick body $body]]
+    puts $fd [str_to_log [list timestamp $ts jid $from nick $nick body $body]]
     close $fd
 }
 
@@ -288,6 +211,7 @@
     global font
     global tcl_platform
     global defaultnick
+    variable d2m
 
     foreach {key val} $args {
 	switch -- $key {
@@ -303,109 +227,93 @@
 	set jid $nas
     }
 
-    set logfile [log_file $jid]
-    if {[file exists $logfile]} {
-	set lw [winid $jid]
-	debugmsg plugins "LOGGER: $lw"
-	if {[winfo exists $lw]} {
-	    focus -force $lw
-	    return
-	}
+    set logfile [jid_to_filename $jid]
 
-	set fd [open $logfile r]
-	fconfigure $fd -encoding utf-8
-	set hist [read $fd]
-	close $fd
+    set lw [winid $jid]
+    debugmsg plugins "LOGGER: $lw"
+    if {[winfo exists $lw]} {
+	focus -force $lw
+	return
+    }
 
-	set mynick [get_group_nick $jid ""]
+    set mynick [get_group_nick $jid ""]
 
+    toplevel $lw -relief $::tk_relief -borderwidth $::tk_borderwidth -class Chat
+    wm group $lw .
+    wm withdraw $lw
+    set title [format [::msgcat::mc "History for %s"] $jid]
+    wm title $lw $title
+    wm iconname $lw $title
 
-	toplevel $lw -relief $::tk_relief -borderwidth $::tk_borderwidth -class Chat
-	wm group $lw .
-	wm withdraw $lw
-	set title [format [::msgcat::mc "History for %s"] $jid]
-	wm title $lw $title
-	wm iconname $lw $title
+    set lf [ScrolledWindow $lw.sw]
+    set l [text $lf.log -font $font -wrap word -takefocus 0]
 
-	set lf [ScrolledWindow $lw.sw]
-	set l [text $lf.log -font $font -wrap word -takefocus 0]
+    set cf [frame $lw.controls]
 
-	set cf [frame $lw.controls]
+    set mf [frame $lw.mf]
+    pack $mf -side top -fill x -expand no -padx 1m -pady 1m
+    set mlabel [label $mf.mlabel -text [::msgcat::mc "Select month:"]]
+    pack $mlabel -side left
+    set ebutton [button $mf.ebutton -text [::msgcat::mc "Export to XHTML"] \
+				    -command [list [namespace current]::export \
+						   $l $lw.mf.mcombo $logfile $mynick]]
+    pack $ebutton -side right
+    pack $lf -padx 1m -pady 1m -fill both -expand yes
 
-	set mf [frame $lw.mf]
-	pack $mf -side top -fill x -expand no -padx 1m -pady 1m
-	set mlabel [label $mf.mlabel -text [::msgcat::mc "Select month:"]]
-	pack $mlabel -side left
-	set ebutton [button $mf.ebutton -text [::msgcat::mc "Export to XHTML"] \
-					-command [list [namespace current]::export \
-							$l $lw.mf.mcombo $logfile $mynick]]
-	pack $ebutton -side right
-	pack $lf -padx 1m -pady 1m -fill both -expand yes
+    $lf setwidget $l
 
-	$lf setwidget $l
+    regsub -all %W [bind Text <Prior>] $l prior_binding
+    regsub -all %W [bind Text <Next>] $l next_binding
+    bind $lw <Prior> $prior_binding
+    bind $lw <Next> $next_binding
 
-	regsub -all %W [bind Text <Prior>] $l prior_binding
-	regsub -all %W [bind Text <Next>] $l next_binding
-	bind $lw <Prior> $prior_binding
-	bind $lw <Next> $next_binding
+    $l tag configure they -foreground [option get $lw theyforeground Chat]
+    $l tag configure me -foreground [option get $lw meforeground Chat]
+    $l tag configure server_lab \
+       -foreground [option get $lw serverlabelforeground Chat]
+    $l tag configure server \
+       -foreground [option get $lw serverforeground Chat]
 
-	$l tag configure they -foreground [option get $lw theyforeground Chat]
-	$l tag configure me -foreground [option get $lw meforeground Chat]
-	$l tag configure server_lab \
-	    -foreground [option get $lw serverlabelforeground Chat]
-	$l tag configure server \
-	    -foreground [option get $lw serverforeground Chat]
+    set subdirs {}
+    foreach sd [lsort -decreasing [get_subdirs $logfile]] {
+	lassign [split $sd -] year month
+	lappend subdirs "$d2m($month) $year"
+    }
+    lappend subdirs [::msgcat::mc "All"]
 
+    set mcombo [ComboBox $mf.mcombo \
+			 -editable no \
+			 -exportselection no \
+			 -values $subdirs \
+			 -text [lindex $subdirs 0] \
+			 -modifycmd [list [namespace current]::change_month \
+					  $mf.mcombo $logfile $l $mynick]]
+    pack $mcombo -side left
 
-	if {![lempty $hist]} {
-	    set vars [lindex $hist 0]
-	    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]
-		set curym [clock format [clock seconds] -format %Y%m]
-		if {$ym < $curym} {
-		    set hist [filter_old_history $logfile $hist]
-		}
-	    }
-	}
+    change_month $mf.mcombo $logfile $l $mynick
 
-	set subdirs [concat [::msgcat::mc "Current"] \
-			    [lsort -decreasing [get_subdirs $logfile]] \
-			    [::msgcat::mc "All"]]
+    $lf.log see end
+    $lf.log configure -state disabled
 
-	set mcombo [ComboBox $mf.mcombo \
-			-editable no \
-			-exportselection no \
-			-values $subdirs \
-			-text [::msgcat::mc "Current"] \
-			-modifycmd [list [namespace current]::change_month \
-					$mf.mcombo $logfile $l $mynick]]
-	pack $mcombo -side left
+    hook::run open_log_post_hook $connid $jid $lw
 
-	draw_messages $l $hist $mynick
-
-	$lf.log see end
-	$lf.log configure -state disabled
-
-	hook::run open_log_post_hook $connid $jid $lw
-
-	wm deiconify $lw
-	
-    } else {
-	
-    }
+    wm deiconify $lw
 }
 
 #############################################################################
 
 proc ::logger::get_subdirs {logfile} {
+    variable options
+
     set subdirs {}
-    foreach subdir [glob -nocomplain -directory [file dirname $logfile] */] {
-	if {[file exists [file join $subdir [file tail $logfile]]]} {
-	    lappend subdirs [file tail $subdir]
+    foreach yeard [glob -nocomplain -type d -directory $options(logdir) *] {
+	foreach monthd [glob -nocomplain -type d -directory $yeard *] {
+	    if {[file exists [file join $monthd $logfile]]} {
+		lappend subdirs [file tail $yeard]-[file tail $monthd]
+	    }
 	}
     }
+
     return $subdirs
 }
 
@@ -425,7 +333,8 @@
 
     foreach vars $hist {
 	array unset tmp
-	array set tmp $vars
+	if {[catch {array set tmp $vars}]} continue
+
 	if {[info exists tmp(timestamp)]} {
 	    set seconds [clock scan $tmp(timestamp) -gmt 1]
 	    $l insert end [clock format $seconds -format {[%Y-%m-%d %X]}]
@@ -460,16 +369,18 @@
 #############################################################################
 
 proc ::logger::change_month {mcombo logfile l mynick} {
+    variable m2d
+
     set month [$mcombo cget -text]
-
     if {$month == [::msgcat::mc "All"]} {
 	draw_messages $l {} $mynick
 	foreach m [lsort -increasing [get_subdirs $logfile]] {
 	    add_messages $l [read_hist_from_file $logfile $m] $mynick
 	    update
 	}
-	add_messages $l [read_hist_from_file $logfile [::msgcat::mc "Current"]] $mynick
     } else {
+	set my_list [split $month " "]
+	set month [lindex $my_list end]-$m2d([join [lrange $my_list 0 end-1] " "])
 	draw_messages $l [read_hist_from_file $logfile $month] $mynick
     }
     $l see end
@@ -478,22 +389,19 @@
 #############################################################################
 
 proc ::logger::read_hist_from_file {logfile month} {
-    if {$month == [::msgcat::mc "Current"]} {
-	set filename $logfile
-    } else {
-	set filename [file join \
-			   [file dirname $logfile] \
-			   $month \
-			   [file tail $logfile]]
-    }
+    variable options
 
+    lassign [split $month -] year month1
+    set filename [file join $options(logdir) $year $month1 $logfile]
+
+    set hist {}
     if {[file exists $filename]} {
 	set fd [open $filename r]
 	fconfigure $fd -encoding utf-8
-	set hist [read $fd]
+	while {[gets $fd line] > 0} {
+	    lappend hist [log_to_str $line]
+	}
 	close $fd
-    } else {
-	set hist {}
     }
 
     return $hist
@@ -506,9 +414,8 @@
 	return {}
     }
 
-    set logfile [log_file $jid]
-    set months [linsert [lsort -decreasing [get_subdirs $logfile]] \
-			0 [::msgcat::mc "Current"]]
+    set logfile [jid_to_filename $jid]
+    set months [lsort -decreasing [get_subdirs $logfile]]
     set messages {}
     set curseconds [clock seconds]
     set max1 [expr {$max - 1}]
@@ -547,60 +454,18 @@
 
 #############################################################################
 
-proc ::logger::filter_old_history {logfile hist} {
-    set newhist {}
-    set curym [clock format [clock seconds] -format %Y-%m]
-    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]
-	    if {$ym < $curym} {
-		lappend oldhist($ym) $vars
-	    } else {
-		lappend newhist $vars
-	    }
-	}
-    }
+proc ::logger::export {lw mcombo logfile mynick} {
+    variable m2d
 
-    foreach ym [array names oldhist] {
-	set dir [file join [file dirname $logfile] $ym]
-	set oldlog [file join $dir [file tail $logfile]]
-	file mkdir $dir
-	
-	set fd [open $oldlog a]
-	fconfigure $fd -encoding utf-8
-	foreach vars $oldhist($ym) {
-	    puts $fd [list $vars]
-	}
-	close $fd
-	update
-    }
-
-    set fd [open $logfile w]
-    fconfigure $fd -encoding utf-8
-    foreach vars $newhist {
-	puts $fd [list $vars]
-    }
-    close $fd
-
-    return $newhist
-}
-
-#############################################################################
-
-proc ::logger::export {lw mcombo logfile mynick} {
     set month [$mcombo cget -text]
-
     if {$month == [::msgcat::mc "All"]} {
 	set hist {}
 	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"]]]
     } else {
+	set my_list [split $month " "]
+	set month [lindex $my_list end]-$m2d([join [lrange $my_list 0 end-1] " "])
 	set hist [read_hist_from_file $logfile $month]
     }
 
@@ -624,7 +489,8 @@
 
     foreach vars $hist {
 	array unset tmp
-	array set tmp $vars
+	if {[catch {array set tmp $vars}]} continue
+
 	set subtags {}
 	if {[info exists tmp(timestamp)]} {
 	    set seconds [clock scan $tmp(timestamp) -gmt 1]
@@ -706,3 +572,243 @@
 
 #############################################################################
 
+proc ::logger::convert_subdir_log {t logfrom logto jid dir} {
+    set fd [open $logfrom r]
+    fconfigure $fd -encoding utf-8
+    set hist [read $fd]
+    close $fd
+
+    set fd [open $logto a]
+    fconfigure $fd -encoding utf-8
+    if {[catch {
+	    foreach vars $hist {
+		puts $fd [str_to_log $vars]
+	    }
+	}]} {
+	$t configure -state normal
+	$t insert end [::msgcat::mc "File %s is corrupt.\
+				     History for %s (%s) is NOT converted\n" \
+				    $logfrom $jid $dir] error
+	$t configure -state disabled
+	$t see end
+    } else {
+	$t configure -state normal
+	$t insert end "($dir) $jid\n"
+	$t configure -state disabled
+	$t see end
+    }
+    close $fd
+    update
+}
+
+proc ::logger::convert_root_log {t 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
+
+    if {[catch {
+	    foreach vars $hist {
+		array unset tmp
+		if {[catch {array set tmp $vars}]} continue
+
+		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
+		}
+	    }
+	}]} {
+	$t configure -state normal
+	$t insert end [::msgcat::mc "File %s is corrupt.\
+				     History for %s is NOT converted\n" \
+				    $logfile $jid] error
+	$t configure -state disabled
+	$t see end
+	update
+	return
+    }
+
+    foreach ym [lsort [array names newhist]] {
+	$t configure -state normal
+	$t insert end "($ym) $jid\n"
+	$t configure -state disabled
+	$t see end
+	update
+	lassign [split $ym -] year month
+	set dir [file join $dirto $year $month]
+	set newlog [file join $dir [jid_to_filename $jid]]
+	file mkdir $dir
+
+	set fd [open $newlog a]
+	fconfigure $fd -encoding utf-8
+	catch {
+	    foreach vars $newhist($ym) {
+		puts $fd [str_to_log $vars]
+	    }
+	}
+	close $fd
+    }
+}
+
+proc ::logger::convert_logs {t dirfrom dirto} {
+    variable version
+
+    # 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
+    }
+
+    # 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
+	    convert_subdir_log $t $filepath [file join $fdir $filename] $jid $dir
+	}
+    }
+
+    # Process all files in log dir itself
+    foreach filepath [glob -nocomplain -type f -directory $dirfrom *] {
+	convert_root_log $t $dirfrom $dirto \
+			 [file tail $filepath] $JID([file tail $filepath])
+    }
+
+    # Storing version for possible future conversions
+    set fd [open [file join $dirto version] w]
+    puts $fd $version
+    close $fd
+}
+
+#############################################################################
+
+proc ::logger::convert_on_start {} {
+    variable version
+    variable options
+
+    set version_file [file join $options(logdir) version]
+    if {[file exists $version_file]} {
+	set fd [open $version_file r]
+	set v [string trim [read $fd]]
+	close $fd
+	if {$v >= $version} return
+    }
+
+    # Create temporary directory for converted logs
+    set dir "$options(logdir).new"
+    while {[file exists $dir]} {
+	set dir "$dir~"
+    }
+
+    set w .log_convert
+
+    Dialog $w -title [::msgcat::mc "Converting Log Files"] \
+	-separator 1 -anchor e -default 0 -cancel 0 -modal none
+
+    bind $w <Destroy> [list set convert_result 1]
+
+    $w add -text [::msgcat::mc "Close"] \
+	   -state disabled \
+	   -command [list destroy $w]
+
+    set f [$w getframe]
+
+    set msg [message $f.msg -aspect 50000 \
+		     -text [::msgcat::mc "Please, be patient while chats\
+					  history is being converted to new format"]]
+    pack $msg
+
+    set sw [ScrolledWindow $f.sw]
+    pack $sw -expand yes -fill both
+
+    set t [text $sw.t -state disabled -wrap word]
+    $t tag configure error -foreground [option get $t errorForeground Text]
+    $sw setwidget $t
+
+    $w draw
+    grab $w
+
+    convert_logs $t $options(logdir) $dir
+    
+    set bdir "$options(logdir)~"
+    while {[file exists $bdir]} {
+	set bdir "$dir~"
+    }
+    file rename -- $options(logdir) $bdir
+    file rename -- $dir $options(logdir)
+
+    if {[winfo exists $w]} {
+	$w itemconfigure 0 -state normal
+
+	$msg configure -text [::msgcat::mc "Chats history is converted.\nBackup\
+					    of the old history\
+					    is stored in %s" $bdir]
+
+	$t configure -state normal
+	$t insert end "[::msgcat::mc {Conversion is finished}]\n"
+	$t configure -state disabled
+	$t see end
+
+	vwait convert_result
+    }
+    catch {unset ::convert_result}
+}
+
+hook::add finload_hook ::logger::convert_on_start 1000
+
+#############################################################################
+



More information about the Tkabber-dev mailing list