File indexing completed on 2025-04-20 05:09:41
0001 ## add_trace.pl 0002 ## Script to add a kDebug() call as the first line of each method 0003 ## including as many parameters as possible (i.e. those supported by kDebug) 0004 ## Very useful for tracing. 0005 ## 0006 ## Usage: perl -i add_trace.pl myfile.cpp 0007 ## 0008 ## Generates all statement with kDebug(0) so that it is very easy 0009 ## to remove them afterwards : 0010 ## perl -pi -e 'if (/kDebug\(0\)/) { $_ = ""; }' myfile.cpp 0011 ## 0012 ## Copyright 2000, 2002 David Faure <faure@kde.org> 0013 ## Copyright 2005-2006, 2008 Thorsten Staerk <kde@staerk.de> 0014 ## Copyright 2006 Laurent Montel <montel@kde.org> 0015 ## 0016 ## Redistribution and use in source and binary forms, with or without 0017 ## modification, are permitted provided that the following conditions 0018 ## are met: 0019 ## 0020 ## 1. Redistributions of source code must retain the above copyright 0021 ## notice, this list of conditions and the following disclaimer. 0022 ## 2. Redistributions in binary form must reproduce the above copyright 0023 ## notice, this list of conditions and the following disclaimer in the 0024 ## documentation and/or other materials provided with the distribution. 0025 ## 0026 ## THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR 0027 ## IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 0028 ## OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 0029 ## IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 0030 ## INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 0031 ## NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 0032 ## DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 0033 ## THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 0034 ## (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 0035 ## THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 0036 0037 if (scalar (@ARGV) == 0) 0038 { 0039 print "This program puts in debugging output into a program. At the beginning of every function, there is "; 0040 print "a line inserted saying which function starts at the moment."; 0041 exit(0); 0042 } 0043 0044 my $line=""; 0045 $insignature=0; 0046 while (<>) 0047 { 0048 if ( $insignature ) 0049 { 0050 $statement .= $_; 0051 chop; 0052 $oneline .= $_; 0053 } 0054 elsif ( /^\/\/.*/) 0055 { 0056 # comment 0057 # do nothing 0058 $insignature = 0; 0059 } 0060 # [^\s]+ means, one ore more characters that are no spaces 0061 elsif ( /^[^\s]+\s*[^\s]+::[^\s]+.*\}/ && !/typedef\s/ && !/^\s*class\s/ ) 0062 { 0063 # declaration and implementation in one line 0064 # do nothing 0065 $insignature = 0; 0066 } 0067 elsif ( /^[^\s]+\s*[^\s]+::[^\s]+/ && !/typedef\s/ && !/^\s*class\s/ ) 0068 { 0069 $insignature = 1; 0070 $statement = $_; 0071 chop; 0072 $oneline = $_; 0073 } 0074 0075 if ( $insignature ) 0076 { 0077 if ( /\{/ ) # End of signature 0078 { 0079 $insignature = 0; 0080 $_ = $oneline; 0081 #print STDERR "Signature : $_\n"; 0082 print $statement; 0083 $line = "kDebug(0)"; 0084 if ( m/([^\*\s]+::[^\s]+)\(/ ) 0085 { 0086 $line = $line . " << \"Entering function\""; 0087 } 0088 ## Ok now extract args 0089 s/^.*\([\s]*//; # Remove everything before first '(' 0090 s/\s*\)\s*:\s+.*$/,/; # Remove any ") : blah", replace with a ',' 0091 s/\s*\).*\{\s*$/,/; # Remove anything after ')', replace with a ',' 0092 s/ const / /g; # Replace every "const" by a space 0093 #print STDERR "Args list : $_\n"; 0094 @args = split( ",", $_ ); 0095 foreach (@args) 0096 { 0097 s/^\s*//; 0098 s/\s*$//; 0099 #print STDERR "Argument: $_\n"; 0100 ## Pointer ? 0101 if ( m/[a-zA-Z0-9_\s]+\*\s*([a-zA-Z0-9_]+)/ ) { 0102 $line = $line . " << \" $1=\" << " . $1; 0103 } 0104 ## int, long ? 0105 elsif ( m/^int\s+([a-zA-Z0-9_]+)/ || m/^long\s*([a-zA-Z0-9_]+)/ ) { 0106 $line = $line . " << \" $1=\" << " . $1; 0107 } 0108 ## bool 0109 elsif ( m/^bool\s+([a-zA-Z0-9_]+)/ ) { 0110 $line = $line . " << \" $1=\" << (" . $1 . " ? \"true\" : \"false\" )"; 0111 } 0112 ## QString and friends 0113 elsif ( m/QString[\&\s]+([a-zA-Z0-9_]+)/ || m/QCString[\&\s]*([a-zA-Z0-9_]+)/ ) { 0114 $line = $line . " << \" $1=\" << " . $1; 0115 } 0116 ## KUrl 0117 elsif ( m/KUrl[\&\s]+([a-zA-Z0-9_]+)/ ) { 0118 $line = $line . " << \" $1=\" << " . $1 . ".url()"; 0119 } 0120 } 0121 $line = $line . " << endl;\n"; 0122 #print STDERR "Debug call added : $line\n"; 0123 } 0124 } 0125 else 0126 { 0127 $readline=$_; 0128 if ( $line ) # there is something to insert 0129 { 0130 if (/( *).*/) { $line=$1.$line; } # indent 0131 if ($readline eq $line) 0132 { 0133 $line=""; 0134 } 0135 else 0136 { 0137 print $line; 0138 $line=""; 0139 } 0140 } 0141 # Normal line 0142 print $readline; 0143 } 0144 } 0145 if ( $insignature ) 0146 { 0147 print STDERR "Warning, unterminated method signature !! Check the file !\n"; 0148 print $statement; 0149 }