lib/graphincludes/project/default.pm

   1 # This file is part of the graph-includes package
   2 #
   3 # (c) 2005 Yann Dirson <ydirson@altern.org>
   4 # Distributed under version 2 of the GNU GPL.
   5
   6 package graphincludes::project::default;
   7 use graphincludes::project;
   8 our @ISA = qw(graphincludes::project);
   9
  10 sub new {
  11     my $class = shift;
  12     my $self;
  13
  14     $self  = $class->SUPER::new(@_);
  15
  16     bless ($self, $class);
  17
  18     $self->{IGNOREDDEPS} = $self->ignored_deps();
  19     $self->{IGNOREDEDGES} = {}; # to be computed in getdeps
  20
  21     return $self;
  22 }
  23
  24 sub filelabel {
  25   my $self = shift;
  26   my ($file,$level) = @_;
  27   $level = $main::minshow unless defined $level;
  28
  29   $file =~ s/^$self->{PFXSTRIP}// if defined $self->{PFXSTRIP};
  30   if ($level == 0) {
  31     return $file;
  32   } elsif ($level == 1) {
  33     $file =~ s/\.[^.]*$//;
  34     return $file;
  35   } elsif ($level == 2) {
  36     if ($file =~ m!(.*)/.*!) {
  37       return $1;
  38     } else {
  39       return '<' . $self->filelabel($file, $level - 1) . '>';
  40     }
  41   }
  42   return undef;
  43 }
  44
  45 sub defaultcolors {
  46   return ();
  47 }
  48
  49 sub ignored_deps {
  50   return {};
  51 }
  52
  53 sub special_edge {
  54   my $self = shift;
  55   my ($src, $dst) = @_;
  56
  57   my $lbl = $self->{IGNOREDEDGES}->{$src}->{$dst};
  58
  59   if (defined $lbl) {
  60     return "color=gray,constraint=false,label=\"$lbl\"";
  61   } else {
  62     return $self->SUPER::special_edge($src,$dst);
  63   }
  64 }
  65
  66 sub getdeps {
  67     my $self = shift;
  68     my %deps;
  69
  70     sub fullpath {
  71         my ($dstpath, $strip, $srcpath) = @_;
  72         join ('/', @$srcpath[0..($#$srcpath-$strip)], @$dstpath);
  73     }
  74
  75     while (<>) {
  76         if (m/^\s*#\s*include\s*"(.*)"/) {
  77             my @srcpath = split (m|/|, $ARGV); # can we avoid to compute this for each dep ?
  78             my @dstpath = split (m|/|, $1);
  79             # count number of leading "../" in the #include reference
  80             my $strip = 1;      # we'll have to strip at least the basename from srcpath
  81             while ($dstpath[0] eq '..') { $strip++; shift @dstpath; }
  82             while ($#srcpath >= $strip and
  83                    !defined $self->{NODEIDS}->{$self->filelabel(fullpath(\@dstpath,$strip,\@srcpath))})
  84             { $strip++; }
  85             my $dstfile = fullpath(\@dstpath,$strip,\@srcpath);
  86             if (grep { $_ eq $dstfile } @{$self->{FILES}}) {
  87               my $orignode = $self->{NODEIDS}->{$self->filelabel($ARGV)};
  88               my $destnode = $self->{NODEIDS}->{$self->filelabel($dstfile)};
  89               if (defined $self->{IGNOREDDEPS}->{$ARGV}->{$dstfile}) {
  90                 print STDERR "ignoring $ARGV -> $dstfile\n" if $main::debug;
  91                 $self->{IGNOREDEDGES}->{$orignode}->{$destnode} =
  92                   $self->{IGNOREDDEPS}->{$ARGV}->{$dstfile};
  93               }
  94               push (@{$deps{$orignode}}, $destnode);
  95             } else {
  96                 print STDERR "ERROR: unknown file $dstfile referenced by $ARGV\n" if $main::verbose >= 2;
  97             }
  98         } elsif (m/^\s*#\s*include\s*<(.*)>/) {
  99                  print STDERR "Ignoring <$1> for now ($ARGV)\n" if $main::verbose >= 2;
 100              }
 101     }
 102     return \%deps;
 103 }
 104
 105 1;