File Coverage

lib/Graph/Easy/Node.pm

Criterion	Covered	Total	%
statement	832	932	89.2
branch	465	568	81.8
condition	156	192	81.2
subroutine	74	77	96.1
pod	45	45	100.0
total	1572	1814	86.6

#############################################################################
# Represents one node in a Graph::Easy graph.
#
# (c) by Tels 2004-2008. Part of Graph::Easy.
#############################################################################

package Graph::Easy::Node;

$VERSION = '0.76';

use Graph::Easy::Base;
use Graph::Easy::Attributes;
@ISA = qw/Graph::Easy::Base/;

use Graph::Easy::Util qw(ord_values);

# to map "arrow-shape" to "arrowshape"
my $att_aliases;

use strict;
use warnings;
use constant isa_cell => 0;

sub _init
  {
  # Generic init routine, to be overridden in subclasses.
  my ($self,$args) = @_;

  $self->{name} = 'Node #' . $self->{id};

  $self->{att} = { };
  $self->{class} = 'node';		# default class

  foreach my $k (sort keys %$args)
    {
    if ($k !~ /^(label|name)\z/)
      {
      require Carp;
      Carp::confess ("Invalid argument '$k' passed to Graph::Easy::Node->new()");
      }
    $self->{$k} = $args->{$k} if $k eq 'name';
    $self->{att}->{$k} = $args->{$k} if $k eq 'label';
    }

  # These are undef (to save memory) until needed:
  #  $self->{children} = {};
  #  $self->{dx} = 0;		# relative to no other node
  #  $self->{dy} = 0;
  #  $self->{origin} = undef;	# parent node (for relative placement)
  #  $self->{group} = undef;
  #  $self->{parent} = $graph or $group;
  # Mark as not yet laid out:
  #  $self->{x} = 0;
  #  $self->{y} = 0;

  $self;
  }

my $merged_borders =
  {
    'dotteddashed' => 'dot-dash',
    'dasheddotted' => 'dot-dash',
    'double-dashdouble' => 'double',
    'doubledouble-dash' => 'double',
    'doublesolid' => 'double',
    'soliddouble' => 'double',
    'dotteddot-dash' => 'dot-dash',
    'dot-dashdotted' => 'dot-dash',
  };

sub _collapse_borders
  {
  # Given a right border from node one, and the left border of node two,
  # return what border we need to draw on node two:
  my ($self, $one, $two, $swapem) = @_;

  ($one,$two) = ($two,$one) if $swapem;

  $one = 'none' unless $one;
  $two = 'none' unless $two;

  # If the border of the left/top node is defined, we don't draw the
  # border of the right/bottom node.
  return 'none' if $one ne 'none' || $two ne 'none';

  # otherwise, we draw simple the right border
  $two;
  }

sub _merge_borders
  {
  my ($self, $one, $two) = @_;

  $one = 'none' unless $one;
  $two = 'none' unless $two;

  # "nonenone" => "none" or "dotteddotted" => "dotted"
  return $one if $one eq $two;

  # none + solid == solid + none == solid
  return $one if $two eq 'none';
  return $two if $one eq 'none';

  for my $b (qw/broad wide bold double solid/)
    {
    # the stronger one overrides the weaker one
    return $b if $one eq $b || $two eq $b;
    }

  my $both = $one . $two;
  return $merged_borders->{$both} if exists $merged_borders->{$both};

  # fallback
  $two;
  }

sub _border_to_draw
  {
  # Return the border style we need to draw, taking the shape (none) into
  # account
  my ($self, $shape) = @_;

  my $cache = $self->{cache};

  return $cache->{border_style} if defined $cache->{border_style};

  $shape = $self->{att}->{shape} unless defined $shape;
  $shape = $self->attribute('shape') unless defined $shape;

  $cache->{border_style} = $self->{att}->{borderstyle};
  $cache->{border_style} = $self->attribute('borderstyle') unless defined $cache->{border_style};
  $cache->{border_style} = 'none' if $shape =~ /^(none|invisible)\z/;
  $cache->{border_style};
  }

sub _border_styles
  {
  # Return the four border styles (right, bottom, left, top). This takes
  # into account the neighbouring nodes and their borders, so that on
  # ASCII output the borders can be properly collapsed.
  my ($self, $border, $collapse) = @_;

  my $cache = $self->{cache};

  # already computed values?
  return if defined $cache->{left_border};

  $cache->{left_border} = $border;
  $cache->{top_border} = $border;
  $cache->{right_border} = $border;
  $cache->{bottom_border} = $border;

  return unless $collapse;

#  print STDERR " border_styles: $self->{name} border=$border\n";

  my $EM = 14;
  my $border_width = Graph::Easy::_border_width_in_pixels($self,$EM);

  # convert overly broad borders to the correct style
  $border = 'bold' if $border_width > 2;
  $border = 'broad' if $border_width > $EM * 0.2 && $border_width < $EM * 0.75;
  $border = 'wide' if $border_width >= $EM * 0.75;

#  XXX TODO
#  handle different colors, too:
#  my $color = $self->color_attribute('bordercolor');

  # Draw border on A (left), and C (left):
  #
  #    +---+
  #  B | A | C
  #    +---+

  # Ditto, plus C's border:
  #
  #    +---+---+
  #  B | A | C |
  #    +---+---+
  #

  # If no left neighbour, draw border normally

  # XXX TODO: ->{parent} ?
  my $parent = $self->{parent} || $self->{graph};
  return unless ref $parent;

  my $cells = $parent->{cells};
  return unless ref $cells;

  my $x = $self->{x}; my $y = $self->{y};

  $x -= 1; my $left = $cells->{"$x,$y"};
  $x += 1; $y-= 1; my $top = $cells->{"$x,$y"};
  $x += 1; $y += 1; my $right = $cells->{"$x,$y"};
  $x -= 1; $y += 1; my $bottom = $cells->{"$x,$y"};

  # where to store the result
  my @where = ('left', 'top', 'right', 'bottom');
  # need to swap arguments to _collapse_borders()?
  my @swapem = (0, 0, 1, 1);

  for my $other ($left, $top, $right, $bottom)
    {
    my $side = shift @where;
    my $swap = shift @swapem;

    # see if we have a (visible) neighbour on the left side
    if (ref($other) &&
      !$other->isa('Graph::Easy::Edge') &&
      !$other->isa_cell() &&
      !$other->isa('Graph::Easy::Node::Empty'))
      {
      $other = $other->{node} if ref($other->{node});

#      print STDERR "$side node $other ", $other->_border_to_draw(), " vs. $border (swap $swap)\n";

      if ($other->attribute('shape') ne 'invisible')
        {
        # yes, so take its border style
        my $result;
        if ($swap)
	  {
          $result = $self->_merge_borders($other->_border_to_draw(), $border);
	  }
        else
	  {
	  $result = $self->_collapse_borders($border, $other->_border_to_draw());
	  }
        $cache->{$side . '_border'} = $result;

#	print STDERR "# result: $result\n";
        }
      }
    }
  }

