lib/graphincludes/project.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;
   7 use strict;
   8 use warnings;
   9
  10 use graphincludes::params;
  11 our @ISA;
  12
  13 use graphincludes::graph;
  14
  15 use File::Spec::Functions qw(catfile catpath splitdir splitpath);
  16 use Hash::Util qw(lock_keys);
  17
  18 # set_language: class method that sets the language to be used when extracting deps.
  19 # This is a hack, which does not allow to mix several languages in a single project.
  20 # It is only a temporary measure that allows support for languages other than C/C++.
  21 our $_language;
  22 sub set_language {
  23   my $class = shift;
  24   $_language = shift;
  25   my $langmodule = "graphincludes::extractor::" . $_language;
  26   eval "require $langmodule" or die "cannot load $langmodule from " . join ':', @INC;
  27   push @ISA, $langmodule;
  28 }
  29
  30 sub new {
  31   my $class = shift;
  32   my %args = @_;
  33   my $prefixstrip = $args{prefixstrip};
  34   my @files = @{$args{files}};  # take a copy of @ARGV
  35   my $self = {};
  36
  37 #   if (defined $_language) {
  38 #     $self = ("graphincludes::extractor::" . $_language)->new;
  39 #   }
  40
  41   $self->{GRAPHS} = [ new graphincludes::graph ];       # stack of graphs for the different levels
  42   $self->{GRAPHS}[0]->init_nodes(\@files);
  43
  44   $self->{PFXSTRIP} = $prefixstrip;
  45   $self->{SPECIALEDGES} = {};
  46   $self->{IGNOREDEDGES} = {};   # to be computed in getdeps
  47   $self->{REPORT} = { HDR => {},
  48                       SYS => {},
  49                     };
  50
  51   bless ($self, $class);
  52   lock_keys (%$self);
  53
  54   return $self;
  55 }
  56
  57 sub init {
  58   my $self = shift;
  59
  60   $self->{GRAPHS}[0]{EDGES} = $self->getdeps($self->{GRAPHS}[0]{NODES});
  61
  62   $self->{GRAPHS}[1] = new graphincludes::graph;
  63   $self->{GRAPHS}[1]->init_nodes ($self->_level1nodes(@{$self->{GRAPHS}[0]{NODES}}));
  64
  65   # FIXME: level1 deps ?
  66 }
  67
  68 sub filelabel {
  69   my $self = shift;
  70   my ($file,$level) = @_;
  71
  72   return $file;
  73 }
  74
  75 # FIXME: should register link to lower-level
  76 sub _level1nodes {
  77   my $self = shift;
  78   my (@files) = @_;
  79   my (%nodes);
  80   foreach my $file (@files) {
  81     my $label = $self->filelabel($file);
  82     push @{$nodes{$label}}, $file;
  83   }
  84   return \%nodes;
  85 }
  86
  87 sub locatefile {
  88   my $self = shift;
  89   my ($dst, @path) = @_;
  90
  91   print STDERR "Trying to locate \`$dst'\n" if $graphincludes::params::debug;
  92
  93   sub fullpath {
  94     my ($dstpath, $strip, $srcpath) = @_;
  95     catfile (@$srcpath[0..($#$srcpath-$strip)], @$dstpath);
  96   }
  97
  98   (undef, my $dstdir, my $filename) = splitpath($dst);
  99   my @dstpath = (splitdir ($dstdir), $filename);
 100   # count number of leading "../" in the #include reference
 101   my $strip = 0;
 102   while ($dstpath[0] eq '..') {
 103     $strip++; shift @dstpath;
 104   }
 105   # find the file in @path
 106   my $dstfile;
 107   foreach my $dir (@path) {
 108     my @srcpath = splitdir ($dir);
 109     if (defined($dstfile = fullpath(\@dstpath,$strip,\@srcpath)) and
 110         grep { $_ eq $dstfile } @{$self->{GRAPHS}[0]{NODES}}) {
 111       print STDERR " Found from $dir ($dstfile)\n" if $graphincludes::params::debug;
 112       last;
 113     } else {
 114       print STDERR " Not from $dir ($dstfile)\n" if $graphincludes::params::debug;
 115       $dstfile = undef;
 116     }
 117   }
 118
 119   return $dstfile;              # can be undef !
 120 }
 121
 122 sub _fileexists {
 123   my ($file, @path) = @_;
 124   foreach my $dir (@path) {
 125     my $f = catpath('', $dir, $file);
 126     return $f if -r $f;
 127   }
 128   return undef;
 129 }
 130
 131 sub record_dep {
 132   my $self = shift;
 133   my ($deps, $src, $dst) = @_;
 134
 135   my $orignode = $self->filelabel($src);
 136   my $destnode = $self->filelabel($dst);
 137   if (defined $self->{IGNOREDDEPS}->{$src}->{$dst}) {
 138     print STDERR "ignoring $src -> $dst\n" if $graphincludes::params::debug;
 139     $self->{IGNOREDEDGES}->{$orignode}->{$destnode} =
 140       $self->{IGNOREDDEPS}->{$src}->{$dst};
 141   }
 142   if (defined $deps->{$orignode}->{$destnode}) {
 143     $deps->{$orignode}->{$destnode} ++;
 144   } else {
 145     $deps->{$orignode}->{$destnode} = 1;
 146   }
 147 }
 148
 149 sub record_missed_dep {
 150   my $self = shift;
 151   my ($src, $dst) = @_;
 152
 153   if (defined _fileexists ($dst, @graphincludes::params::sysinclpath)) {
 154     # list as system include
 155     $self->{REPORT}->{SYS}->{$dst} = 1;
 156   } else {
 157     # list as unknown header
 158     push @{$self->{REPORT}->{HDR}->{$dst}}, $src;
 159   }
 160 }
 161
 162 sub special_edge {
 163   my $self = shift;
 164   my ($src, $dst) = @_;
 165
 166   my $attrs = $self->{SPECIALEDGES}->{$src}->{$dst};
 167
 168   if (defined $attrs) {
 169     return $attrs;
 170   } else {
 171     return undef;
 172   }
 173 }
 174
 175 1;