initial commit

[old-projects.git] / deptrack / deptrack.pl

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

use DBI;
use strict;

my $dsn = "DBI:mysql:database=deptrack;host=localhost";
my $dbh = DBI->connect($dsn,"deptrack","phptrax");


# return program syntax 
sub syntax {
  print "Syntax:\n\tdeptrack directory\n";
  die;
}

# 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*$//;
      if (length($add)>0) { push @out, "$add\n"; }
    }
  
    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*$//;
        if (length($add)>0) { push @out, "$add\n"; }
      }
    } 
  }
  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*$//;
    if (length($line)>0) { push @out, "$line\n"; }
  }
  return @out;
}

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

  # build virtual path
  if (length($vdir)>0) {
    $vdir="$vdir/"
  }

  opendir(DIRHANDLE, $dir);
  my @list = grep /^[^\.]/, readdir(DIRHANDLE);
  closedir(DIRHANDLE);
  
  my @phpfiles=grep /\.(php|inc)$/,@list;
  foreach my $file (@phpfiles) {
    parsefile("$dir/$file","$vdir$file");
  }

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

# parse a file
sub parsefile {
  my($file,$vfile,$vdir) = @_;
  my(@lines,@phplines,@includes);
 
  open(FHANDLE,$file);
  @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 /(require|include)\s*\(/, @phplines;
  foreach my $include (@includes) {
    if ($include =~ /\.inc(\.php)?$/) {

    } else {

    }
  }
}

# create DB entries for a directory
sub listdir {
  my($dir,$vdir) = @_;
  my($sth);
  
  # build virtual path
  if (length($vdir)>0) {
    $vdir="$vdir/";
  }

  opendir(DIRHANDLE, $dir);
  my @list = grep /^[^\.]/, readdir(DIRHANDLE);
  closedir(DIRHANDLE);
  
  my @phpfiles=grep /\.(php|inc)/,@list;
  foreach my $file (@phpfiles) {
    if ($file =~ /\.inc(\.php)?$/) {
      $sth = $dbh->prepare("insert into file set path='$vdir$file',type='include'");
    } else {
      $sth = $dbh->prepare("insert into file set path='$vdir$file',type='page'");
    }
    $sth->execute;
  }
  
  foreach my $entry (@list) {
    if (-d $entry) {
      if ($entry !~ /^CVS$/) {
        &listdir("$dir/$entry", "$vdir$entry");
      }
    }
  }
}

## do the work
my $nargs = @ARGV;
$nargs || syntax();

my $topdir = $ARGV[0];
$topdir =~ s/\/$//;

listdir($topdir,"");
parsedir($topdir,"");