sub _correct_size
  {
  # Correct {w} and {h} after parsing. This is a fallback in case
  # the output specific routines (_correct_site_ascii() etc) do
  # not exist.
  my $self = shift;

  return if defined $self->{w};

  my $shape = $self->attribute('shape');

  if ($shape eq 'point')
    {
    $self->{w} = 5;
    $self->{h} = 3;
    my $style = $self->attribute('pointstyle');
    my $shape = $self->attribute('pointshape');
    if ($style eq 'invisible' || $shape eq 'invisible')
      {
      $self->{w} = 0; $self->{h} = 0; return;
      }
    }
  elsif ($shape eq 'invisible')
    {
    $self->{w} = 3;
    $self->{h} = 3;
    }
  else
    {
    my ($w,$h) = $self->dimensions();
    $self->{h} = $h;
    $self->{w} = $w + 2;
    }

  my $border = $self->_border_to_draw($shape);

  $self->_border_styles($border, 'collapse');

#  print STDERR "# $self->{name} $self->{w} $self->{h} $shape\n";
#  use Data::Dumper; print Dumper($self->{cache});

  if ($shape !~ /^(invisible|point)/)
    {
    $self->{w} ++ if $self->{cache}->{right_border} ne 'none';
    $self->{w} ++ if $self->{cache}->{left_border} ne 'none';
    $self->{h} ++ if $self->{cache}->{top_border} ne 'none';
    $self->{h} ++ if $self->{cache}->{bottom_border} ne 'none';

    $self->{h} += 2 if $border eq 'none' && $shape !~ /^(invisible|point)/;
    }

  $self;
  }

sub _unplace
  {
  # free the cells this node occupies from $cells
  my ($self,$cells) = @_;

  my $x = $self->{x}; my $y = $self->{y};
  delete $cells->{"$x,$y"};
  $self->{x} = undef;
  $self->{y} = undef;
  $self->{cache} = {};

  $self->_calc_size() unless defined $self->{cx};

  if ($self->{cx} + $self->{cy} > 2)	# one of them > 1!
    {
    for my $ax (1..$self->{cx})
      {
      my $sx = $x + $ax - 1;
      for my $ay (1..$self->{cy})
        {
        my $sy = $y + $ay - 1;
        # free cell
        delete $cells->{"$sx,$sy"};
        }
      }
    } # end handling multi-celled node

  # unplace all edges leading to/from this node, too:
  for my $e (ord_values ( $self->{edges} ))
    {
    $e->_unplace($cells);
    }

  $self;
  }

sub _mark_as_placed
  {
  # for creating an action on the action stack we also need to recursively
  # mark all our children as already placed:
  my ($self) = @_;

  no warnings 'recursion';

  delete $self->{_todo};

  for my $child (ord_values ( $self->{children} ))
    {
    $child->_mark_as_placed();
    }
  $self;
  }

sub _place_children
  {
  # recursively place node and its children
  my ($self, $x, $y, $parent) = @_;

  no warnings 'recursion';

  return 0 unless $self->_check_place($x,$y,$parent);

  print STDERR "# placing children of $self->{name} based on $x,$y\n" if $self->{debug};

  for my $child (ord_values ( $self->{children} ))
    {
    # compute place of children (depending on whether we are multicelled or not)

    my $dx = $child->{dx} > 0 ? $self->{cx} - 1 : 0;
    my $dy = $child->{dy} > 0 ? $self->{cy} - 1 : 0;

    my $rc = $child->_place_children($x + $dx + $child->{dx},$y + $dy + $child->{dy},$parent);
    return $rc if $rc == 0;
    }
  $self->_place($x,$y,$parent);
  }

sub _place
  {
  # place this node at the requested position (without checking)
  my ($self, $x, $y, $parent) = @_;

  my $cells = $parent->{cells};
  $self->{x} = $x;
  $self->{y} = $y;
  $cells->{"$x,$y"} = $self;

  # store our position if we are the first node in that rank
  my $r = abs($self->{rank} || 0);
  my $what = $parent->{_rank_coord} || 'x';	# 'x' or 'y'
  $parent->{_rank_pos}->{ $r } = $self->{$what}
    unless defined $parent->{_rank_pos}->{ $r };

  # a multi-celled node will be stored like this:
  # [ node   ] [ filler ]
  # [ filler ] [ filler ]
  # [ filler ] [ filler ] etc.

#  $self->_calc_size() unless defined $self->{cx};

  if ($self->{cx} + $self->{cy} > 2)    # one of them > 1!
    {
    for my $ax (1..$self->{cx})
      {
      my $sx = $x + $ax - 1;
      for my $ay (1..$self->{cy})
        {
        next if $ax == 1 && $ay == 1;   # skip left-upper most cell
        my $sy = $y + $ay - 1;

        # We might even get away with creating only one filler cell
        # although then its "x" and "y" values would be "wrong".

        my $filler =
	  Graph::Easy::Node::Cell->new ( node => $self, x => $sx, y => $sy );
        $cells->{"$sx,$sy"} = $filler;
        }
      }
    } # end handling of multi-celled node

  $self->_update_boundaries($parent);

  1;					# did place us
  }

sub _check_place
  {
  # chack that a node can be placed at $x,$y (w/o checking its children)
  my ($self,$x,$y,$parent) = @_;

  my $cells = $parent->{cells};

  # node cannot be placed here
  return 0 if exists $cells->{"$x,$y"};

  $self->_calc_size() unless defined $self->{cx};

  if ($self->{cx} + $self->{cy} > 2)	# one of them > 1!
    {
    for my $ax (1..$self->{cx})
      {
      my $sx = $x + $ax - 1;
      for my $ay (1..$self->{cy})
        {
        my $sy = $y + $ay - 1;
        # node cannot be placed here
        return 0 if exists $cells->{"$sx,$sy"};
        }
      }
    }
  1;					# can place it here
  }

sub _do_place
  {
  # Tries to place the node at position ($x,$y) by checking that
  # $cells->{"$x,$y"} is still free. If the node belongs to a cluster,
  # checks all nodes of the cluster (and when all of them can be
  # placed simultaneously, does so).
  # Returns true if the operation succeeded, otherwise false.
  my ($self,$x,$y,$parent) = @_;

  my $cells = $parent->{cells};

  # inlined from _check() for speed reasons:

  # node cannot be placed here
  return 0 if exists $cells->{"$x,$y"};

  $self->_calc_size() unless defined $self->{cx};

  if ($self->{cx} + $self->{cy} > 2)	# one of them > 1!
    {
    for my $ax (1..$self->{cx})
      {
      my $sx = $x + $ax - 1;
      for my $ay (1..$self->{cy})
        {
        my $sy = $y + $ay - 1;
        # node cannot be placed here
        return 0 if exists $cells->{"$sx,$sy"};
        }
      }
    }

  my $children = 0;
  $children = scalar keys %{$self->{children}} if $self->{children};

  # relativ to another, or has children (relativ to us)
  if (defined $self->{origin} || $children > 0)
    {
    # The coordinates of the origin node. Because 'dx' and 'dy' give
    # our distance from the origin, we can compute the origin by doing
    # "$x - $dx"

    my $grandpa = $self; my $ox = 0; my $oy = 0;
    # Find our grandparent (e.g. the root of origin chain), and the distance
    # from $x,$y to it:
    ($grandpa,$ox,$oy) = $self->find_grandparent() if $self->{origin};

    # Traverse all children and check their places, place them if poss.
    # This will also place ourselves, because we are a grandchild of $grandpa
    return $grandpa->_place_children($x + $ox,$y + $oy,$parent);
    }

  # finally place this node at the requested position
  $self->_place($x,$y,$parent);
  }

#############################################################################

