lib/graphincludes/project/default.pm

   1 # This file is part of the DEPS/graph-includes package
   2 #
   3 # (c) 2005,2006 Yann Dirson <ydirson@altern.org>
   4 # Distributed under version 2 of the GNU GPL.
   5
   6 package graphincludes::project::default;
   7 use strict;
   8 use warnings;
   9
  10 use base qw(graphincludes::project);
  11 use Hash::Util qw(lock_keys unlock_keys);
  12 use File::Spec::Functions qw(splitpath);
  13
  14 use graphincludes::params;
  15
  16 sub new {
  17   my $class = shift;
  18   my $self;
  19
  20   $self  = $class->SUPER::new(@_);
  21
  22   unlock_keys(%$self);
  23   bless ($self, $class);
  24   $self->{IGNOREDDEPS} = $self->ignored_deps();
  25   lock_keys(%$self);
  26
  27   return $self;
  28 }
  29
  30 sub nlevels { return 2; }
  31 sub filelabel {
  32   my $self = shift;
  33   my ($file,$level) = @_;
  34   $level = $graphincludes::params::minshow unless defined $level;
  35
  36   $file =~ s/^$self->{PFXSTRIP}// if defined $self->{PFXSTRIP};
  37   if ($level == 0) {
  38     return $file;
  39   } elsif ($level == 1) {
  40     $file =~ s/\.[^.]*$//;
  41     return $file;
  42   } elsif ($level == 2) {
  43     (undef, my $dirname, my $filename) = splitpath($file);
  44     if ($dirname ne '') {
  45       return $dirname;
  46     } else {
  47       return '<' . $self->filelabel($file, $level - 1) . '>';
  48     }
  49   }
  50   return undef;
  51 }
  52
  53 sub defaultcolors {
  54   return ();
  55 }
  56
  57 sub ignored_deps {
  58   return {};
  59 }
  60
  61 sub special_edge {
  62   my $self = shift;
  63   my ($src, $dst) = @_;
  64
  65   my $lbl = $self->{IGNOREDEDGES}->{$src}->{$dst};
  66
  67   my $special = $self->SUPER::special_edge($src,$dst);
  68
  69   if (defined $lbl) {
  70     $special->{color} = 'gray';
  71     $special->{constraint} = 'false';
  72     $special->{label} = [ $lbl ];
  73   }
  74
  75   return $special;
  76 }
  77
  78 1;