handle require_once and include_once, allow single quotes

[old-projects.git] / deptrack / src / deptrack.in

#!/usr/bin/perl -w
#
# $Id$

use strict;
use Config::General;
use DBI;
use Getopt::Std;

###############################################################################
#                                                                             #
#                              Global variables                               #
#                                                                             #
###############################################################################

my $rootdir;

my %conf;
my $config;
my $confile;
my $debug;
my %opts;
my @incpath;

# file masks
my($mask_inc,$mask_php,$mask_img); 

# db connection
my($db_db,$db_host,$db_user,$db_pwd);
my($dsn,$dbh);


sub dprint {
  my $text = shift;
  print $text if ($debug);
}

###############################################################################
#                                                                             #
#                              text operations                                #
#                                                                             #
###############################################################################

# worker function called by tagextract and tagstrip
sub tagcrunch {
  my($tag1,$tag2,$intag,@lines) = @_;
  my($line,$pos,@out,$add);
   
  while ($line = shift(@lines)) {
    if ($intag) {
      # we are inside the block
      if (($pos=index($line, $tag2)) > -1) {
        $add = substr($line,0,$pos);
	$line = substr($line,$pos+length($tag2));
	$intag = 0;
      } else {
        $add = $line;
	$line = "";
      }
      $add =~ s/^\s*//;
      $add =~ s/\s*$//;
      push @out, "$add\n" if (length($add)>0);
    }
  
    if (!$intag) {
      # we are outside the block
      while(($pos = index($line, $tag1)) > -1) {
        $line = substr($line,$pos+length($tag1));
        if (($pos=index($line, $tag2)) > -1) {
            $add = substr($line,0,$pos);
	    $line = substr($line,$pos+length($tag2));
	} else {
	  $add = $line; 
	  $line="";
          $intag=1;
	}
        $add =~ s/^\s*//;
	$add =~ s/\s*$//;
        push @out, "$add\n" if (length($add)>0);
      }
    } 
  }
  return @out;
}

# return only blocks of @lines between tag1 and tag2
sub tagextract {
  my($tag1,$tag2,@lines) = @_;
  return &tagcrunch($tag1,$tag2,0,@lines);
}

# return @lines minus blocks between tag1 and tag2
sub tagstrip {
  my($tag1,$tag2,@lines) = @_;
  return &tagcrunch($tag2,$tag1,1,@lines);
}

# for each line, remove whatever is after the comment marker
sub commentstrip {
  my($tag,@lines) = @_;
  my @out;
  
  foreach my $line (@lines) {
    $line =~ s/$tag.*//;
    $line =~ s/\s*$//;
    push @out, "$line\n" if (length($line)>0);
  }
  return @out;
}


###############################################################################
#                                                                             #
#                                  DB access                                  #
#                                                                             #
###############################################################################

sub dbconnect {
  $dsn = "DBI:mysql:database=$db_db;host=$db_host";
  $dbh = DBI->connect($dsn,$db_user,$db_pwd);
}

# clear a database table
sub cleartable {
  my($table) = @_;
  my $sth = $dbh->do("delete from $table");
}

# add a dependency into DB
sub putdep {
  my($pageid,$depid,$did,$type) = @_;
  my($sth);
  
  $sth = $dbh->prepare("select id from dep where page=$pageid and dep=$depid and dir=$did and type='$type'");
  $sth->execute();
  if (!$sth->rows) {
    $dbh->do("insert into dep set page=$pageid,dep=$depid,dir=$did,type='$type'");
  }
}

# put a directory into DB
sub putdir {
  my($dir) = @_;

  &dprint("putdir($dir)\n");
  my $did=&getdirid($dir);
  if (!$did) {
    $dbh->do("insert into dir set path='$dir'");
    $did=&getdirid($dir);
  }
  return $did;
}

# put a file into DB
sub putfile {
  my($file,$exists,$did) = @_;
  my($fid,$type);
 
  $exists=0 if (!$exists);
  &dprint("putfile($file,$exists,$did)\n");
  if ($exists) {
    $type = "page" if ($file =~ /$mask_php/);
    $type = "include" if ($file =~ /$mask_inc/);
    $type = "image" if ($file =~ /$mask_img/);
  } else {
    $type = "dead";
  }

  $fid=&getfileid($file);
  if ($fid) {
    $dbh->do("update file set type='$type' where id=$fid") if ($exists);
  } else {
    $dbh->do("insert into file set path='$file',type='$type'");
    $fid=&getfileid($file);
  }
  $dbh->do("update file set dir='$did' where id=$fid") if ($did);
  return $fid;  
}