sub _wrapped_label
  {
  # returns the label wrapped automatically to use the least space
  my ($self, $label, $align, $wrap) = @_;

  return (@{$self->{cache}->{label}}) if $self->{cache}->{label};

  # XXX TODO: handle "paragraphs"
  $label =~ s/\\(n|r|l|c)/ /g;		# replace line splits by spaces

  # collapse multiple spaces
  $label =~ s/\s+/ /g;

  # find out where to wrap
  if ($wrap eq 'auto')
    {
    $wrap = int(sqrt(length($label)) * 1.4);
    }
  $wrap = 2 if $wrap < 2;

  # run through the text and insert linebreaks
  my $i = 0;
  my $line_len = 0;
  my $last_space = 0;
  my $last_hyphen = 0;
  my @lines;
  while ($i < length($label))
    {
    my $c = substr($label,$i,1);
    $last_space = $i if $c eq ' ';
    $last_hyphen = $i if $c eq '-';
    $line_len ++;
    if ($line_len >= $wrap && ($last_space != 0 || $last_hyphen != 0))
      {
#      print STDERR "# wrap at $line_len\n";

      my $w = $last_space; my $replace = '';
      if ($last_hyphen > $last_space)
	{
        $w = $last_hyphen; $replace = '-';
	}

#      print STDERR "# wrap at $w\n";

      # "foo bar-baz" => "foo bar" (lines[0]) and "baz" (label afterwards)

#      print STDERR "# first part '". substr($label, 0, $w) . "'\n";

      push @lines, substr($label, 0, $w) . $replace;
      substr($label, 0, $w+1) = '';
      # reset counters
      $line_len = 0;
      $i = 0;
      $last_space = 0;
      $last_hyphen = 0;
      next;
      }
    $i++;
    }
  # handle what is left over
  push @lines, $label if $label ne '';

  # generate the align array
  my @aligns;
  my $al = substr($align,0,1);
  for my $i (0.. scalar @lines)
    {
    push @aligns, $al;
    }
  # cache the result to avoid costly recomputation
  $self->{cache}->{label} = [ \@lines, \@aligns ];
  (\@lines, \@aligns);
  }

sub _aligned_label
  {
  # returns the label lines and for each one the alignment l/r/c
  my ($self, $align, $wrap) = @_;

  $align = 'center' unless $align;
  $wrap = $self->attribute('textwrap') unless defined $wrap;

  my $name = $self->label();

  return $self->_wrapped_label($name,$align,$wrap) unless $wrap eq 'none';

  my (@lines,@aligns);
  my $al = substr($align,0,1);
  my $last_align = $al;

  # split up each line from the front
  while ($name ne '')
    {
    $name =~ s/^(.*?([^\\]|))(\z|\\(n|r|l|c))//;
    my $part = $1;
    my $a = $3 || '\n';

    $part =~ s/\\\|/\|/g;		# \| => |
    $part =~ s/\\\\/\\/g;		# '\\' to '\'
    $part =~ s/^\s+//;			# remove spaces at front
    $part =~ s/\s+\z//;			# remove spaces at end
    $a =~ s/\\//;			# \n => n
    $a = $al if $a eq 'n';

    push @lines, $part;
    push @aligns, $last_align;

    $last_align = $a;
    }

  # XXX TODO: should remove empty lines at start/end?
  (\@lines, \@aligns);
  }

#############################################################################
# as_html conversion and helper functions related to that

my $remap = {
  node => {
    align => undef,
    background => undef,
    basename => undef,
    border => undef,
    borderstyle => undef,
    borderwidth => undef,
    bordercolor => undef,
    columns => undef,
    fill => 'background',
    origin => undef,
    offset => undef,
    pointstyle => undef,
    pointshape => undef,
    rows => undef,
    size => undef,
    shape => undef,
    },
  edge => {
    fill => undef,
    border => undef,
    },
  all => {
    align => 'text-align',
    autolink => undef,
    autotitle => undef,
    comment => undef,
    fontsize => undef,
    font => 'font-family',
    flow => undef,
    format => undef,
    label => undef,
    link => undef,
    linkbase => undef,
    style => undef,
    textstyle => undef,
    title => undef,
    textwrap => \&Graph::Easy::_remap_text_wrap,
    group => undef,
    },
  };

sub _extra_params
  {
  # return text with a leading " ", that will be appended to "td" when
  # generating HTML
  '';
  }

# XXX TODO: ?
my $pod = {
  B => [ '', '' ],
  O => [ '', '' ],
  S => [ '', '' ],
  U => [ '', '' ],
  C => [ '', '' ],
  I => [ '', '' ],
  };

sub _convert_pod
  {
  my ($self, $type, $text) = @_;

  my $t = $pod->{$type} or return $text;

  # "" . "text" . ""
  $t->[0] . $text . $t->[1];
  }

sub _label_as_html
  {
  # Build the text from the lines, by inserting  for each break
  # Also align each line, and if nec., convert B to bold.
  my ($self) = @_;

  my $align = $self->attribute('align');
  my $text_wrap = $self->attribute('textwrap');

  my ($lines,$aligns);
  if ($text_wrap eq 'auto')
    {
    # set "white-space: nowrap;" in CSS and ignore linebreaks in label
    $lines = [ $self->label() ];
    $aligns = [ substr($align,0,1) ];
    }
  else
    {
    ($lines,$aligns) = $self->_aligned_label($align,$text_wrap);
    }

  # Since there is no "float: center;" in CSS, we must set the general
  # text-align to center when we encounter any \c and the default is
  # left or right:

  my $switch_to_center = 0;
  if ($align ne 'center')
    {
    local $_;
    $switch_to_center = grep /^c/, @$aligns;
    }

  $align = 'center' if $switch_to_center;
  my $a = substr($align,0,1);			# center => c

  my $format = $self->attribute('format');

  my $name = '';
  my $i = 0;
  while ($i < @$lines)
    {
    my $line = $lines->[$i];
    my $al = $aligns->[$i];

    # This code below will not handle B due to the
    # line break. Also, nesting does not work due to returned "<" and ">".

    if ($format eq 'pod')
      {
      # first inner-most, then go outer until there are none left
      $line =~ s/([BOSUCI])<([^<>]+)>/ $self->_convert_pod($1,$2);/eg
        while ($line =~ /[BOSUCI]<[^<>]+>/)
      }
    else
      {
      $line =~ s/&/&/g;			# quote &
      $line =~ s/>/>/g;			# quote >
      $line =~ s/
      $line =~ s/\\\\/\\/g;			# "\\" to "\"
      }

    # insert a span to align the line unless the default already covers it
    $line = '' . $line . ''
      if $a ne $al;
    $name .= '' . $line;

    $i++;					# next line
    }
  $name =~ s/^//;				# remove first

  ($name, $switch_to_center);
  }

sub quoted_comment
  {
  # Comment of this object, quoted suitable as to be embedded into HTML/SVG
  my $self = shift;

  my $cmt = $self->attribute('comment');
  if ($cmt ne '')
    {
    $cmt =~ s/&/&/g;
    $cmt =~ s/
    $cmt =~ s/>/>/g;
    $cmt = '\n";
    }

  $cmt;
  }

