libdeps-perl 0.13-1.1 / usr / share / perl5 / graphincludes / project / default.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::default;
use strict;
use warnings;

use base qw(graphincludes::project);
use Hash::Util qw(lock_keys unlock_keys);
use File::Spec::Functions qw(splitpath);

use graphincludes::params;

sub new {
  my $class = shift;
  my $self;

  $self  = $class->SUPER::new(@_);

  unlock_keys(%$self);
  bless ($self, $class);
  $self->{IGNOREDDEPS} = $self->ignored_deps();
  lock_keys(%$self);

  return $self;
}

sub nlevels { return 2; }
sub filelabel {
  my $self = shift;
  my ($file,$level) = @_;
  $level = $graphincludes::params::minshow unless defined $level;

  $file =~ s/^$self->{PFXSTRIP}// if defined $self->{PFXSTRIP};
  if ($level == 0) {
    return $file;
  } elsif ($level == 1) {
    $file =~ s/\.[^.]*$//;
    return $file;
  } elsif ($level == 2) {
    (undef, my $dirname, my $filename) = splitpath($file);
    if ($dirname ne '') {
      return $dirname;
    } else {
      return '<' . $self->filelabel($file, $level - 1) . '>';
    }
  }
  return undef;
}

sub defaultcolors {
  return ();
}

sub ignored_deps {
  return {};
}

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

  my $lbl = $self->{IGNOREDEDGES}->{$src}->{$dst};

  my $special = $self->SUPER::special_edge($src,$dst);

  if (defined $lbl) {
    $special->{color} = 'gray';
    $special->{constraint} = 'false';
    $special->{label} = [ $lbl ];
  }

  return $special;
}

1;