# return the ID corresponding to a directory name
sub getdirid {
  my($dir) = @_;
  my($sth);
  
  $sth = $dbh->prepare("select id from dir where path='$dir'");
  $sth->execute();
  if (my $ref = $sth->fetchrow_hashref()) {
    return $ref->{"id"};
  } else {
   return 0;
  }
}

# return the ID corresponding to a file name
sub getfileid {
  my($file) = @_;
  my($sth);
  
  $sth = $dbh->prepare("select id from file where path='$file'");
  $sth->execute();
  if (my $ref = $sth->fetchrow_hashref()) {
    return $ref->{"id"};
  } else {
   return 0;
  }
}


###############################################################################
#                                                                             #
#                              file processing                                #
#                                                                             #
###############################################################################

# from a path in the server tree, return the path in the filesystem
sub realpath {
  my($vpath) = @_;
  
  return $rootdir.$vpath;
}

# given a working directory and a relative path, return full path
# ( in the server tree )
sub abspath {
  my($curdir,$relpath) = @_;
  my(@path,@comps,$ret);
 
  # current directory not absolute
  if ($curdir !~ /^\//) {
    print "abspath($curdir,$relpath) : $curdir is not an absolute path!\n";
    die;
  }

  # relpath is already absolute
  return $relpath if ($relpath =~ /^\//);
  
  # is there a final slash?
  my $finalslash="";
  $finalslash="/" if ($relpath =~ /\/$/);
  
  @path = split /\//,substr($curdir,1);
  @comps = split /\//,$relpath;
  foreach my $comp (@comps) {
    SWITCH: {
      if ($comp =~ /^\.$/) { last SWITCH; }
      if ($comp =~ /^\.\.$/) { pop @path; last SWITCH; }
      push @path, $comp;
    }
  }
  $ret = "/". join("/",@path) .$finalslash;
  $ret =~ s/\/\//\//;
  return $ret;
}

# parse a directory
sub parsedir {
  my($vdir) = @_;
  my($fid,$did);

  # build virtual path
  $did=&putdir($vdir);

  opendir(DIRHANDLE, &realpath($vdir));
  my @list = grep /^[^\.]/, readdir(DIRHANDLE);
  closedir(DIRHANDLE);
  
  my @incfiles=grep /$mask_inc/,@list;
  map (&putfile("${vdir}$_", 1, $did), @incfiles);

  my @imgfiles=grep /$mask_img/,@list;
  map (&putfile("${vdir}$_", 1, $did), @imgfiles);
  
  my @phpfiles=grep /$mask_php/,@list;
  foreach my $phpfile (@phpfiles) {
    if (-f realpath("${vdir}${phpfile}")) {
      $fid=&putfile("${vdir}${phpfile}", 1, $did);
      &parsefile($fid, $did, "${vdir}${phpfile}", $vdir);
    } else {
      &putfile("${vdir}$phpfile", 0, $did)
    }
  } 

  foreach my $entry (@list) {
    if ((-d realpath("${vdir}${entry}")) && ($entry !~ /^CVS$/)) {
      &parsedir("${vdir}${entry}/");
    }
  }
}

# parse a file
sub parsefile {
  my($fid,$did,$vfile,$vdir) = @_;
  my(@lines,@phplines,@includes,$depid,$sth,$ifile,$iexists);
  
  &dprint("parsefile($fid,$did,$vfile,$vdir)\n");
  
  # we return if we already have dependecies in the same scope
  $sth = $dbh->prepare("select id from dep where page=$fid and dir=$did");
  $sth->execute();
  return if (my $ref = $sth->fetchrow_hashref());
  
  open(FHANDLE,realpath($vfile));
  @lines = <FHANDLE>;
  close(FHANDLE);

  # strip out commented code
  @lines = &tagstrip("<!--","-->",@lines);

  # deal with PHP lines
  @phplines = &tagextract("<?php","?>",@lines);
  @phplines = &tagstrip("/*","*/",@phplines);
  @phplines = &commentstrip("\/\/",@phplines);
  @phplines = &commentstrip("#",@phplines);
  @includes = grep s/.*(require|require_once|include|include_once)\s*\({0,1}[\"\'](.*)[\"\']\){0,1}.*\n$/$2/, @phplines;
  foreach my $include (@includes) {
    &dprint("REQ:$include\n");
    if ($include =~ /$mask_php/) {
      print "Warning : $include gets included by $vfile!\n";
    }
    $iexists=0;
    if ($include =~ /^[\.\/]/) {
      # the directory is specified
      $ifile = &abspath($vdir,$include);
      $iexists=1 if (-f &realpath($ifile));
    } else {
      # directory not specified, go through the include path
      foreach my $incp (@incpath) {
        $ifile = &abspath(&abspath($vdir,$incp),$include);
        &dprint("trying $ifile\n");
        if (-f &realpath($ifile)) {
          $iexists=1;
          last;
        }
      }
      # did not find file to be included, treat it as if it were
      # in the first segment of include path
      $ifile = &abspath(&abspath($vdir,$incpath[0]),$include) if (!$iexists);
    }
    $depid=&putfile($ifile,$iexists,0);
    &putdep($fid,$depid,$did,"include");
    &parsefile($depid,$did,$ifile,$vdir) if ($iexists);
  }
}


###############################################################################
#                                                                             #
#                                init and conf file                           #
#                                                                             #
###############################################################################

sub init {
  my $path = `pwd`;
  $confile="$ENV{'HOME'}/.deptrackrc";

  if ( not getopts('dhf:', \%opts) or $opts{'h'}) {
    &syntax();
  }

  # check for root directory
  my $nargs = @ARGV;
  $nargs || &syntax();
  $rootdir = $ARGV[0];
  $rootdir =~ s/\/$//;

  if (!-d $rootdir) {
   print "root directory $rootdir not found!\n";
   die;
  } else {
   print "Using $rootdir as web root directory\n";
  }
  
  # process options
  if ($opts{'d'}){
    print "Running in debug mode ...\n";
    $debug = 1;
  }else{
    $debug = 0;
  }
 
  if ($opts{'f'}){
    if (-r "$opts{'f'}") {
      print "Using $opts{'f'} as config file\n";
      &read_conf("$opts{'f'}");
    } else {
      print "$opts{'f'} : not a valid config file\n";
      exit(1);
    }
  } else {
    print "Using $confile as config file\n";
    if (-r "$confile") {
       &read_conf("$confile");
    } else {
      print "No valid configuration file found, aborting\n";
      exit(1);
    }
  }
  &dbconnect();
}


#Read Configuration and init global vars
sub read_val {
  my($default,$value) = @_;
  if ($value) { return $value; }
  else { return $default; }
}

sub read_conf {
  my $file = shift;
  $config = new Config::General( -file =>"$file",
                                 -AllowMultiOptions =>"yes",
                                 -LowerCaseNames =>"yes",);
  %conf = $config->getall;

  $db_db = &read_val("deptrack", $conf{'db_db'});
  $db_host = &read_val("localhost", $conf{'db_host'});
  $db_pwd = &read_val("", $conf{'db_pwd'});
  $db_user = &read_val("deptrack", $conf{'db_user'});

  @incpath = split /:/, &read_val(".", $conf{'include_path'});
  $mask_img = &read_val("\\.(png|gif|jpg)\$", $conf{'mask_img'});
  $mask_inc = &read_val("\\.inc(\\.php)?\$", $conf{'mask_inc'});
  $mask_php = &read_val("(?<!\\.inc)\\.php\$", $conf{'mask_php'});
}


# show program info
sub about {
  print "deptrack @VERSION@ Copyright (C) Jeremy Lainé and Pierre Habouzit\n\n",
        "  This program comes with ABSOLUTELY NO WARRANTY. This is free software,\n",
	"  you are welcome to distribute it under the terms of the GNU Public\n",
	"  License (GPL) version 2.\n\n";
}

# return program syntax 
sub syntax {
  print "Syntax:\n",
        "  deptrack [options] root_directory\n\n",
	" Options:\n",
        "  -h          - this help message\n",
        "  -f <file>   - use <file> as config file\n",
        "  -d          - debug mode\n";
  exit(1);
}


###############################################################################
#                                                                             #
#                                       main                                  #
#                                                                             #
###############################################################################

&about();
&init();
&cleartable("dir");
&cleartable("file");
&cleartable("dep");
&parsedir("/");