sub as_html
  {
  # return node as HTML
  my ($self) = @_;

  my $shape = 'rect';
  $shape = $self->attribute('shape') unless $self->isa_cell();

  if ($shape eq 'edge')
    {
    my $edge = Graph::Easy::Edge->new();
    my $cell = Graph::Easy::Edge::Cell->new( edge => $edge );
    $cell->{w} = $self->{w};
    $cell->{h} = $self->{h};
    $cell->{att}->{label} = $self->label();
    $cell->{type} =
     Graph::Easy::Edge::Cell->EDGE_HOR +
     Graph::Easy::Edge::Cell->EDGE_LABEL_CELL;
    return $cell->as_html();
    }

  my $extra = $self->_extra_params();
  my $taga = "td$extra";
  my $tagb = 'td';

  my $id = $self->{graph}->{id};
  my $a = $self->{att};
  my $g = $self->{graph};

  my $class = $self->class();

  # how many rows/columns will this node span?
  my $rs = ($self->{cy} || 1) * 4;
  my $cs = ($self->{cx} || 1) * 4;

  # shape: invisible; must result in an empty cell
  if ($shape eq 'invisible' && $class ne 'node.anon')
    {
    return " <$taga colspan=$cs rowspan=$rs style=\"border: none; background: inherit;\">\n";
    }

  my $c = $class; $c =~ s/\./_/g;	# node.city => node_city

  my $html = " <$taga colspan=$cs rowspan=$rs##class####style##";

  my $title = $self->title();
  $title =~ s/'//g;			# replace quotation marks

  $html .= " title='$title'" if $title ne '' && $shape ne 'img';	# add mouse-over title

  my ($name, $switch_to_center);

  if ($shape eq 'point')
    {
    require Graph::Easy::As_ascii;		# for _u8 and point-style

    local $self->{graph}->{_ascii_style} = 1;	# use utf-8
    $name = $self->_point_style( $self->attribute('pointshape'), $self->attribute('pointstyle') );
    }
  elsif ($shape eq 'img')
    {
    # take the label as the URL, but escape critical characters
    $name = $self->label();
    $name =~ s/\s/\+/g;				# space
    $name =~ s/'/%27/g;				# replace quotation marks
    $name =~ s/[\x0d\x0a]//g;			# remove 0x0d0x0a and similar
    my $t = $title; $t = $name if $t eq '';
    $name = "";
    }
  else
    {
    ($name,$switch_to_center) = $self->_label_as_html();
    }

  # if the label is "", the link wouldn't be clickable
  my $link = ''; $link = $self->link() unless $name eq '';

  # the attributes in $out will be applied to either the TD, or the inner DIV,
  # unless if we have a link, then most of them will be moved to the A HREF
  my $att = $self->raw_attributes();
  my $out = $self->{graph}->_remap_attributes( $self, $att, $remap, 'noquote', 'encode', 'remap_colors');

  $out->{'text-align'} = 'center' if $switch_to_center;

  # only for nodes, not for edges
  if (!$self->isa('Graph::Easy::Edge'))
    {
    my $bc = $self->attribute('bordercolor');
    my $bw = $self->attribute('borderwidth');
    my $bs = $self->attribute('borderstyle');

    $out->{border} = Graph::Easy::_border_attribute_as_html( $bs, $bw, $bc );

    # we need to specify the border again for the inner div
    if ($shape !~ /(rounded|ellipse|circle)/)
      {
      my $DEF = $self->default_attribute('border');

      delete $out->{border} if $out->{border} =~ /^\s*\z/ || $out->{border} eq $DEF;
      }

    delete $out->{border} if $class eq 'node.anon' && $out->{border} && $out->{border} eq 'none';
    }

  # we compose the inner part as $inner_start . $label . $inner_end:
  my $inner_start = '';
  my $inner_end = '';

  if ($shape =~ /(rounded|ellipse|circle)/)
    {
    # set the fill on the inner part, but the background and no border on the
    my $inner_style = '';
    my $fill = $self->color_attribute('fill');
    $inner_style = 'background:' . $fill if $fill;
    $inner_style .= ';border:' . $out->{border} if $out->{border};
    $inner_style =~ s/;\s?\z$//;				# remove '; ' at end

    delete $out->{background};
    delete $out->{border};

    my $td_style = '';
    $td_style = ' style="border: none;';
    my $bg = $self->color_attribute('background');
    $td_style .= "background: $bg\"";

    $html =~ s/##style##/$td_style/;

    $inner_end = '';
    my $c = substr($shape, 0, 1); $c = 'c' if $c eq 'e';	# 'r' or 'c'

    my ($w,$h) = $self->dimensions();

    if ($shape eq 'circle')
      {
      # set both to the biggest size to enforce a circle shape
      my $r = $w;
      $r = $h if $h > $w;
      $w = $r; $h = $r;
      }

    $out->{top} = ($h / 2 + 0.5) . 'em'; delete $out->{top} if $out->{top} eq '1.5em';
    $h = ($h + 2) . 'em';
    $w = ($w + 2) . 'em';

    $inner_style .= ";width: $w; height: $h";

    $inner_style = " style='$inner_style'";
    $inner_start = "";
    }

  if ($class =~ /^group/)
    {
    delete $out->{border};
    delete $out->{background};
    my $group_class = $class; $group_class =~ s/\s.*//;		# "group gt" => "group"
    my @atr = qw/bordercolor borderwidth fill/;

    # transform "group_foo gr" to "group_foo" if border eq 'none' (for anon groups)
    my $border_style = $self->attribute('borderstyle');
    $c =~ s/\s+.*// if $border_style eq 'none';

    # only need the color for the label cell
    push @atr, 'color' if $self->{has_label};
    $name = ' ' unless $self->{has_label};
    for my $b (@atr)
      {
      my $def = $g->attribute($group_class,$b);
      my $v = $self->attribute($b);

      my $n = $b; $n = 'background' if $b eq 'fill';
      $out->{$n} = $v unless $v eq '' || $v eq $def;
      }
    $name = ' ' unless $name ne '';
    }

  # "shape: none;" or point means no border, and background instead fill color
  if ($shape =~ /^(point|none)\z/)
    {
    $out->{background} = $self->color_attribute('background');
    $out->{border} = 'none';
    }

  my $style = '';
  for my $atr (sort keys %$out)
    {
    if ($link ne '')
      {
      # put certain styles on the outer container, and not on the link
      next if $atr =~ /^(background|border)\z/;
      }
    $style .= "$atr: $out->{$atr}; ";
    }

  # bold, italic, underline etc. (but not for empty cells)
  $style .= $self->text_styles_as_css(1,1) if $name !~ /^(| )\z/;

  $style =~ s/;\s?\z$//;			# remove '; ' at end
  $style =~ s/\s+/ /g;				# '  ' => ' '
  $style =~ s/^\s+//;				# remove ' ' at front
  $style = " style=\"$style\"" if $style;

  my $end_tag = "\n";

  if ($link ne '')
    {
    # encode critical entities
    $link =~ s/\s/\+/g;				# space
    $link =~ s/'/%27/g;				# replace quotation marks

    my $outer_style = '';
    # put certain styles like border and background on the table cell:
    for my $s (qw/background border/)
      {
      $outer_style .= "$s: $out->{$s};" if exists $out->{$s};
      }
    $outer_style =~ s/;\s?\z$//;			# remove '; ' at end
    $outer_style = ' style="'.$outer_style.'"' if $outer_style;

    $inner_start =~ s/##style##/$outer_style/;	# remove from inner_start

    $html =~ s/##style##/$outer_style/;			# or HTML, depending
    $inner_start .= "";	# and put on link
    $inner_end = ''.$inner_end;
    }

  $c = " class='$c'" if $c ne '';
  $html .= ">$inner_start$name$inner_end$end_tag";
  $html =~ s/##class##/$c/;
  $html =~ s/##style##/$style/;

  $self->quoted_comment() . $html;
  }

sub angle
  {
  # return the rotation of the node, dependend on the rotate attribute
  # (and if relative, on the flow)
  my $self = shift;

  my $angle = $self->{att}->{rotate} || 0;

  $angle = 180 if $angle =~ /^(south|down)\z/;
  $angle = 0 if $angle =~ /^(north|up)\z/;
  $angle = 270 if $angle eq 'west';
  $angle = 90 if $angle eq 'east';

  # convert relative angles
  if ($angle =~ /^([+-]\d+|left|right|back|front|forward)\z/)
    {
    my $base_rot = $self->flow();
    $angle = 0 if $angle =~ /^(front|forward)\z/;
    $angle = 180 if $angle eq 'back';
    $angle = -90 if $angle eq 'left';
    $angle = 90 if $angle eq 'right';
    $angle = $base_rot + $angle + 0;	# 0 points up, so front points right
    $angle += 360 while $angle < 0;
    }

  $self->_croak("Illegal node angle $angle") if $angle !~ /^\d+\z/;

  $angle %= 360 if $angle > 359;

  $angle;
  }

