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

package DEPS::Transform::CompatGroup;

use warnings;
use strict;

use graphincludes::graph::grouped;
use Carp qw(croak);

sub apply {
  my %args = @_;

  # sanity checks
  if (!defined $args{graphs}
      or scalar @{$args{graphs}} != 1) {
    use Data::Dumper; print STDERR Dumper(keys %args);
    croak "graphincludes::transform::compatgroup applies to a single graph";
  }

  my $src = $args{graphs}[0];	# the low-level graph
  my $lvl = $args{level};
  my $prj = $args{labeller};
  my @prev = map { $prj->{TRANSGRAPH}->get_node_from_name($_)->{DATA}
		     or croak "no graph named '$_'" } @{$args{previous}};

  my $new = new graphincludes::graph::grouped;

  # for each low-level node:
  # - record the group, and the correct $lvl-1 group as ingredient
  # - record the groups for the llnode dependencies
  # - record dependencies between the groups, and the correct edge as ingredient
  # - record intra-node dependencies in groups
  foreach my $llnode ($src->get_nodes) {
    my $groupname = $prj->filelabel($llnode->{LABEL}, $lvl);
    next if !defined $groupname;

    my ($newnode, $newsubnode) = _register_node ($new, $llnode, $groupname, $lvl, $prj, \@prev);

    # find the immediate subedge
    foreach my $edge ($src->get_edges_from($llnode->{LABEL})) {
      my $newdepname = $prj->filelabel($edge->{DST}{LABEL}, $lvl);
      next if !defined $newdepname;

      my ($newdep, $newsubdep) = _register_node ($new, $edge->{DST}, $newdepname, $lvl, $prj, \@prev);

      # record the dep, as part of node if intra-group, or as edge ingredient
      my $subedge = $prev[$#prev]->get_edge($newsubnode->{LABEL}, $newsubdep->{LABEL});
      if ($newdep eq $newnode) {
	# the subedge is taken from level $lvl-1, and will not be found there if it was
	# aleady intra-node at that level, so skip it if we do not find it
	$new->register_intragroup_edge($newnode, $subedge)
	  if defined $subedge;
      } else {
	$new->record_edge($groupname, $newdepname)->add_ingredients($subedge);
      }
    }
  }

  return $new;
}

# Hack to get the dependency graph in corect shape.  Not to be
# mis-used: the compatgroup mechanism allows for inconsistencies if
# this fixup is used, when the filelabel function does not define a
# proper group hierarchy.
sub fixup_dep {
  my ($graph, $src, $dst, $orig) = @_;

  $graph->has_edge($orig, $dst) or croak "no dependency exists from $orig to $dst";

  $graph->drop_edge($orig, $dst);
  $graph->record_edge($src, $dst);
}

sub _register_node {
  my ($new, $node, $groupname, $lvl, $prj, $prev) = @_;

  # find the immediate subnode
  my ($subnode, $prevlevel);
  for ($prevlevel = $lvl - 1;
       $prevlevel >= 0 and
       !defined ($subnode = $prev->[$prevlevel]->
		 get_node_from_name($prj->filelabel($node->{LABEL}, $prevlevel)));
       --$prevlevel) {
  }

  # hack necessary because prefixstrip is applied to level 0 - we
  # would need another graph between 0 and 1 for this
  $subnode = $prev->[$prevlevel]->get_node_from_name($node->{LABEL}) unless defined $subnode;
  die "No ingredient node found for $groupname for $node->{LABEL}" unless defined $subnode;

  my $newnode = $new->record_node($groupname);
  $new->register_group_member($newnode, $subnode);
  return ($newnode->add_ingredients($subnode), $subnode);
}

1;
