| 1 | #!/usr/bin/perl -w |
| 2 | # |
| 3 | # $Id$ |
| 4 | |
| 5 | use strict; |
| 6 | use Config::General; |
| 7 | use DBI; |
| 8 | use Getopt::Std; |
| 9 | |
| 10 | ############################################################################### |
| 11 | # # |
| 12 | # Global variables # |
| 13 | # # |
| 14 | ############################################################################### |
| 15 | |
| 16 | my $rootdir; |
| 17 | |
| 18 | my %conf; |
| 19 | my $config; |
| 20 | my $confile; |
| 21 | my $debug; |
| 22 | my %opts; |
| 23 | my @incpath; |
| 24 | |
| 25 | # file masks |
| 26 | my($mask_inc,$mask_php,$mask_img); |
| 27 | |
| 28 | # db connection |
| 29 | my($db_db,$db_host,$db_user,$db_pwd); |
| 30 | my($dsn,$dbh); |
| 31 | |
| 32 | |
| 33 | sub dprint { |
| 34 | my $text = shift; |
| 35 | print $text if ($debug); |
| 36 | } |
| 37 | |
| 38 | ############################################################################### |
| 39 | # # |
| 40 | # text operations # |
| 41 | # # |
| 42 | ############################################################################### |
| 43 | |
| 44 | # worker function called by tagextract and tagstrip |
| 45 | sub tagcrunch { |
| 46 | my($tag1,$tag2,$intag,@lines) = @_; |
| 47 | my($line,$pos,@out,$add); |
| 48 | |
| 49 | while ($line = shift(@lines)) { |
| 50 | if ($intag) { |
| 51 | # we are inside the block |
| 52 | if (($pos=index($line, $tag2)) > -1) { |
| 53 | $add = substr($line,0,$pos); |
| 54 | $line = substr($line,$pos+length($tag2)); |
| 55 | $intag = 0; |
| 56 | } else { |
| 57 | $add = $line; |
| 58 | $line = ""; |
| 59 | } |
| 60 | $add =~ s/^\s*//; |
| 61 | $add =~ s/\s*$//; |
| 62 | push @out, "$add\n" if (length($add)>0); |
| 63 | } |
| 64 | |
| 65 | if (!$intag) { |
| 66 | # we are outside the block |
| 67 | while(($pos = index($line, $tag1)) > -1) { |
| 68 | $line = substr($line,$pos+length($tag1)); |
| 69 | if (($pos=index($line, $tag2)) > -1) { |
| 70 | $add = substr($line,0,$pos); |
| 71 | $line = substr($line,$pos+length($tag2)); |
| 72 | } else { |
| 73 | $add = $line; |
| 74 | $line=""; |
| 75 | $intag=1; |
| 76 | } |
| 77 | $add =~ s/^\s*//; |
| 78 | $add =~ s/\s*$//; |
| 79 | push @out, "$add\n" if (length($add)>0); |
| 80 | } |
| 81 | } |
| 82 | } |
| 83 | return @out; |
| 84 | } |
| 85 | |
| 86 | # return only blocks of @lines between tag1 and tag2 |
| 87 | sub tagextract { |
| 88 | my($tag1,$tag2,@lines) = @_; |
| 89 | return &tagcrunch($tag1,$tag2,0,@lines); |
| 90 | } |
| 91 | |
| 92 | # return @lines minus blocks between tag1 and tag2 |
| 93 | sub tagstrip { |
| 94 | my($tag1,$tag2,@lines) = @_; |
| 95 | return &tagcrunch($tag2,$tag1,1,@lines); |
| 96 | } |
| 97 | |
| 98 | # for each line, remove whatever is after the comment marker |
| 99 | sub commentstrip { |
| 100 | my($tag,@lines) = @_; |
| 101 | my @out; |
| 102 | |
| 103 | foreach my $line (@lines) { |
| 104 | $line =~ s/$tag.*//; |
| 105 | $line =~ s/\s*$//; |
| 106 | push @out, "$line\n" if (length($line)>0); |
| 107 | } |
| 108 | return @out; |
| 109 | } |
| 110 | |
| 111 | |
| 112 | ############################################################################### |
| 113 | # # |
| 114 | # DB access # |
| 115 | # # |
| 116 | ############################################################################### |
| 117 | |
| 118 | sub dbconnect { |
| 119 | $dsn = "DBI:mysql:database=$db_db;host=$db_host"; |
| 120 | $dbh = DBI->connect($dsn,$db_user,$db_pwd); |
| 121 | } |
| 122 | |
| 123 | # clear a database table |
| 124 | sub cleartable { |
| 125 | my($table) = @_; |
| 126 | my $sth = $dbh->do("delete from $table"); |
| 127 | } |
| 128 | |
| 129 | # add a dependency into DB |
| 130 | sub putdep { |
| 131 | my($pageid,$depid,$did,$type) = @_; |
| 132 | my($sth); |
| 133 | |
| 134 | $sth = $dbh->prepare("select id from dep where page=$pageid and dep=$depid and dir=$did and type='$type'"); |
| 135 | $sth->execute(); |
| 136 | if (!$sth->rows) { |
| 137 | $dbh->do("insert into dep set page=$pageid,dep=$depid,dir=$did,type='$type'"); |
| 138 | } |
| 139 | } |
| 140 | |
| 141 | # put a directory into DB |
| 142 | sub putdir { |
| 143 | my($dir) = @_; |
| 144 | |
| 145 | &dprint("putdir($dir)\n"); |
| 146 | my $did=&getdirid($dir); |
| 147 | if (!$did) { |
| 148 | $dbh->do("insert into dir set path='$dir'"); |
| 149 | $did=&getdirid($dir); |
| 150 | } |
| 151 | return $did; |
| 152 | } |
| 153 | |
| 154 | # put a file into DB |
| 155 | sub putfile { |
| 156 | my($file,$exists,$did) = @_; |
| 157 | my($fid,$type); |
| 158 | |
| 159 | $exists=0 if (!$exists); |
| 160 | &dprint("putfile($file,$exists,$did)\n"); |
| 161 | if ($exists) { |
| 162 | $type = "page" if ($file =~ /$mask_php/); |
| 163 | $type = "include" if ($file =~ /$mask_inc/); |
| 164 | $type = "image" if ($file =~ /$mask_img/); |
| 165 | } else { |
| 166 | $type = "dead"; |
| 167 | } |
| 168 | |
| 169 | $fid=&getfileid($file); |
| 170 | if ($fid) { |
| 171 | $dbh->do("update file set type='$type' where id=$fid") if ($exists); |
| 172 | } else { |
| 173 | $dbh->do("insert into file set path='$file',type='$type'"); |
| 174 | $fid=&getfileid($file); |
| 175 | } |
| 176 | $dbh->do("update file set dir='$did' where id=$fid") if ($did); |
| 177 | return $fid; |
| 178 | } |
| 179 | |
| 180 | # return the ID corresponding to a directory name |
| 181 | sub getdirid { |
| 182 | my($dir) = @_; |
| 183 | my($sth); |
| 184 | |
| 185 | $sth = $dbh->prepare("select id from dir where path='$dir'"); |
| 186 | $sth->execute(); |
| 187 | if (my $ref = $sth->fetchrow_hashref()) { |
| 188 | return $ref->{"id"}; |
| 189 | } else { |
| 190 | return 0; |
| 191 | } |
| 192 | } |
| 193 | |
| 194 | # return the ID corresponding to a file name |
| 195 | sub getfileid { |
| 196 | my($file) = @_; |
| 197 | my($sth); |
| 198 | |
| 199 | $sth = $dbh->prepare("select id from file where path='$file'"); |
| 200 | $sth->execute(); |
| 201 | if (my $ref = $sth->fetchrow_hashref()) { |
| 202 | return $ref->{"id"}; |
| 203 | } else { |
| 204 | return 0; |
| 205 | } |
| 206 | } |
| 207 | |
| 208 | |
| 209 | ############################################################################### |
| 210 | # # |
| 211 | # file processing # |
| 212 | # # |
| 213 | ############################################################################### |
| 214 | |
| 215 | # from a path in the server tree, return the path in the filesystem |
| 216 | sub realpath { |
| 217 | my($vpath) = @_; |
| 218 | |
| 219 | return $rootdir.$vpath; |
| 220 | } |
| 221 | |
| 222 | # given a working directory and a relative path, return full path |
| 223 | # ( in the server tree ) |
| 224 | sub abspath { |
| 225 | my($curdir,$relpath) = @_; |
| 226 | my(@path,@comps,$ret); |
| 227 | |
| 228 | # current directory not absolute |
| 229 | if ($curdir !~ /^\//) { |
| 230 | print "abspath($curdir,$relpath) : $curdir is not an absolute path!\n"; |
| 231 | die; |
| 232 | } |
| 233 | |
| 234 | # relpath is already absolute |
| 235 | return $relpath if ($relpath =~ /^\//); |
| 236 | |
| 237 | # is there a final slash? |
| 238 | my $finalslash=""; |
| 239 | $finalslash="/" if ($relpath =~ /\/$/); |
| 240 | |
| 241 | @path = split /\//,substr($curdir,1); |
| 242 | @comps = split /\//,$relpath; |
| 243 | foreach my $comp (@comps) { |
| 244 | SWITCH: { |
| 245 | if ($comp =~ /^\.$/) { last SWITCH; } |
| 246 | if ($comp =~ /^\.\.$/) { pop @path; last SWITCH; } |
| 247 | push @path, $comp; |
| 248 | } |
| 249 | } |
| 250 | $ret = "/". join("/",@path) .$finalslash; |
| 251 | $ret =~ s/\/\//\//; |
| 252 | return $ret; |
| 253 | } |
| 254 | |
| 255 | # parse a directory |
| 256 | sub parsedir { |
| 257 | my($vdir) = @_; |
| 258 | my($fid,$did); |
| 259 | |
| 260 | # build virtual path |
| 261 | $did=&putdir($vdir); |
| 262 | |
| 263 | opendir(DIRHANDLE, &realpath($vdir)); |
| 264 | my @list = grep /^[^\.]/, readdir(DIRHANDLE); |
| 265 | closedir(DIRHANDLE); |
| 266 | |
| 267 | my @incfiles=grep /$mask_inc/,@list; |
| 268 | map (&putfile("${vdir}$_", 1, $did), @incfiles); |
| 269 | |
| 270 | my @imgfiles=grep /$mask_img/,@list; |
| 271 | map (&putfile("${vdir}$_", 1, $did), @imgfiles); |
| 272 | |
| 273 | my @phpfiles=grep /$mask_php/,@list; |
| 274 | foreach my $phpfile (@phpfiles) { |
| 275 | if (-f realpath("${vdir}${phpfile}")) { |
| 276 | $fid=&putfile("${vdir}${phpfile}", 1, $did); |
| 277 | &parsefile($fid, $did, "${vdir}${phpfile}", $vdir); |
| 278 | } else { |
| 279 | &putfile("${vdir}$phpfile", 0, $did) |
| 280 | } |
| 281 | } |
| 282 | |
| 283 | foreach my $entry (@list) { |
| 284 | if ((-d realpath("${vdir}${entry}")) && ($entry !~ /^CVS$/)) { |
| 285 | &parsedir("${vdir}${entry}/"); |
| 286 | } |
| 287 | } |
| 288 | } |
| 289 | |
| 290 | # parse a file |
| 291 | sub parsefile { |
| 292 | my($fid,$did,$vfile,$vdir) = @_; |
| 293 | my(@lines,@phplines,@includes,$depid,$sth,$ifile,$iexists); |
| 294 | |
| 295 | &dprint("parsefile($fid,$did,$vfile,$vdir)\n"); |
| 296 | |
| 297 | # we return if we already have dependecies in the same scope |
| 298 | $sth = $dbh->prepare("select id from dep where page=$fid and dir=$did"); |
| 299 | $sth->execute(); |
| 300 | return if (my $ref = $sth->fetchrow_hashref()); |
| 301 | |
| 302 | open(FHANDLE,realpath($vfile)); |
| 303 | @lines = <FHANDLE>; |
| 304 | close(FHANDLE); |
| 305 | |
| 306 | # strip out commented code |
| 307 | @lines = &tagstrip("<!--","-->",@lines); |
| 308 | |
| 309 | # deal with PHP lines |
| 310 | @phplines = &tagextract("<?php","?>",@lines); |
| 311 | @phplines = &tagstrip("/*","*/",@phplines); |
| 312 | @phplines = &commentstrip("\/\/",@phplines); |
| 313 | @phplines = &commentstrip("#",@phplines); |
| 314 | @includes = grep s/.*(require|include)\s*\({0,1}\"(.*)\"\){0,1}.*\n$/$2/, @phplines; |
| 315 | foreach my $include (@includes) { |
| 316 | &dprint("REQ:$include\n"); |
| 317 | if ($include =~ /$mask_php/) { |
| 318 | print "Warning : $include gets included by $vfile!\n"; |
| 319 | } |
| 320 | $iexists=0; |
| 321 | if ($include =~ /^[\.\/]/) { |
| 322 | # the directory is specified |
| 323 | $ifile = &abspath($vdir,$include); |
| 324 | $iexists=1 if (-f &realpath($ifile)); |
| 325 | } else { |
| 326 | # directory not specified, go through the include path |
| 327 | foreach my $incp (@incpath) { |
| 328 | $ifile = &abspath(&abspath($vdir,$incp),$include); |
| 329 | &dprint("trying $ifile\n"); |
| 330 | if (-f &realpath($ifile)) { |
| 331 | $iexists=1; |
| 332 | last; |
| 333 | } |
| 334 | } |
| 335 | # did not find file to be included, treat it as if it were |
| 336 | # in the first segment of include path |
| 337 | $ifile = &abspath(&abspath($vdir,$incpath[0]),$include) if (!$iexists); |
| 338 | } |
| 339 | $depid=&putfile($ifile,$iexists,0); |
| 340 | &putdep($fid,$depid,$did,"include"); |
| 341 | &parsefile($depid,$did,$ifile,$vdir) if ($iexists); |
| 342 | } |
| 343 | } |
| 344 | |
| 345 | |
| 346 | ############################################################################### |
| 347 | # # |
| 348 | # init and conf file # |
| 349 | # # |
| 350 | ############################################################################### |
| 351 | |
| 352 | sub init { |
| 353 | my $path = `pwd`; |
| 354 | $confile="$ENV{'HOME'}/.deptrackrc"; |
| 355 | |
| 356 | if ( not getopts('dhf:', \%opts) or $opts{'h'}) { |
| 357 | &syntax(); |
| 358 | } |
| 359 | |
| 360 | # check for root directory |
| 361 | my $nargs = @ARGV; |
| 362 | $nargs || &syntax(); |
| 363 | $rootdir = $ARGV[0]; |
| 364 | $rootdir =~ s/\/$//; |
| 365 | |
| 366 | if (!-d $rootdir) { |
| 367 | print "root directory $rootdir not found!\n"; |
| 368 | die; |
| 369 | } else { |
| 370 | print "Using $rootdir as web root directory\n"; |
| 371 | } |
| 372 | |
| 373 | # process options |
| 374 | if ($opts{'d'}){ |
| 375 | print "Running in debug mode ...\n"; |
| 376 | $debug = 1; |
| 377 | }else{ |
| 378 | $debug = 0; |
| 379 | } |
| 380 | |
| 381 | if ($opts{'f'}){ |
| 382 | if (-r "$opts{'f'}") { |
| 383 | print "Using $opts{'f'} as config file\n"; |
| 384 | &read_conf("$opts{'f'}"); |
| 385 | } else { |
| 386 | print "$opts{'f'} : not a valid config file\n"; |
| 387 | exit(1); |
| 388 | } |
| 389 | } else { |
| 390 | print "Using $confile as config file\n"; |
| 391 | if (-r "$confile") { |
| 392 | &read_conf("$confile"); |
| 393 | } else { |
| 394 | print "No valid configuration file found, aborting\n"; |
| 395 | exit(1); |
| 396 | } |
| 397 | } |
| 398 | &dbconnect(); |
| 399 | } |
| 400 | |
| 401 | |
| 402 | #Read Configuration and init global vars |
| 403 | sub read_val { |
| 404 | my($default,$value) = @_; |
| 405 | if ($value) { return $value; } |
| 406 | else { return $default; } |
| 407 | } |
| 408 | |
| 409 | sub read_conf { |
| 410 | my $file = shift; |
| 411 | $config = new Config::General( -file =>"$file", |
| 412 | -AllowMultiOptions =>"yes", |
| 413 | -LowerCaseNames =>"yes",); |
| 414 | %conf = $config->getall; |
| 415 | |
| 416 | $db_db = &read_val("deptrack", $conf{'db_db'}); |
| 417 | $db_host = &read_val("localhost", $conf{'db_host'}); |
| 418 | $db_pwd = &read_val("", $conf{'db_pwd'}); |
| 419 | $db_user = &read_val("deptrack", $conf{'db_user'}); |
| 420 | |
| 421 | @incpath = split /:/, &read_val(".", $conf{'include_path'}); |
| 422 | $mask_img = &read_val("\\.(png|gif|jpg)\$", $conf{'mask_img'}); |
| 423 | $mask_inc = &read_val("\\.inc(\\.php)?\$", $conf{'mask_inc'}); |
| 424 | $mask_php = &read_val("(?<!\\.inc)\\.php\$", $conf{'mask_php'}); |
| 425 | } |
| 426 | |
| 427 | |
| 428 | # show program info |
| 429 | sub about { |
| 430 | print "deptrack @VERSION@ Copyright (C) Jeremy Lainé and Pierre Habouzit\n\n", |
| 431 | " This program comes with ABSOLUTELY NO WARRANTY. This is free software,\n", |
| 432 | " you are welcome to distribute it under the terms of the GNU Public\n", |
| 433 | " License (GPL) version 2.\n\n"; |
| 434 | } |
| 435 | |
| 436 | # return program syntax |
| 437 | sub syntax { |
| 438 | print "Syntax:\n", |
| 439 | " deptrack [options] root_directory\n\n", |
| 440 | " Options:\n", |
| 441 | " -h - this help message\n", |
| 442 | " -f <file> - use <file> as config file\n", |
| 443 | " -d - debug mode\n"; |
| 444 | exit(1); |
| 445 | } |
| 446 | |
| 447 | |
| 448 | ############################################################################### |
| 449 | # # |
| 450 | # main # |
| 451 | # # |
| 452 | ############################################################################### |
| 453 | |
| 454 | &about(); |
| 455 | &init(); |
| 456 | &cleartable("dir"); |
| 457 | &cleartable("file"); |
| 458 | &cleartable("dep"); |
| 459 | &parsedir("/"); |