# for determining the absolute parent flow
my $p_flow =
  {
  'east' => 90,
  'west' => 270,
  'north' => 0,
  'south' => 180,
  'up' => 0,
  'down' => 180,
  'back' => 270,
  'left' => 270,
  'right' => 90,
  'front' => 90,
  'forward' => 90,
  };

sub _parent_flow_absolute
  {
  # make parent flow absolute
  my ($self, $def)  = @_;

  return '90' if ref($self) eq 'Graph::Easy';

  my $flow = $self->parent()->raw_attribute('flow') || $def;

  return unless defined $flow;

  # in case of relative flow at parent, convert to absolute (right: east, left: west etc)
  # so that "graph { flow: left; }" results in a westward flow
  my $f = $p_flow->{$flow}; $f = $flow unless defined $f;
  $f;
  }

sub flow
  {
  # Calculate the outgoing flow from the incoming flow and the flow at this
  # node (either from edge(s) or general flow). Returns an absolute flow:
  # See the online manual about flow for a reference and details.
  my $self = shift;

  no warnings 'recursion';

  my $cache = $self->{cache};
  return $cache->{flow} if exists $cache->{flow};

  # detected cycle, so break it
  return $cache->{flow} = $self->_parent_flow_absolute('90') if exists $self->{_flow};

  local $self->{_flow} = undef;		# endless loops really ruin our day

  my $in;
  my $flow = $self->{att}->{flow};

  $flow = $self->_parent_flow_absolute() if !defined $flow || $flow eq 'inherit';

  # if flow is absolute, return it early
  return $cache->{flow} = $flow if defined $flow && $flow =~ /^(0|90|180|270)\z/;
  return $cache->{flow} = Graph::Easy->_direction_as_number($flow)
    if defined $flow && $flow =~ /^(south|north|east|west|up|down)\z/;

  # for relative flows, compute the incoming flow as base flow

  # check all edges
  for my $e (ord_values ( $self->{edges} ))
    {
    # only count incoming edges
    next unless $e->{from} != $self && $e->{to} == $self;

    # if incoming edge has flow, we take this
    $in = $e->flow();
    # take the first match
    last if defined $in;
    }

  if (!defined $in)
    {
    # check all predecessors
    for my $e (ord_values ( $self->{edges} ))
      {
      my $pre = $e->{from};
      $pre = $e->{to} if $e->{bidirectional};
      if ($pre != $self)
        {
        $in = $pre->flow();
        # take the first match
        last if defined $in;
        }
      }
    }

  $in = $self->_parent_flow_absolute('90') unless defined $in;

  $flow = Graph::Easy->_direction_as_number($in) unless defined $flow;

  $cache->{flow} = Graph::Easy->_flow_as_direction($in,$flow);
  }

#############################################################################
# multi-celled nodes

sub _calc_size
  {
  # Calculate the base size in cells from the attributes (before grow())
  # Will return a hash that denotes in which direction the node should grow.
  my $self = shift;

  # If specified only one of "rows" or "columns", then grow the node
  # only in the unspecified direction. Default is grow both.
  my $grow_sides = { cx => 1, cy => 1 };

  my $r = $self->{att}->{rows};
  my $c = $self->{att}->{columns};
  delete $grow_sides->{cy} if defined $r && !defined $c;
  delete $grow_sides->{cx} if defined $c && !defined $r;

  $r = $self->attribute('rows') unless defined $r;
  $c = $self->attribute('columns') unless defined $c;

  $self->{cy} = abs($r || 1);
  $self->{cx} = abs($c || 1);

  $grow_sides;
  }

sub _grow
  {
  # Grows the node until it has sufficient cells for all incoming/outgoing
  # edges. The initial size will be based upon the attributes 'size' (or
  # 'rows' or 'columns', depending on which is set)
  my $self = shift;

  # XXX TODO: grow the node based on its label dimensions
#  my ($w,$h) = $self->dimensions();
#
#  my $cx = int(($w+2) / 5) || 1;
#  my $cy = int(($h) / 3) || 1;
#
#  $self->{cx} = $cx if $cx > $self->{cx};
#  $self->{cy} = $cy if $cy > $self->{cy};

  # satisfy the edge start/end port constraints:

  # We calculate a bitmap (vector) for each side, and mark each
  # used port. Edges that have an unspecified port will just be
  # counted.

  # bitmap for each side:
  my $vec = { north => '', south => '', east => '', west => '' };
  # number of edges constrained to one side, but without port number
  my $cnt = { north => 0, south => 0, east => 0, west => 0 };
  # number of edges constrained to one side, with port number
  my $portnr = { north => 0, south => 0, east => 0, west => 0 };
  # max number of ports for each side
  my $max = { north => 0, south => 0, east => 0, west => 0 };

  my @idx = ( [ 'start', 'from' ], [ 'end', 'to' ] );
  # number of slots we need to edges without port restrictions
  my $unspecified = 0;

  # count of outgoing edges
  my $outgoing = 0;

  for my $e (ord_values ( $self->{edges} ))
    {
    # count outgoing edges
    $outgoing++ if $e->{from} == $self;

    # do always both ends, because self-loops can start AND end at this node:
    for my $end (0..1)
      {
      # if the edge starts/ends here
      if ($e->{$idx[$end]->[1]} == $self)		# from/to
	{
	my ($side, $nr) = $e->port($idx[$end]->[0]);	# start/end

	if (defined $side)
	  {
	  if (!defined $nr || $nr eq '')
	    {
	    # no port number specified, so just count
	    $cnt->{$side}++;
	    }
	  else
	    {
	    # mark the bit in the vector
	    # limit to four digits
	    $nr = 9999 if abs($nr) > 9999;

	    # if slot was not used yet, count it
	    $portnr->{$side} ++ if vec($vec->{$side}, $nr, 1) == 0x0;

	    # calculate max number of ports
            $nr = abs($nr) - 1 if $nr < 0;		# 3 => 3, -3 => 2
            $nr++;					# 3 => 4, -3 => 3

	    # mark as used
	    vec($vec->{$side}, $nr - 1, 1) = 0x01;

	    $max->{$side} = $nr if $nr > $max->{$side};
	    }
          }
        else
          {
          $unspecified ++;
          }
        } # end if port is constrained
      } # end for start/end port
    } # end for all edges

  for my $e (ord_values ( $self->{edges} ))
    {
    # the loop above will count all self-loops twice when they are
    # unrestricted. So subtract these again. Restricted self-loops
    # might start at one port and end at another, and this case is
    # covered correctly by the code above.
    $unspecified -- if $e->{to} == $e->{from};
    }

  # Shortcut, if the number of edges is < 4 and we have not restrictions,
  # then a 1x1 node suffices
  if ($unspecified < 4 && ($unspecified == keys %{$self->{edges}}))
    {
    $self->_calc_size();
    return $self;
    }

  my $need = {};
  my $free = {};
  for my $side (qw/north south east west/)
    {
    # maximum number of ports we need to reserve, minus edges constrained
    # to unique ports: free ports on that side
    $free->{$side} = $max->{$side} - $portnr->{$side};
    $need->{$side} = $max->{$side};
    if ($free->{$side} < 2 * $cnt->{$side})
      {
      $need->{$side} += 2 * $cnt->{$side} - $free->{$side} - 1;
      }
    }
  # now $need contains for each side the absolute min. number of ports we need

#  use Data::Dumper;
#  print STDERR "# port contraints for $self->{name}:\n";
#  print STDERR "# count: ", Dumper($cnt), "# max: ", Dumper($max),"\n";
#  print STDERR "# ports: ", Dumper($portnr),"\n";
#  print STDERR "# need : ", Dumper($need),"\n";
#  print STDERR "# free : ", Dumper($free),"\n";

  # calculate min. size in X and Y direction
  my $min_x = $need->{north}; $min_x = $need->{south} if $need->{south} > $min_x;
  my $min_y = $need->{west}; $min_y = $need->{east} if $need->{east} > $min_y;

  my $grow_sides = $self->_calc_size();

  # increase the size if the minimum required size is not met
  $self->{cx} = $min_x if $min_x > $self->{cx};
  $self->{cy} = $min_y if $min_y > $self->{cy};

  my $flow = $self->flow();

  # if this is a sink node, grow it more by ignoring free ports on the front side
  my $front_side = 'east';
  $front_side = 'west' if $flow == 270;
  $front_side = 'south' if $flow == 180;
  $front_side = 'north' if $flow == 0;

  # now grow the node based on the general flow first VER, then HOR
  my $grow = 0;					# index into @grow_what
  my @grow_what = sort keys %$grow_sides;	# 'cx', 'cy' or 'cx' or 'cy'

  if (keys %$grow_sides > 1)
    {
    # for left/right flow, swap the growing around
    @grow_what = ( 'cy', 'cx' ) if $flow == 90 || $flow == 270;
    }

  # fake a non-sink node for nodes with an offset/children
  $outgoing = 1 if ref($self->{origin}) || keys %{$self->{children}} > 0;

  while ( 3 < 5 )
    {
    # calculate whether we already found a space for all edges
    my $free_ports = 0;
    for my $side (qw/north south/)
      {
      # if this is a sink node, grow it more by ignoring free ports on the front side
      next if $outgoing == 0 && $front_side eq $side;
      $free_ports += 1 + int(($self->{cx} - $cnt->{$side} - $portnr->{$side}) / 2);
      }
    for my $side (qw/east west/)
      {
      # if this is a sink node, grow it more by ignoring free ports on the front side
      next if $outgoing == 0 && $front_side eq $side;
      $free_ports += 1 + int(($self->{cy} - $cnt->{$side} - $portnr->{$side}) / 2);
      }
    last if $free_ports >= $unspecified;

    $self->{ $grow_what[$grow] } += 2;

    $grow ++; $grow = 0 if $grow >= @grow_what;
    }

  $self;
  }

