| 1 | #!/usr/bin/perl |
|---|
| 2 | # |
|---|
| 3 | # checks files for TABs and raises error if TABs found |
|---|
| 4 | # (TABs are evil, cause they have no default width) |
|---|
| 5 | # |
|---|
| 6 | # As well checks for older ARB compile logs and removes them |
|---|
| 7 | |
|---|
| 8 | |
|---|
| 9 | use strict; |
|---|
| 10 | use warnings; |
|---|
| 11 | |
|---|
| 12 | my $forceAll = 0; # 1 -> force scan of all files if no stamp, 0 -> assume all ok, scan only new files |
|---|
| 13 | my $defsStart = 15; # lineno of start of definition |
|---|
| 14 | |
|---|
| 15 | my $checkForOldLogs = 1; # whether to check for old logfile and delete them |
|---|
| 16 | |
|---|
| 17 | my %scan_extension = map { $_ => 1; } ( |
|---|
| 18 | 'c', 'h', |
|---|
| 19 | 'cxx', 'hxx', |
|---|
| 20 | 'cpp', 'hpp', |
|---|
| 21 | 'f', 'inc', |
|---|
| 22 | 'm4', 'status', 'in', |
|---|
| 23 | 'txt', 'doc', 'README', 'readme', |
|---|
| 24 | 'sh', |
|---|
| 25 | 'pl', 'pm', 'PL', 'cgi', |
|---|
| 26 | 'java', |
|---|
| 27 | 'head', 'header', 'default', 'footer', |
|---|
| 28 | 'makefile', |
|---|
| 29 | 'template', |
|---|
| 30 | 'dat', |
|---|
| 31 | 'dtd', 'xsl', |
|---|
| 32 | 'eft', 'ift', 'ift2', 'amc', |
|---|
| 33 | 'sellst', |
|---|
| 34 | 'mask', |
|---|
| 35 | 'aisc', 'pa', |
|---|
| 36 | 'source', 'menu', |
|---|
| 37 | 'mat', 'conf', |
|---|
| 38 | ); |
|---|
| 39 | |
|---|
| 40 | my %auto_determine = map { $_ => 1; } ( |
|---|
| 41 | 'x', 'jar', |
|---|
| 42 | ); |
|---|
| 43 | |
|---|
| 44 | my %ignore_extension = map { $_ => 1; } ( |
|---|
| 45 | 'a', 'o', 'so', |
|---|
| 46 | 'class', |
|---|
| 47 | 'html', 'bitmap', 'ps', 'icon', 'hlp', 'help', |
|---|
| 48 | 'gif', 'png', 'fig', 'vfont', 'SAVE', |
|---|
| 49 | 'tgz', 'gz', |
|---|
| 50 | 'lst', 'depends', |
|---|
| 51 | 'md5', 'bs', 'xs', |
|---|
| 52 | 'exists', 'ignore', '3pm', |
|---|
| 53 | 'arb', 'seq', 'genmenu', |
|---|
| 54 | 'init', 'cvsignore', 'log', 'am', 'org', |
|---|
| 55 | 'last_gcc', 'last_compiler', 'csv', |
|---|
| 56 | 'b', 'n', 'helpfiles', |
|---|
| 57 | 'ms', 'gon', 'pep', 'bla', 'tct', 'comm', |
|---|
| 58 | 'before', 'v1', 'data', 'pdb', 'embl', 'xpm', 'big', |
|---|
| 59 | '2_manual_postscript', '2_manual_text', |
|---|
| 60 | 'stamp', |
|---|
| 61 | ); |
|---|
| 62 | |
|---|
| 63 | my %ignored_subdirs = map { $_ => 1; } ( |
|---|
| 64 | 'GDE', |
|---|
| 65 | 'READSEQ', |
|---|
| 66 | 'HEADERLIBS', |
|---|
| 67 | 'patches', |
|---|
| 68 | 'UNIT_TESTER/flags', |
|---|
| 69 | 'UNIT_TESTER/logs', |
|---|
| 70 | 'UNIT_TESTER/run', |
|---|
| 71 | 'UNIT_TESTER/sok', |
|---|
| 72 | 'UNIT_TESTER/tests', |
|---|
| 73 | 'UNIT_TESTER/valgrind', |
|---|
| 74 | 'bin', |
|---|
| 75 | ); |
|---|
| 76 | |
|---|
| 77 | my %ignored_relpath = map { $_ => 1; } ( |
|---|
| 78 | 'NAMES_COM/names_client.h', |
|---|
| 79 | 'NAMES_COM/names_server.h', |
|---|
| 80 | 'PROBE_COM/PT_com.h', |
|---|
| 81 | 'PROBE_COM/PT_server.h', |
|---|
| 82 | ); |
|---|
| 83 | |
|---|
| 84 | my $tab_count = 0; |
|---|
| 85 | my $files_newer_than = 0; |
|---|
| 86 | |
|---|
| 87 | sub getModtime($) { |
|---|
| 88 | my ($file) = @_; |
|---|
| 89 | my @st = stat($file); |
|---|
| 90 | if (not @st) { die "can't stat '$file' ($!)"; } |
|---|
| 91 | return $st[9]; |
|---|
| 92 | } |
|---|
| 93 | |
|---|
| 94 | |
|---|
| 95 | sub scan_for_tabs($) { |
|---|
| 96 | my ($file) = @_; |
|---|
| 97 | my $has_tabs = `grep -m 1 -n -H '\t' $file`; |
|---|
| 98 | |
|---|
| 99 | # print "$file:0: has_tabs='$has_tabs'\n"; |
|---|
| 100 | |
|---|
| 101 | if ($has_tabs ne '') { |
|---|
| 102 | my $pos = "$file:0:"; |
|---|
| 103 | if ($has_tabs =~ /^[^:]+:[0-9]+:/) { |
|---|
| 104 | $pos = $&; |
|---|
| 105 | } |
|---|
| 106 | print "$pos contains tabs. Tabs are not allowed.\n"; |
|---|
| 107 | $tab_count++; |
|---|
| 108 | if ($tab_count>10) { die "Further scan skipped.\n"; } |
|---|
| 109 | } |
|---|
| 110 | } |
|---|
| 111 | |
|---|
| 112 | sub recurse_dirs($$); |
|---|
| 113 | sub recurse_dirs($$) { |
|---|
| 114 | my ($dir,$basedir) = @_; |
|---|
| 115 | |
|---|
| 116 | my @subdirs = (); |
|---|
| 117 | my $subdir = ''; |
|---|
| 118 | if ($dir ne $basedir) { |
|---|
| 119 | $subdir = substr($dir,length($basedir)+1); |
|---|
| 120 | if (defined $ignored_subdirs{$subdir}) { |
|---|
| 121 | # print "Ignoring '$subdir' (dir='$dir')\n"; |
|---|
| 122 | return; |
|---|
| 123 | } |
|---|
| 124 | } |
|---|
| 125 | |
|---|
| 126 | opendir(DIR, $dir) || die "can't read directory '$dir' (Reason: $!)"; |
|---|
| 127 | foreach (readdir(DIR)) { |
|---|
| 128 | if ($_ ne '.' and $_ ne '..') { |
|---|
| 129 | my $full = $dir.'/'.$_; |
|---|
| 130 | my $rel = $subdir.'/'.$_; |
|---|
| 131 | if (-l $full) { |
|---|
| 132 | # print "$full:0: link -- skipped\n"; |
|---|
| 133 | } |
|---|
| 134 | elsif (-d $full) { |
|---|
| 135 | if ($_ ne 'CVS' and |
|---|
| 136 | $_ ne '.svn' and |
|---|
| 137 | $_ ne '.git' and |
|---|
| 138 | $_ ne 'ARB_SOURCE_DOC' and |
|---|
| 139 | $_ ne 'old_help' and |
|---|
| 140 | $_ ne 'PERL2ARB' and |
|---|
| 141 | $_ ne 'GENC' and $_ ne 'GENH' |
|---|
| 142 | ) { |
|---|
| 143 | push @subdirs, $full; |
|---|
| 144 | } |
|---|
| 145 | } |
|---|
| 146 | elsif (-f $full) { |
|---|
| 147 | my $scan = -1; |
|---|
| 148 | my $determine = 0; |
|---|
| 149 | my $modtime = getModtime($full); |
|---|
| 150 | |
|---|
| 151 | if ($modtime<$files_newer_than) { |
|---|
| 152 | # file was created before last run of tabBrake.pl |
|---|
| 153 | $scan = 0; |
|---|
| 154 | |
|---|
| 155 | # check if it's a log from an aborted compile |
|---|
| 156 | if (/^[^.]+\.([0-9]+)\.log$/o) { |
|---|
| 157 | if ($checkForOldLogs and $modtime<($files_newer_than-3*60)) { |
|---|
| 158 | print "Old log file: $full -- removing\n"; |
|---|
| 159 | unlink($full) || print "$full:0: can't unlink (Reason: $!)\n"; |
|---|
| 160 | } |
|---|
| 161 | } |
|---|
| 162 | } |
|---|
| 163 | elsif (defined $ignored_relpath{$rel}) { |
|---|
| 164 | # print "$full:0: excluded by relpath '$rel'\n"; |
|---|
| 165 | $scan = 0; |
|---|
| 166 | } |
|---|
| 167 | else { |
|---|
| 168 | if (/\.([^.]+)$/) { # file with extension |
|---|
| 169 | my $ext = $1; |
|---|
| 170 | if (exists $ignore_extension{$ext}) { |
|---|
| 171 | # print "$full:0: excluded by extension '$ext'\n"; |
|---|
| 172 | $scan = 0; |
|---|
| 173 | } |
|---|
| 174 | elsif (exists $scan_extension{$ext}) { |
|---|
| 175 | # print "$full:0: scan!\n"; |
|---|
| 176 | $scan = 1; |
|---|
| 177 | } |
|---|
| 178 | elsif (exists $auto_determine{$ext}) { |
|---|
| 179 | # print "$full:0: scan!\n"; |
|---|
| 180 | $determine = 1; |
|---|
| 181 | } |
|---|
| 182 | else { |
|---|
| 183 | if ($ext =~ /^[0-9]+$/ |
|---|
| 184 | ) { |
|---|
| 185 | $scan = 0; |
|---|
| 186 | } |
|---|
| 187 | elsif ($full =~ /util\/config\./ or |
|---|
| 188 | $full =~ /lib\/config\./ |
|---|
| 189 | ) { |
|---|
| 190 | $scan = 1; |
|---|
| 191 | } |
|---|
| 192 | else { |
|---|
| 193 | # print "$full:0: a '$ext' file\n"; |
|---|
| 194 | } |
|---|
| 195 | } |
|---|
| 196 | } |
|---|
| 197 | else { |
|---|
| 198 | if (/Makefile/ or |
|---|
| 199 | /ChangeLog/ |
|---|
| 200 | ) { |
|---|
| 201 | $scan = 0; |
|---|
| 202 | } |
|---|
| 203 | else { |
|---|
| 204 | $determine = 1; |
|---|
| 205 | } |
|---|
| 206 | } |
|---|
| 207 | |
|---|
| 208 | if ($determine==1) { |
|---|
| 209 | $scan==-1 || die "logic error"; |
|---|
| 210 | my $file_says = `file $full`; |
|---|
| 211 | if ($file_says =~ /^[^:]+:[ ]*(.*)$/) { |
|---|
| 212 | $file_says = $1; |
|---|
| 213 | } |
|---|
| 214 | else { |
|---|
| 215 | die "Can't parse output from 'file'-command"; |
|---|
| 216 | } |
|---|
| 217 | |
|---|
| 218 | if ($file_says =~ /executable/ or |
|---|
| 219 | $file_says eq 'empty' or |
|---|
| 220 | $file_says eq 'data' or |
|---|
| 221 | $file_says eq 'IFF data' or |
|---|
| 222 | $file_says =~ /archive.*data/o or |
|---|
| 223 | $file_says =~ /shared.*object/o |
|---|
| 224 | ) { |
|---|
| 225 | $scan = 0; |
|---|
| 226 | } |
|---|
| 227 | elsif ($file_says =~ /shell.*script/ or |
|---|
| 228 | $file_says =~ /ASCII.*text/ or |
|---|
| 229 | $file_says =~ /ISO.*text/ or |
|---|
| 230 | $file_says =~ /perl.*script/ |
|---|
| 231 | ) { |
|---|
| 232 | $scan = 1; |
|---|
| 233 | } |
|---|
| 234 | else { |
|---|
| 235 | print "$full:0: file_says='$file_says'\n"; |
|---|
| 236 | } |
|---|
| 237 | } |
|---|
| 238 | } |
|---|
| 239 | if ($scan==-1) { |
|---|
| 240 | if (/^#.*#$/) { |
|---|
| 241 | print "$full:1: a lost file?\n"; |
|---|
| 242 | } |
|---|
| 243 | else { |
|---|
| 244 | # die "Don't know what to do with '$full'"; |
|---|
| 245 | } |
|---|
| 246 | } |
|---|
| 247 | elsif ($scan==1) { |
|---|
| 248 | scan_for_tabs($full); |
|---|
| 249 | # print "$full:0: scanning..\n"; |
|---|
| 250 | } |
|---|
| 251 | } |
|---|
| 252 | } |
|---|
| 253 | } |
|---|
| 254 | closedir(DIR); |
|---|
| 255 | |
|---|
| 256 | foreach (@subdirs) { |
|---|
| 257 | recurse_dirs($_,$basedir); |
|---|
| 258 | } |
|---|
| 259 | } |
|---|
| 260 | |
|---|
| 261 | # -------------------------------------------------------------------------------- |
|---|
| 262 | |
|---|
| 263 | print "--- TAB brake ---\n"; |
|---|
| 264 | |
|---|
| 265 | my $ARBHOME = $ENV{'ARBHOME'}; |
|---|
| 266 | |
|---|
| 267 | if (not defined $ARBHOME) { |
|---|
| 268 | die "'ARBHOME' not defined"; |
|---|
| 269 | } |
|---|
| 270 | |
|---|
| 271 | my $time_stamp = $ARBHOME.'/SOURCE_TOOLS/stamp.tabBrake'; |
|---|
| 272 | my $exitcode = 0; |
|---|
| 273 | if (-f $time_stamp) { |
|---|
| 274 | $files_newer_than = getModtime($time_stamp); |
|---|
| 275 | print "Checking files newer than ".localtime($files_newer_than)."\n"; |
|---|
| 276 | } |
|---|
| 277 | else { |
|---|
| 278 | if ($forceAll==1) { |
|---|
| 279 | print "Initial call - checking all files\n"; |
|---|
| 280 | $files_newer_than = 0; |
|---|
| 281 | } |
|---|
| 282 | else { |
|---|
| 283 | print "Initial call - assuming everything is TAB-free\n"; |
|---|
| 284 | $files_newer_than = time; |
|---|
| 285 | $checkForOldLogs = 0; # do not check for old logs (sometimes fails on fresh checkouts, e.g. in jenkins build server) |
|---|
| 286 | } |
|---|
| 287 | } |
|---|
| 288 | |
|---|
| 289 | if ($exitcode==0) { |
|---|
| 290 | `touch $time_stamp`; # mark time of last try |
|---|
| 291 | # i.e. user inserts TAB to file -> fail once |
|---|
| 292 | } |
|---|
| 293 | recurse_dirs($ARBHOME,$ARBHOME); |
|---|
| 294 | if ($tab_count>0) { |
|---|
| 295 | $exitcode = 1; |
|---|
| 296 | print $ARBHOME.'/SOURCE_TOOLS/tabBrake.pl:'.$defsStart.': Warning: what may contain TABs is defined here'."\n"; |
|---|
| 297 | } |
|---|
| 298 | |
|---|
| 299 | exit($exitcode); |
|---|
