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         my @srcpath = split (m|/|, $ARGV);
  77         if (m/^\s*#\s*include\s*"(.*)"/) {
  78             my @dstpath = split (m|/|, $1);
  79             my $strip = 1;
  80             while ($dstpath[0] eq '..') { $strip++; shift @dstpath; }
  81             while ($#srcpath >= $strip and
  82                    !defined $self->{NODEIDS}->{$self->filelabel(fullpath(\@dstpath,$strip,\@srcpath))})
  83             { $strip++; }
  84             my $dstfile = fullpath(\@dstpath,$strip,\@srcpath);
  85             if (grep { $_ eq $dstfile } @{$self->{FILES}}) {
  86               my $orignode = $self->{NODEIDS}->{$self->filelabel($ARGV)};
  87               my $destnode = $self->{NODEIDS}->{$self->filelabel($dstfile)};
  88               if (defined $self->{IGNOREDDEPS}->{$ARGV}->{$dstfile}) {
  89                 print STDERR "ignoring $ARGV -> $dstfile\n" if $main::debug;
  90                 $self->{IGNOREDEDGES}->{$orignode}->{$destnode} =
  91                   $self->{IGNOREDDEPS}->{$ARGV}->{$dstfile};
  92               }
  93               push (@{$deps{$orignode}}, $destnode);
  94             } else {
  95                 print STDERR "ERROR: unknown file $dstfile referenced by $ARGV\n" if $main::verbose >= 2;
  96             }
  97         } elsif (m/^\s*#\s*include\s*<(.*)>/) {
  98                  print STDERR "Ignoring <$1> for now ($ARGV)\n" if $main::verbose >= 2;
  99              }
 100     }
 101     return \%deps;
 102 }
 103
 104 1;