sub is_multicelled
  {
  # return true if node consist of more than one cell
  my $self = shift;

  $self->_calc_size() unless defined $self->{cx};

  $self->{cx} + $self->{cy} <=> 2;	# 1 + 1 == 2: no, cx + xy != 2: yes
  }

sub is_anon
  {
  # normal nodes are not anon nodes (but "::Anon" are)
  0;
  }

#############################################################################
# accessor methods

sub _un_escape
  {
  # replace \N, \G, \T, \H and \E (depending on type)
  # if $label is false, also replace \L with the label
  my ($self, $txt, $do_label) = @_;

  # for edges:
  if (exists $self->{edge})
    {
    my $e = $self->{edge};
    $txt =~ s/\\E/$e->{from}->{name}\->$e->{to}->{name}/g;
    $txt =~ s/\\T/$e->{from}->{name}/g;
    $txt =~ s/\\H/$e->{to}->{name}/g;
    # \N for edges is the label of the edge
    if ($txt =~ /\\N/)
      {
      my $l = $self->label();
      $txt =~ s/\\N/$l/g;
      }
    }
  else
    {
    # \N for nodes
    $txt =~ s/\\N/$self->{name}/g;
    }
  # \L with the label
  if ($txt =~ /\\L/ && $do_label)
    {
    my $l = $self->label();
    $txt =~ s/\\L/$l/g;
    }

  # \G for edges and nodes
  if ($txt =~ /\\G/)
    {
    my $g = '';
    # the graph itself
    $g = $self->attribute('title') unless ref($self->{graph});
    # any nodes/edges/groups in it
    $g = $self->{graph}->label() if ref($self->{graph});
    $txt =~ s/\\G/$g/g;
    }
  $txt;
  }

sub title
  {
  # Returns a title of the node (or '', if none was set), which can be
  # used for mouse-over titles

  my $self = shift;

  my $title = $self->attribute('title');
  if ($title eq '')
    {
    my $autotitle = $self->attribute('autotitle');
    if (defined $autotitle)
      {
      $title = '';					# default is none

      if ($autotitle eq 'name')				# use name
	{
        $title = $self->{name};
	# edges do not have a name and fall back on their label
        $title = $self->{att}->{label} unless defined $title;
	}

      if ($autotitle eq 'label')
        {
        $title = $self->{name};				# fallback to name
        # defined to avoid overriding "name" with the non-existent label attribute
	# do not use label() here, but the "raw" label of the edge:
        my $label = $self->label(); $title = $label if defined $label;
        }

      $title = $self->link() if $autotitle eq 'link';
      }
    $title = '' unless defined $title;
    }

  $title = $self->_un_escape($title, 1) if !$_[0] && $title =~ /\\[EGHNTL]/;

  $title;
  }

sub background
  {
  # get the background for this group/edge cell, honouring group membership.
  my $self = shift;

  $self->color_attribute('background');
  }

sub label
  {
  my $self = shift;

  # shortcut to speed it up a bit:
  my $label = $self->{att}->{label};
  $label = $self->attribute('label') unless defined $label;

  # for autosplit nodes, use their auto-label first (unless already got
  # a label from the class):
  $label = $self->{autosplit_label} unless defined $label;
  $label = $self->{name} unless defined $label;

  return '' unless defined $label;

  if ($label ne '')
    {
    my $len = $self->attribute('autolabel');
    if ($len ne '')
      {
      # allow the old format (pre v0.49), too: "name,12" => 12
      $len =~ s/^name\s*,\s*//;
      # restrict to sane values
      $len = abs($len || 0); $len = 99999 if $len > 99999;
      if (length($label) > $len)
        {
        my $g = $self->{graph} || {};
	if ((($g->{_ascii_style}) || 0) == 0)
	  {
	  # ASCII output
	  $len = int($len / 2) - 3; $len = 0 if $len < 0;
	  $label = substr($label, 0, $len) . ' ... ' . substr($label, -$len, $len);
	  }
	else
	  {
	  $len = int($len / 2) - 2; $len = 0 if $len < 0;
	  $label = substr($label, 0, $len) . ' … ' . substr($label, -$len, $len);
	  }
        }
      }
    }

  $label = $self->_un_escape($label) if !$_[0] && $label =~ /\\[EGHNT]/;

  $label;
  }

sub name
  {
  my $self = shift;

  $self->{name};
  }

sub x
  {
  my $self = shift;

  $self->{x};
  }

sub y
  {
  my $self = shift;

  $self->{y};
  }

sub width
  {
  my $self = shift;

  $self->{w};
  }

sub height
  {
  my $self = shift;

  $self->{h};
  }

sub origin
  {
  # Returns node that this node is relative to or undef, if not.
  my $self = shift;

  $self->{origin};
  }

sub pos
  {
  my $self = shift;

  ($self->{x} || 0, $self->{y} || 0);
  }

sub offset
  {
  my $self = shift;

  ($self->{dx} || 0, $self->{dy} || 0);
  }

sub columns
  {
  my $self = shift;

  $self->_calc_size() unless defined $self->{cx};

  $self->{cx};
  }

sub rows
  {
  my $self = shift;

  $self->_calc_size() unless defined $self->{cy};

  $self->{cy};
  }

sub size
  {
  my $self = shift;

  $self->_calc_size() unless defined $self->{cx};

  ($self->{cx}, $self->{cy});
  }

sub shape
  {
  my $self = shift;

  my $shape;
  $shape = $self->{att}->{shape} if exists $self->{att}->{shape};
  $shape = $self->attribute('shape') unless defined $shape;
  $shape;
  }

