libdeps-perl 0.13-1.1 / usr / share / perl5 / graphincludes / project.pm

# This file is part of the DEPS/graph-includes package
#
# (c) 2005,2006 Yann Dirson <ydirson@altern.org>
# Distributed under version 2 of the GNU GPL.

package graphincludes::project;
use strict;
use warnings;

use graphincludes::params;
our @ISA;

use graphincludes::graph;

use File::Spec::Functions qw(catfile catpath splitdir splitpath canonpath);
use Hash::Util qw(lock_keys);
use Carp qw(croak);

# set_language: class method that sets the language to be used when extracting deps.
# This is a hack, which does not allow to mix several languages in a single project.
# It is only a temporary measure that allows support for languages other than C/C++.
our $_language;
sub set_language {
  my $class = shift;
  $_language = shift;
  my $langmodule = "graphincludes::extractor::" . $_language;
  eval "require $langmodule" or die "cannot load $langmodule from " . join ':', @INC;
  push @ISA, $langmodule;
}

sub new {
  my $class = shift;
  my %args = @_;
  my $prefixstrip = $args{prefixstrip};
  my @files = map { canonpath($_) } @{$args{files}}; # take a (cleaned up) copy of @ARGV
  my $self = {};

#   if (defined $_language) {
#     $self = ("graphincludes::extractor::" . $_language)->new;
#   }

  $self->{TRANSGRAPH} = new graphincludes::graph; # graph of graph transformations
  my $graphnode = new DEPS::Node('files');
  $self->{TRANSGRAPH}->add_node($graphnode);
  $self->{ROOTGRAPH} = $graphnode->{DATA} = new graphincludes::graph; # the file dependency graph
  $self->{ROOTGRAPH}->set_nodes_from_names(\@files);

  $self->{PFXSTRIP} = $prefixstrip;
  $self->{SPECIALEDGES} = {};
  $self->{IGNOREDEDGES} = {};	# to be computed in getdeps
  $self->{REPORT} = { HDR => {},
		      SYS => {},
		    };

  bless ($self, $class);
  lock_keys (%$self);

  return $self;
}

sub init {
  my $self = shift;

  $self->getdeps($self->{ROOTGRAPH});
}

sub nlevels { return 0; }
sub filelabel {
  my $self = shift;
  my ($file,$level) = @_;

  return $file;
}

sub locatefile {
  my $self = shift;
  my ($dst, @path) = @_;

  print STDERR "Trying to locate \`$dst'\n" if $graphincludes::params::debug;

  sub fullpath {
    my ($dstpath, $strip, $srcpath) = @_;
    catfile (@$srcpath[0..($#$srcpath-$strip)], @$dstpath);
  }

  (undef, my $dstdir, my $filename) = splitpath($dst);
  my @dstpath = (splitdir ($dstdir), $filename);
  # count number of leading "../" in the #include reference
  my $strip = 0;
  while ($dstpath[0] eq '..') {
    $strip++; shift @dstpath;
  }
  # find the file in @path
  my $dstfile;
  foreach my $dir (@path) {
    my @srcpath = splitdir ($dir);
    if (defined($dstfile = canonpath(fullpath(\@dstpath,$strip,\@srcpath))) and
	grep { $_->{LABEL} eq $dstfile } $self->{ROOTGRAPH}->get_nodes) {
      print STDERR " Found from $dir ($dstfile)\n" if $graphincludes::params::debug;
      last;
    } else {
      print STDERR " Not from $dir ($dstfile)\n" if $graphincludes::params::debug;
      $dstfile = undef;
    }
  }

  return $dstfile;		# can be undef !
}

sub _fileexists {
  my ($file, @path) = @_;
  foreach my $dir (@path) {
    my $f = catpath('', $dir, $file);
    return $f if -r $f;
  }
  return undef;
}

sub record_missed_dep {
  my $self = shift;
  my ($src, $dst) = @_;

  if (defined _fileexists ($dst, @graphincludes::params::sysinclpath)) {
    # list as system include
    $self->{REPORT}->{SYS}->{$dst} = 1;
  } else {
    # list as unknown header
    push @{$self->{REPORT}->{HDR}->{$dst}}, $src;
  }
}

sub special_edge {
  my $self = shift;
  my ($src, $dst) = @_;

  my $attrs = $self->{SPECIALEDGES}->{$src}->{$dst};

  if (defined $attrs) {
    return $attrs;
  } else {
    return undef;
  }
}

sub apply_transform {
  my $self = shift;
  my ($transform, $args, $newname, @graphnames) = @_;

  # load the required transform package
  eval "require $transform" or die "cannot load '$transform': $@";

  # find graphs from graphnames
  my @parentnodes = map { $self->{TRANSGRAPH}->get_node_from_name($_)
			    or croak "no graph named '$_'" } @graphnames;
  my @graphs = map { $_->{DATA} } @parentnodes;

  # apply transform
  my $result;
  eval '$result = '.$transform.'::apply (graphs => \@graphs, %$args)' or croak "transform failed: $@";

  # record in project's transform graph
  my $node = new DEPS::Node($newname);
  $node->{DATA} = $result;
  $self->{TRANSGRAPH}->add_node($node);

  # record deps
  foreach my $parent (@parentnodes) {
    $self->{TRANSGRAPH}->add_edge (new DEPS::Edge($parent, $node));
  }

  return $result;
}

1;