Bugfix -> un chomp de merde et 1 heure de perdue :( Le fichier de conf

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

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

# 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;
  my $pos;
  my $out;
  my $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) { $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) { $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);
}

# parse a directory
sub parsedir {
  my $dirhandle;
  my $dir = $_[0];
  my $file;
  
  opendir($dirhandle,$dir);
  my @files=grep /.*.(php|inc)/,readdir($dirhandle);
  closedir($dirhandle);
  foreach $file (@files) {
    parsefile($file);
  }
}

# parse a file
sub parsefile {
  my $fhandle;
  my $file = $_[0];
  
  open($fhandle,$file);
  @lines = <$fhandle>;
  close($fhandle);
  @lines = tagstrip("<!--","-->",@lines);
  @lines = tagextract("<?php","?>",@lines);
  @lines = tagstrip("/*","*/",@lines);
  print @lines;
}

my $dir;
my $nargs = @ARGV;
$nargs || syntax();

foreach $dir (@ARGV) {
  parsedir($dir);
}