deptrack/deptrack.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # $Id$
   4
   5 use strict;
   6 use DBI();
   7
   8 my $dsn = "DBI:mysql:database=deptrack;host=localhost";
   9 my $dbh = DBI->connect($dsn,"deptrack","phptrax");
  10
  11 my @incpath = split /:/, "./:../";
  12
  13 my $mask_inc = "\\.inc(\\.php)?\$";
  14 my $mask_php = "(?<!\\.inc)\\.php\$";
  15 my $mask_img = "\\.(png|gif|jpg)\$";
  16
  17 my $rootdir = $ARGV[0];
  18
  19 my $debug = 0;
  20
  21 # return program syntax
  22 sub syntax {
  23   print "Syntax:\n\tdeptrack root_directory\n\n";
  24   exit 0;
  25 }
  26
  27 sub dprint {
  28   my($text) = @_;
  29   print($text) if ($debug);
  30 }
  31
  32 ###############################################################################
  33 #                                                                             #
  34 #                              text operations                                #
  35 #                                                                             #
  36 ###############################################################################
  37
  38 # worker function called by tagextract and tagstrip
  39 sub tagcrunch {
  40   my($tag1,$tag2,$intag,@lines) = @_;
  41   my($line,$pos,@out,$add);
  42
  43   while ($line = shift(@lines)) {
  44     if ($intag) {
  45       # we are inside the block
  46       if (($pos=index($line, $tag2)) > -1) {
  47         $add = substr($line,0,$pos);
  48         $line = substr($line,$pos+length($tag2));
  49         $intag = 0;
  50       } else {
  51         $add = $line;
  52         $line = "";
  53       }
  54       $add =~ s/^\s*//;
  55       $add =~ s/\s*$//;
  56       push @out, "$add\n" if (length($add)>0);
  57     }
  58
  59     if (!$intag) {
  60       # we are outside the block
  61       while(($pos = index($line, $tag1)) > -1) {
  62         $line = substr($line,$pos+length($tag1));
  63         if (($pos=index($line, $tag2)) > -1) {
  64             $add = substr($line,0,$pos);
  65             $line = substr($line,$pos+length($tag2));
  66         } else {
  67           $add = $line;
  68           $line="";
  69           $intag=1;
  70         }
  71         $add =~ s/^\s*//;
  72         $add =~ s/\s*$//;
  73         push @out, "$add\n" if (length($add)>0);
  74       }
  75     }
  76   }
  77   return @out;
  78 }
  79
  80 # return only blocks of @lines between tag1 and tag2
  81 sub tagextract {
  82   my($tag1,$tag2,@lines) = @_;
  83   return &tagcrunch($tag1,$tag2,0,@lines);
  84 }
  85
  86 # return @lines minus blocks between tag1 and tag2
  87 sub tagstrip {
  88   my($tag1,$tag2,@lines) = @_;
  89   return &tagcrunch($tag2,$tag1,1,@lines);
  90 }
  91
  92 # for each line, remove whatever is after the comment marker
  93 sub commentstrip {
  94   my($tag,@lines) = @_;
  95   my @out;
  96
  97   foreach my $line (@lines) {
  98     $line =~ s/$tag.*//;
  99     $line =~ s/\s*$//;
 100     push @out, "$line\n" if (length($line)>0);
 101   }
 102   return @out;
 103 }
 104
 105
 106 ###############################################################################
 107 #                                                                             #
 108 #                                  DB access                                  #
 109 #                                                                             #
 110 ###############################################################################
 111
 112 # clear a database table
 113 sub cleartable {
 114   my($table) = @_;
 115   my $sth = $dbh->do("delete from $table");
 116 }
 117
 118 # add a dependency into DB
 119 sub putdep {
 120   my($pageid,$depid,$did,$type) = @_;
 121   my($sth);
 122
 123   $sth = $dbh->prepare("select id from dep where page=$pageid and dep=$depid and dir=$did and type='$type'");
 124   $sth->execute();
 125   if (!$sth->rows) {
 126     $dbh->do("insert into dep set page=$pageid,dep=$depid,dir=$did,type='$type'");
 127   }
 128 }
 129
 130 # put a directory into DB
 131 sub putdir {
 132   my($dir) = @_;
 133
 134   &dprint("putdir($dir)\n");
 135   my $did=&getdirid($dir);
 136   if (!$did) {
 137     $dbh->do("insert into dir set path='$dir'");
 138     $did=&getdirid($dir);
 139   }
 140   return $did;
 141 }
 142
 143 # put a file into DB
 144 sub putfile {
 145   my($file,$exists) = @_;
 146   my($fid,$type);
 147
 148   $exists=0 if (!$exists);
 149   &dprint("putfile($file,$exists)\n");
 150   if ($exists) {
 151     $type = "page" if ($file =~ /$mask_php/);
 152     $type = "include" if ($file =~ /$mask_inc/);
 153     $type = "image" if ($file =~ /$mask_img/);
 154   } else {
 155     $type = "dead";
 156   }
 157
 158   $fid=&getfileid($file);
 159   if ($fid) {
 160     $dbh->do("update file set type='$type' where id=$fid") if ($exists);
 161   } else {
 162     $dbh->do("insert into file set path='$file',type='$type'");
 163     $fid=&getfileid($file);
 164   }
 165   return $fid;
 166 }
 167
 168 # return the ID corresponding to a directory name
 169 sub getdirid {
 170   my($dir) = @_;
 171   my($sth);
 172
 173   $sth = $dbh->prepare("select id from dir where path='$dir'");
 174   $sth->execute();
 175   if (my $ref = $sth->fetchrow_hashref()) {
 176     return $ref->{"id"};
 177   } else {
 178    return 0;
 179   }
 180 }
 181
 182 # return the ID corresponding to a file name
 183 sub getfileid {
 184   my($file) = @_;
 185   my($sth);
 186
 187   $sth = $dbh->prepare("select id from file where path='$file'");
 188   $sth->execute();
 189   if (my $ref = $sth->fetchrow_hashref()) {
 190     return $ref->{"id"};
 191   } else {
 192    return 0;
 193   }
 194 }
 195
 196
 197 ###############################################################################
 198 #                                                                             #
 199 #                              file processing                                #
 200 #                                                                             #
 201 ###############################################################################
 202
 203 # from a path in the server tree, return the path in the filesystem
 204 sub realpath {
 205   my($vpath) = @_;
 206
 207   return $rootdir.$vpath;
 208 }
 209
 210 # given a working directory and a relative path, return full path
 211 # ( in the server tree )
 212 sub abspath {
 213   my($curdir,$relpath) = @_;
 214   my(@path,@comps,$ret);
 215
 216   # current directory not absolute
 217   if ($curdir !~ /^\//) {
 218     print "abspath($curdir,$relpath) : $curdir is not an absolute path!\n";
 219     die;
 220   }
 221
 222   # relpath is already absolute
 223   return $relpath if ($relpath =~ /^\//);
 224
 225   # is there a final slash?
 226   my $finalslash="";
 227   $finalslash="/" if ($relpath =~ /\/$/);
 228
 229   @path = split /\//,substr($curdir,1);
 230   @comps = split /\//,$relpath;
 231   foreach my $comp (@comps) {
 232     SWITCH: {
 233       if ($comp =~ /^\.$/) { last SWITCH; }
 234       if ($comp =~ /^\.\.$/) { pop @path; last SWITCH; }
 235       push @path, $comp;
 236     }
 237   }
 238   $ret = "/". join("/",@path) .$finalslash;
 239   $ret =~ s/\/\//\//;
 240   return $ret;
 241 }
 242
 243 # parse a directory
 244 sub parsedir {
 245   my($vdir) = @_;
 246   my($fid,$did);
 247
 248   # build virtual path
 249   $did=&putdir($vdir);
 250
 251   opendir(DIRHANDLE, &realpath($vdir));
 252   my @list = grep /^[^\.]/, readdir(DIRHANDLE);
 253   closedir(DIRHANDLE);
 254
 255   my @incfiles=grep /$mask_inc/,@list;
 256   map (&putfile("${vdir}$_", 1), @incfiles);
 257
 258   my @imgfiles=grep /$mask_img/,@list;
 259   map (&putfile("${vdir}$_", 1), @imgfiles);
 260
 261   my @phpfiles=grep /$mask_php/,@list;
 262   foreach my $phpfile (@phpfiles) {
 263     if (-f realpath("${vdir}${phpfile}")) {
 264       $fid=&putfile("${vdir}${phpfile}", 1);
 265       &parsefile($fid, $did, "${vdir}${phpfile}", $vdir);
 266     } else {
 267       &putfile("${vdir}$phpfile", 0)
 268     }
 269   }
 270
 271   foreach my $entry (@list) {
 272     if ((-d realpath("${vdir}${entry}")) && ($entry !~ /^CVS$/)) {
 273       &parsedir("${vdir}${entry}/");
 274     }
 275   }
 276 }
 277
 278 # parse a file
 279 sub parsefile {
 280   my($fid,$did,$vfile,$vdir) = @_;
 281   my(@lines,@phplines,@includes,$depid,$sth,$ifile,$iexists);
 282
 283   &dprint("parsefile($fid,$did,$vfile,$vdir)\n");
 284
 285   # we return if we already have dependecies in the same scope
 286   $sth = $dbh->prepare("select id from dep where page=$fid and dir=$did");
 287   $sth->execute();
 288   return if (my $ref = $sth->fetchrow_hashref());
 289
 290   open(FHANDLE,realpath($vfile));
 291   @lines = <FHANDLE>;
 292   close(FHANDLE);
 293
 294   # strip out commented code
 295   @lines = &tagstrip("<!--","-->",@lines);
 296
 297   # deal with PHP lines
 298   @phplines = &tagextract("<?php","?>",@lines);
 299   @phplines = &tagstrip("/*","*/",@phplines);
 300   @phplines = &commentstrip("\/\/",@phplines);
 301   @phplines = &commentstrip("#",@phplines);
 302   @includes = grep s/.*(require|include)\s*\(\"(.*)\"\).*\n$/$2/, @phplines;
 303   foreach my $include (@includes) {
 304     &dprint("REQ:$include\n");
 305     if ($include =~ /$mask_php/) {
 306       print "Warning : $include gets included by $vfile!\n";
 307     }
 308     $iexists=0;
 309     if ($include =~ /^[\.\/]/) {
 310       # the directory is specified
 311       $ifile = &abspath($vdir,$include);
 312       $iexists=1 if (-f &realpath($ifile));
 313     } else {
 314       # directory not specified, go through the include path
 315       foreach my $incp (@incpath) {
 316         $ifile = &abspath(&abspath($vdir,$incp),$include);
 317         &dprint("trying $ifile\n");
 318         if (-f &realpath($ifile)) {
 319           $iexists=1;
 320           last;
 321         }
 322       }
 323       # did not find file to be included, treat it as if it were
 324       # in the first segment of include path
 325       $ifile = &abspath(&abspath($vdir,$incpath[0]),$include) if (!$iexists);
 326     }
 327     $depid=&putfile($ifile,$iexists);
 328     &putdep($fid,$depid,$did,"include");
 329     &parsefile($depid,$did,$ifile,$vdir) if ($iexists);
 330   }
 331 }
 332
 333 ## do the work
 334 my $nargs = @ARGV;
 335 $nargs || &syntax();
 336
 337 $rootdir =~ s/\/$//;
 338
 339 if (!-d $rootdir) {
 340  print "root directory $rootdir not found!\n";
 341  die;
 342 }
 343
 344 &cleartable("dir");
 345 &cleartable("file");
 346 &cleartable("dep");
 347 &parsedir("/");