sub dimensions
  {
  # Returns the minimum dimensions of the node/cell derived from the
  # label or name, in characters.
  my $self = shift;

  my $align = $self->attribute('align');
  my ($lines,$aligns) = $self->_aligned_label($align);

  my $w = 0; my $h = scalar @$lines;
  foreach my $line (@$lines)
    {
    $w = length($line) if length($line) > $w;
    }
  ($w,$h);
  }

#############################################################################
# edges and connections

sub edges_to
  {
  # Return all the edge objects that start at this vertex and go to $other.
  my ($self, $other) = @_;

  # no graph, no dice
  return unless ref $self->{graph};

  my @edges;
  for my $edge (ord_values ( $self->{edges} ))
    {
    push @edges, $edge if $edge->{from} == $self && $edge->{to} == $other;
    }
  @edges;
  }

sub edges_at_port
  {
  # return all edges that share the same given port
  my ($self, $attr, $side, $port) = @_;

  # Must be "start" or "end"
  return () unless $attr =~ /^(start|end)\z/;

  $self->_croak('side not defined') unless defined $side;
  $self->_croak('port not defined') unless defined $port;

  my @edges;
  for my $e (ord_values ( $self->{edges} ))
    {
    # skip edges ending here if we look at start
    next if $e->{to} eq $self && $attr eq 'start';
    # skip edges starting here if we look at end
    next if $e->{from} eq $self && $attr eq 'end';

    my ($s_p,@ss_p) = $e->port($attr);
    next unless defined $s_p;

    # same side and same port number?
    push @edges, $e
      if $s_p eq $side && @ss_p == 1 && $ss_p[0] eq $port;
    }

  @edges;
  }

sub shared_edges
  {
  # return all edges that share one port with another edge
  my ($self) = @_;

  my @edges;
  for my $e (ord_values ( $self->{edges} ))
    {
    my ($s_p,@ss_p) = $e->port('start');
    push @edges, $e if defined $s_p;
    my ($e_p,@ee_p) = $e->port('end');
    push @edges, $e if defined $e_p;
    }
  @edges;
  }

sub nodes_sharing_start
  {
  # return all nodes that share an edge start with an
  # edge from that node
  my ($self, $side, @port) = @_;

  my @edges = $self->edges_at_port('start',$side,@port);

  my $nodes;
  for my $e (@edges)
    {
    # ignore self-loops
    my $to = $e->{to};
    next if $to == $self;

    # remove duplicates
    $nodes->{ $to->{name} } = $to;
    }

  return (ord_values $nodes);
  }

sub nodes_sharing_end
  {
  # return all nodes that share an edge end with an
  # edge from that node
  my ($self, $side, @port) = @_;

  my @edges = $self->edges_at_port('end',$side,@port);

  my $nodes;
  for my $e (@edges)
    {
    # ignore self-loops
    my $from = $e->{from};
    next if $from == $self;

    # remove duplicates
    $nodes->{ $from->{name} } = $from;
    }

  return (ord_values $nodes);
  }

sub incoming
  {
  # return all edges that end at this node
  my $self = shift;

  # no graph, no dice
  return unless ref $self->{graph};

  if (!wantarray)
    {
    my $count = 0;
    for my $edge (ord_values ( $self->{edges} ))
      {
      $count++ if $edge->{to} == $self;
      }
    return $count;
    }

  my @edges;
  for my $edge (ord_values ( $self->{edges} ))
    {
    push @edges, $edge if $edge->{to} == $self;
    }
  @edges;
  }

sub outgoing
  {
  # return all edges that start at this node
  my $self = shift;

  # no graph, no dice
  return unless ref $self->{graph};

  if (!wantarray)
    {
    my $count = 0;
    for my $edge (ord_values ( $self->{edges} ))
      {
      $count++ if $edge->{from} == $self;
      }
    return $count;
    }

  my @edges;
  for my $edge (ord_values ( $self->{edges} ))
    {
    push @edges, $edge if $edge->{from} == $self;
    }
  @edges;
  }

sub connections
  {
  # return number of connections (incoming+outgoing)
  my $self = shift;

  return 0 unless defined $self->{graph};

  # We need to count the connections, because "[A]->[A]" creates
  # two connections on "A", but only one edge!
  my $con = 0;
  for my $edge (ord_values ( $self->{edges} ))
    {
    $con ++ if $edge->{to} == $self;
    $con ++ if $edge->{from} == $self;
    }
  $con;
  }

sub edges
  {
  # return all the edges
  my $self = shift;

  # no graph, no dice
  return unless ref $self->{graph};

  return (wantarray
      ? ord_values ( $self->{edges} )
      : scalar keys %{$self->{edges}}
  );
  }

sub sorted_successors
  {
  # return successors of the node sorted by their chain value
  # (e.g. successors with more successors first)
  my $self = shift;

  my @suc = sort {
       scalar $b->successors() <=> scalar $a->successors() ||
       scalar $a->{name} cmp scalar $b->{name}
       } $self->successors();
  @suc;
  }

sub successors
  {
  # return all nodes (as objects) we are linked to
  my $self = shift;

  return () unless defined $self->{graph};

  my %suc;
  for my $edge (ord_values ( $self->{edges} ))
    {
    next unless $edge->{from} == $self;
    $suc{$edge->{to}->{id}} = $edge->{to};	# weed out doubles
    }
    return ord_values( \%suc );
  }

sub predecessors
  {
  # return all nodes (as objects) that link to us
  my $self = shift;

  return () unless defined $self->{graph};

  my %pre;
  for my $edge (ord_values ( $self->{edges} ))
    {
    next unless $edge->{to} == $self;
    $pre{$edge->{from}->{id}} = $edge->{from};	# weed out doubles
    }
  return ord_values(\%pre);
  }

sub has_predecessors
  {
  # return true if node has incoming edges (even from itself)
  my $self = shift;

  return undef unless defined $self->{graph};

  for my $edge (ord_values ( $self->{edges} ))
    {
    return 1 if $edge->{to} == $self;		# found one
    }
  0;						# found none
  }

sub has_as_predecessor
  {
  # return true if other is a predecessor of node
  my ($self,$other) = @_;

  return () unless defined $self->{graph};

  for my $edge (ord_values ( $self->{edges} ))
    {
    return 1 if
	$edge->{to} == $self && $edge->{from} == $other;	# found one
    }
  0;						# found none
  }

sub has_as_successor
  {
  # return true if other is a successor of node
  my ($self,$other) = @_;

  return () unless defined $self->{graph};

  for my $edge (ord_values ( $self->{edges} ))
    {
    return 1 if
	$edge->{from} == $self && $edge->{to} == $other;	# found one

    }
  0;						# found none
  }

#############################################################################
# relatively placed nodes

sub relative_to
  {
  # Sets the new origin if passed a Graph::Easy::Node object.
  my ($self,$parent,$dx,$dy) = @_;

  if (!ref($parent) || !$parent->isa('Graph::Easy::Node'))
    {
    require Carp;
    Carp::confess("Can't set origin to non-node object $parent");
    }

  my $grandpa = $parent->find_grandparent();
  if ($grandpa == $self)
    {
    require Carp;
    Carp::confess( "Detected loop in origin-chain:"
                  ." tried to set origin of '$self->{name}' to my own grandchild $parent->{name}");
    }

  # unregister us with our old parent
  delete $self->{origin}->{children}->{$self->{id}} if defined $self->{origin};

  $self->{origin} = $parent;
  $self->{dx} = $dx if defined $dx;
  $self->{dy} = $dy if defined $dy;
  $self->{dx} = 0 unless defined $self->{dx};
  $self->{dy} = 0 unless defined $self->{dy};

  # register us as a new child
  $parent->{children}->{$self->{id}} = $self;

  $self;
  }

