deptrack/src/deptrack.in

   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("/");