00001 # TKE - Advanced Programmer's Editor 00002 # Copyright (C) 2014-2019 Trevor Williams (phase1geo@gmail.com) 00003 # 00004 # This program is free software; you can redistribute it and/or modify 00005 # it under the terms of the GNU General Public License as published by 00006 # the Free Software Foundation; either version 2 of the License, or 00007 # (at your option) any later version. 00008 # 00009 # This program is distributed in the hope that it will be useful, 00010 # but WITHOUT ANY WARRANTY; without even the implied warranty of 00011 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00012 # GNU General Public License for more details. 00013 # 00014 # You should have received a copy of the GNU General Public License along 00015 # with this program; if not, write to the Free Software Foundation, Inc., 00016 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 00017 00018 ###################################################################### 00019 # Name: logger.tcl 00020 # Author: Trevor Williams (phase1geo@gmail.com) 00021 # Date: 5/18/2015 00022 # Version: $Revision$ 00023 # Brief: Contains namespace used for debug logging. 00024 ###################################################################### 00025 00026 namespace eval logger { 00027 00028 variable logdir "" 00029 variable logrc "" 00030 00031 ###################################################################### 00032 # Called at application start to initialize the debug logfile. 00033 proc initialize {} { 00034 00035 variable logdir 00036 variable logrc 00037 00038 # Get the logfile directory 00039 if {[set logdir [preferences::get Debug/LogDirectory]] eq ""} { 00040 set logdir [file join $::tke_home logs] 00041 } 00042 00043 # Get the native logfile name and create the directory if it does not already exist 00044 if {![file exists [set logdir [file normalize $logdir]]]} { 00045 file mkdir $logdir 00046 } 00047 00048 # Create the logfile 00049 create_logfile $logdir 00050 00051 # Keep an eye on the Debug/LogDirectory preference option 00052 trace variable preferences::prefs(Debug/LogDirectory) w logger::handle_logdir_change 00053 00054 } 00055 00056 ###################################################################### 00057 # Returns a string containing the header information. 00058 proc get_header {} { 00059 00060 set str "" 00061 append str "===================================================================================\n" 00062 append str "TKE Diagnostic Logfile\n" 00063 append str "===================================================================================\n" 00064 append str "Version: $::version_major.$::version_minor.$::version_point ($::version_hgid)\n" 00065 append str "Tcl/Tk Version: [info patchlevel]\n" 00066 append str "Platform: [array get ::tcl_platform]\n" 00067 append str "===================================================================================\n" 00068 append str "\n" 00069 00070 return $str 00071 00072 } 00073 00074 ###################################################################### 00075 # Creates and initializes the logfile 00076 proc create_logfile {dir} { 00077 00078 variable logdir 00079 variable logrc 00080 00081 set logdir $dir 00082 00083 if {![catch { open [file join $logdir debug.[pid].log] w } rc]} { 00084 00085 # Perform line buffering 00086 fconfigure $rc -buffering line 00087 00088 set logrc $rc 00089 00090 } 00091 00092 } 00093 00094 ###################################################################### 00095 # Handles any changes to the Debug/LogDirectory preference option. 00096 proc handle_logdir_change {name1 name2 op} { 00097 00098 variable logdir 00099 variable logrc 00100 00101 # Get the preference directory value 00102 if {[set pref_dir [preferences::get Debug/LogDirectory]] eq ""} { 00103 set pref_dir [file join $::tke_home logs] 00104 } 00105 00106 # Normalize the preference directory 00107 set pref_dir [file normalize $pref_dir] 00108 00109 # If the directory exists and it differs from the original, close, move and re-open the logfile 00110 if {$logdir ne $pref_dir} { 00111 00112 # Create the directory if it does not exist 00113 if {![file exists $pref_dir]} { 00114 file mkdir $pref_dir 00115 } 00116 00117 # If the logfile was previously opened, close it, move it and re-open for appendment 00118 if {$logrc ne ""} { 00119 00120 # Close the logfile 00121 close $logrc 00122 00123 # Move the logfile 00124 file rename -force [file join $logdir debug.[pid].log] $pref_dir 00125 00126 # Reopen the logfile 00127 if {![catch { open [file join $pref_dir debug.[pid].log] a } rc]} { 00128 fconfigure $rc -buffering line 00129 set logrc $rc 00130 } 00131 00132 # Set the logfile directory name to the preference name 00133 set logdir $pref_dir 00134 00135 # Otherwise, open the logfile in the new directory for writing 00136 } else { 00137 00138 # Create the logfile 00139 create_logfile $pref_dir 00140 00141 } 00142 00143 } 00144 00145 } 00146 00147 ###################################################################### 00148 # Outputs the given string to the logfile. Returns true if string was 00149 # logged without error; otherwise, returns false. 00150 proc log {str} { 00151 00152 variable logrc 00153 00154 if {$logrc ne ""} { 00155 puts $logrc "[clock format [clock seconds]]: $str" 00156 return 1 00157 } 00158 00159 return 0 00160 00161 } 00162 00163 ###################################################################### 00164 # Makes the debug log visible within tke. 00165 # 00166 # Arguments: 00167 # -lazy (0|1) If set to 1, loads the tab in the background. Default is 0. 00168 proc view_log {args} { 00169 00170 variable logdir 00171 variable logrc 00172 00173 array set opts { 00174 -lazy 0 00175 } 00176 array set opts $args 00177 00178 # Flush the output 00179 if {$logrc ne ""} { 00180 flush $logrc 00181 } 00182 00183 # Add the file to the editor 00184 gui::add_file end [file join $logdir debug.[pid].log] -readonly 1 -sidebar 0 -lazy $opts(-lazy) -remember 0 00185 00186 } 00187 00188 ###################################################################### 00189 # Returns a string containing a truncated version of the logfile. 00190 proc get_log {{lines 100}} { 00191 00192 variable logdir 00193 00194 if {![catch { open [file join $logdir debug.[pid].log] r } rc]} { 00195 00196 # Create the header 00197 set str [get_header] 00198 00199 # Add the last "lines" lines of the file to the string 00200 append str [join [lrange [split [read $rc] \n] end-$lines end] \n] 00201 00202 return $str 00203 00204 } 00205 00206 return "" 00207 00208 } 00209 00210 ###################################################################### 00211 # Closes the logfile on application exit. 00212 proc on_exit {} { 00213 00214 variable logdir 00215 variable logrc 00216 00217 if {$logrc ne ""} { 00218 00219 # Close the logfile 00220 close $logrc 00221 00222 # Get the log filename 00223 set logfile [file join $logdir debug.[pid].log] 00224 00225 # Delete the logfile if it's empty or if we are not doing TKE development 00226 if {([file size $logfile] == 0) || ![::tke_development]} { 00227 file delete -force [file join $logdir debug.[pid].log] 00228 } 00229 00230 } 00231 00232 } 00233 00234 } 00235 00236 ###################################################################### 00237 # Create the bgerror procedure to handle all background errors. 00238 proc bgerror {str} { 00239 00240 # Log the error 00241 if {[logger::log $str]} { 00242 if {$str ne ""} { 00243 puts stderr $::errorInfo 00244 } 00245 logger::log $::errorInfo 00246 } elseif {$str ne ""} { 00247 puts stderr $str 00248 puts stderr $::errorInfo 00249 } 00250 00251 }