sub find_grandparent
  {
  # For a node that has no origin (is not relative to another), returns
  # $self. For all others, follows the chain of origin back until we
  # hit a node without a parent. This code assumes there are no loops,
  # which origin() prevents from happening.
  my $cur = shift;

  if (wantarray)
    {
    my $ox = 0;
    my $oy = 0;
    while (defined($cur->{origin}))
      {
      $ox -= $cur->{dx};
      $oy -= $cur->{dy};
      $cur = $cur->{origin};
      }
    return ($cur,$ox,$oy);
    }

  while (defined($cur->{origin}))
    {
    $cur = $cur->{origin};
    }

  $cur;
  }

#############################################################################
# attributes

sub del_attribute
  {
  my ($self, $name) = @_;

  # font-size => fontsize
  $name = $att_aliases->{$name} if exists $att_aliases->{$name};

  $self->{cache} = {};

  my $a = $self->{att};
  delete $a->{$name};
  if ($name eq 'size')
    {
    delete $a->{rows};
    delete $a->{columns};
    }
  if ($name eq 'border')
    {
    delete $a->{borderstyle};
    delete $a->{borderwidth};
    delete $a->{bordercolor};
    }
  $self;
  }

sub set_attribute
  {
  my ($self, $name, $v, $class) = @_;

  $self->{cache} = {};

  $name = 'undef' unless defined $name;
  $v = 'undef' unless defined $v;

  # font-size => fontsize
  $name = $att_aliases->{$name} if exists $att_aliases->{$name};

  # edge.cities => edge
  $class = $self->main_class() unless defined $class;

  # remove quotation marks, but not for titles, labels etc
  my $val = Graph::Easy->unquote_attribute($class,$name,$v);

  my $g = $self->{graph};

  $g->{score} = undef if $g;	# invalidate layout to force a new layout

  my $strict = 0; $strict = $g->{strict} if $g;
  if ($strict)
    {
    my ($rc, $newname, $v) = $g->validate_attribute($name,$val,$class);

    return if defined $rc;		# error?

    $val = $v;
    }

  if ($name eq 'class')
    {
    $self->sub_class($val);
    return $val;
    }
  elsif ($name eq 'group')
    {
    $self->add_to_group($val);
    return $val;
    }
  elsif ($name eq 'border')
    {
    my $c = $self->{att};

    ($c->{borderstyle}, $c->{borderwidth}, $c->{bordercolor}) =
	$g->split_border_attributes( $val );

    return $val;
    }

  if ($name =~ /^(columns|rows|size)\z/)
    {
    if ($name eq 'size')
      {
      $val =~ /^(\d+)\s*,\s*(\d+)\z/;
      my ($cx, $cy) = (abs(int($1)),abs(int($2)));
      ($self->{att}->{columns}, $self->{att}->{rows}) = ($cx, $cy);
      }
    else
      {
      $self->{att}->{$name} = abs(int($val));
      }
    return $self;
    }

  if ($name =~ /^(origin|offset)\z/)
    {
    # Only the first autosplit node get the offset/origin
    return $self if exists $self->{autosplit} && !defined $self->{autosplit};

    if ($name eq 'origin')
      {
      # if it doesn't exist, add it
      my $org = $self->{graph}->add_node($val);
      $self->relative_to($org);

      # set the attributes, too, so get_attribute('origin') works, too:
      $self->{att}->{origin} = $org->{name};
      }
    else
      {
      # offset
      # if it doesn't exist, add it
      my ($x,$y) = split/\s*,\s*/, $val;
      $x = int($x);
      $y = int($y);
      if ($x == 0 && $y == 0)
        {
        $g->error("Error in attribute: 'offset' is 0,0 in node $self->{name} with class '$class'");
        return;
        }
      $self->{dx} = $x;
      $self->{dy} = $y;

      # set the attributes, too, so get_attribute('origin') works, too:
      $self->{att}->{offset} = "$self->{dx},$self->{dy}";
      }
    return $self;
    }

  $self->{att}->{$name} = $val;
  }

sub set_attributes
  {
  my ($self, $atr, $index) = @_;

  foreach my $n (sort keys %$atr)
    {
    my $val = $atr->{$n};
    $val = $val->[$index] if ref($val) eq 'ARRAY' && defined $index;

    next if !defined $val || $val eq '';

    $n eq 'class' ? $self->sub_class($val) : $self->set_attribute($n, $val);
    }
  $self;
  }

BEGIN
  {
  # some handy aliases
  *text_styles_as_css = \&Graph::Easy::text_styles_as_css;
  *text_styles = \&Graph::Easy::text_styles;
  *_font_size_in_pixels = \&Graph::Easy::_font_size_in_pixels;
  *get_color_attribute = \&color_attribute;
  *link = \&Graph::Easy::link;
  *border_attribute = \&Graph::Easy::border_attribute;
  *get_attributes = \&Graph::Easy::get_attributes;
  *get_attribute = \&Graph::Easy::attribute;
  *raw_attribute = \&Graph::Easy::raw_attribute;
  *get_raw_attribute = \&Graph::Easy::raw_attribute;
  *raw_color_attribute = \&Graph::Easy::raw_color_attribute;
  *raw_attributes = \&Graph::Easy::raw_attributes;
  *raw_attributes = \&Graph::Easy::raw_attributes;
  *attribute = \&Graph::Easy::attribute;
  *color_attribute = \&Graph::Easy::color_attribute;
  *default_attribute = \&Graph::Easy::default_attribute;
  $att_aliases = Graph::Easy::_att_aliases();
  }

#############################################################################

sub group
  {
  # return the group this object belongs to
  my $self = shift;

  $self->{group};
  }

sub add_to_group
  {
  my ($self,$group) = @_;

  my $graph = $self->{graph};				# shortcut

  # delete from old group if nec.
  $self->{group}->del_member($self) if ref $self->{group};

  # if passed a group name, create or find group object
  $group = $graph->add_group($group) if (!ref($group) && $graph);

  # To make attribute('group') work:
  $self->{att}->{group} = $group->{name};

  $group->add_member($self);

  $self;
  }

sub parent
  {
  # return parent object, either the group the node belongs to, or the graph
  my $self = shift;

  my $p = $self->{graph};

  $p = $self->{group} if ref($self->{group});

  $p;
  }

sub _update_boundaries
  {
  my ($self, $parent) = @_;

  # XXX TODO: use current layout parent for recursive layouter:
  $parent = $self->{graph};

  # cache max boundaries for A* algorithmn:

  my $x = $self->{x};
  my $y = $self->{y};

  # create the cache if it doesn't already exist
  $parent->{cache} = {} unless ref($parent->{cache});

  my $cache = $parent->{cache};

  $cache->{min_x} = $x if !defined $cache->{min_x} || $x < $cache->{min_x};
  $cache->{min_y} = $y if !defined $cache->{min_y} || $y < $cache->{min_y};

  $x = $x + ($self->{cx}||1) - 1;
  $y = $y + ($self->{cy}||1) - 1;
  $cache->{max_x} = $x if !defined $cache->{max_x} || $x > $cache->{max_x};
  $cache->{max_y} = $y if !defined $cache->{max_y} || $y > $cache->{max_y};

  if (($parent->{debug}||0) > 1)
    {
    my $n = $self->{name}; $n = $self unless defined $n;
    print STDERR "Update boundaries for $n (parent $parent) at $x, $y\n";

    print STDERR "Boundaries are now: " .
		 "$cache->{min_x},$cache->{min_y} => $cache->{max_x},$cache->{max_y}\n";
    }

  $self;
  }

1;
__END__