Graph::Easy - Convert or render graphs (as ASCII, HTML, SVG or via Graphviz)

	use Graph::Easy;

	my $graph = Graph::Easy->new();

	# make a fresh copy of the graph
	my $new_graph = $graph->copy();

	$graph->add_edge ('Bonn', 'Berlin');

	# will not add it, since it already exists
	$graph->add_edge_once ('Bonn', 'Berlin');

	print $graph->as_ascii( ); 		# prints:

	# +------+     +--------+
	# | Bonn | --> | Berlin |
	# +------+     +--------+

	#####################################################
	# alternatively, let Graph::Easy parse some text:

	my $graph = Graph::Easy->new( '[Bonn] -> [Berlin]' );

	#####################################################
	# slightly more verbose way:

	my $graph = Graph::Easy->new();

	my $bonn = $graph->add_node('Bonn');
	$bonn->set_attribute('border', 'solid 1px black');

	my $berlin = $graph->add_node('Berlin');

	$graph->add_edge ($bonn, $berlin);

	print $graph->as_ascii( );

	# You can use plain scalars as node names and for the edge label:
	$graph->add_edge ('Berlin', 'Frankfurt', 'via train');

	# adding edges with attributes:

	my $edge = Graph::Easy::Edge->new();
	$edge->set_attributes( {
		label => 'train',
		style => 'dotted',
		color => 'red',
	} );

	# now with the optional edge object
	$graph->add_edge ($bonn, $berlin, $edge);

	# raw HTML section
	print $graph->as_html( );

	# complete HTML page (with CSS)
	print $graph->as_html_file( );

	# Other possibilities:

	# SVG (possible after you installed Graph::Easy::As_svg):
	print $graph->as_svg( );

	# Graphviz:
	my $graphviz = $graph->as_graphviz();
	open $DOT, '|dot -Tpng -o graph.png' or die ("Cannot open pipe to dot: $!");
	print $DOT $graphviz;
	close $DOT;

	# Please see also the command line utility 'graph-easy'

	[ Bonn ]      --> [ Berlin ]
	[ Frankfurt ] <=> [ Dresden ]
	[ Bonn ]      --  [ Frankfurt ]

	my $graph = Graph::Easy->new();

	my $node = $graph->add_node('Koblenz');

	$node = $graph->add_node('Koblenz');

	$node = $graph->node('Koblenz');

	my $second = $graph->node('Frankfurt');

	my ($first,$second,$edge) = $graph->add_edge('Mainz','Ulm');

	my $other_edge;
	 ($first,$second,$other_edge) = $graph->add_edge('Mainz','Ulm');

	my $edge = $graph->add_edge_once('Mainz','Ulm');
	if (defined $edge)
	  {
	  # the first time the edge was added, do something with it
	  $edge->set_attribute('color','blue');
	  }

	$node->attribute('fill', 'yellow');
	$edge->attribute('label', 'train');

	$graph->add_edge('Cottbus', 'Berlin', 'my label');

	$graph->add_edge('Bremen','Bremen');

	my ($bonn,$rom) = Graph::Easy->add_nodes('Bonn','Rom');

	my ($group) = Graph::Easy->add_group('Cities');

	$group->add_member($bonn);
	$group->add_node($rom);
	$group->add_nodes($rom,$bonn);

	[ Dresden ]

	[ Bonn ] -> [ Berlin ]

	[ Bonn ] -> [ Berlin ]
	[ Bonn ] -> [ Hamburg ]

	[ Bonn ] -> [ Berlin ] -> [ Hamburg ]

	[ Bonn ] -> [ Berlin ]
	[ Freiburg ] -> [ Hamburg ]

	[ Bonn ] -> [ Berlin ]
	[ Berlin ] -> [ Hamburg ]
	[ Bonn ] -> [ Hamburg ]

	[ Bonn ] <-> [ Berlin ]		# bidirectional
	[ Berlin ] ==> [ Rostock ]	# double
	[ Hamburg ] ..> [ Altona ]	# dotted
	[ Dresden ] - > [ Bautzen ]	# dashed
	[ Leipzig ] ~~> [ Kirchhain ]	# wave
	[ Hof ] .-> [ Chemnitz ]	# dot-dash
	[ Magdeburg ] <=> [ Ulm ]	# bidrectional, double etc
	[ Magdeburg ] -- [ Ulm ]	# arrow-less edge

	step.0 {
	  target: Bonn;		# find object with id=Bonn, or
				# if this fails, the node named
				# "Bonn".
	  animate: fill:	# animate this attribute
	  from: yellow;		# start value (0% of duration)
	  via: red;		# at 50% of the duration
	  to: yellow;		# and 100% of duration
	  wait: 0;		# after triggering, wait so many seconds
	  duration: 5;		# entire time to go from "from" to "to"
	  trigger: onload;	# when to trigger this animation
	  repeat: 2;		# how often to repeat ("2" means two times)
				# also "infinite", then "next" will be ignored
	  next: 1;		# which step to take after repeat is up
	}
	step.1 {
	  from: white;		# set to white
	  to: white;
	  duration: 0.1;	# 100ms
	  next: 0;		# go back to step.0
	}

                               0.1s
	                     +-------------------------------+
	                     v                               |
	+--------+  0s   +--------+  5s   +--------+  5s   +--------+
	| onload | ----> | step.0 | ----> | step.0 | ----> | step.1 |
	+--------+       +--------+       +--------+       +--------+

        use Graph::Easy;

        my $graph = Graph::Easy->new( );

	debug			if true, enables debug output
	timeout			timeout (in seconds) for the layouter
	fatal_errors		wrong attributes are fatal errors, default: true
	strict			test attribute names for being valid, default: true
	undirected		create an undirected graph, default: false

    my $copy = $graph->copy( );

	my $error = $graph->error();

	$graph->error( 'Expected Foo, but found Bar.' );

	my $warning = $graph->warn();

	$graph->warn( 'Expected Foo, but found Bar.' );

	$graph->catch_messages(1);

	# Or individually:
	# $graph->catch_warnings(1);
	# $graph->catch_errors(1);

	# something which warns or throws an error:
	...

	if ($graph->error())
	  {
	  my @errors = $graph->errors();
	  }
	if ($graph->warning())
	  {
	  my @warnings = $graph->warnings();
	  }

	my ($first, $second, $edge) = $graph->add_edge( 'node 1', 'node 2');

	my ($first, $second, $edge) = $graph->add_edge( 'node 1', 'node 2');
	my $edge = $graph->add_edge( $x, $y, $edge);
	$graph->add_edge( $x, $y);

	my ($first, $second, $edge) = $graph->add_edge_once( 'node 1', 'node 2');
	my $edge = $graph->add_edge_once( $x, $y, $edge);
	$graph->add_edge_once( $x, $y);

	if (defined $edge)
	  {
	  # got added once, so do something with it
	  $edge->set_attribute('label','unique');
	  }

	my $graph = Graph::Easy->new();
	$graph->add_edge('Bonn','Berlin');
	$graph->add_edge('Berlin','Bonn');

	print $graph->as_ascii();

	#   +--------------+
	#   v              |
	# +--------+     +------+
	# | Berlin | --> | Bonn |
	# +--------+     +------+

	$graph->flip_edges('Bonn', 'Berlin');

	print $graph->as_ascii();

	#   +--------------+
	#   |              v
	# +--------+     +------+
	# | Berlin | --> | Bonn |
	# +--------+     +------+

	my $node = $graph->add_node( 'Node 1' );
	# or if you already have a Graph::Easy::Node object:
	$graph->add_node( $x );

	my $anon_node = $graph->add_anon_node( );

	my @nodes = $graph->add_nodes( 'Node 1', 'Node 2' );

	$node = $graph->rename_node($node, $new_name);

	$graph->del_node('Node name');
	$graph->del_node($node);

	$graph->del_edge($edge);

	$graph->del_edge( $graph->edge('A','B') );

	$graph->merge_nodes( $first_node, $second_node );
	$graph->merge_nodes( $first_node, $second_node, $joiner );

	my $graph = Graph::Easy->new('[A]->[B]->[C]->[D]');

	# this produces "[A]->[C]->[D]"
	$graph->merge_nodes( 'A', 'B' );

	# this produces "[A C]->[D]"
	$graph->merge_nodes( 'A', 'C', ' ' );

	# this produces "[A C \n D]", note single quotes on the third argument!
	$graph->merge_nodes( 'A', 'C', ' \n ' );

	my $value = $graph->get_attribute( $class, $name );

	my $color = $graph->attribute( 'node', 'color' );

	$node->get_attribute('label');
	$edge->get_attribute('color');
	$group->get_attribute('fill');

	my $value = $graph->attribute( $class, $name );

	# returns f.i. #ff0000
	my $color = $graph->get_color_attribute( 'node', 'color' );

	my $att = $object->get_attributes();

	my $att = $object->get_custom_attributes();

	my $att = $object->custom_attributes();

	my $att = $object->raw_attributes();

	node { color: red; }

	[ A ] { class: foo; color: inherit; }

	{ class => foo, color => red }

	my $def = $graph->default_attribute($class, 'fill');

	my $g = Graph::Easy->new();
	my $node = $g->add_node('Berlin');

	print $node->attribute('fill'), "\n";		# print "white"
	print $node->default_attribute('fill'), "\n";	# print "white"
	print $g->attribute('node','fill'), "\n";	# print "white"

	$g->set_attribute('node','fill','red');		# class is "red"
	$node->set_attribute('fill','green');		# this object is "green"

	print $node->attribute('fill'), "\n";		# print "green"
	print $node->default_attribute('fill'), "\n";	# print "white"
	print $g->attribute('node','fill'), "\n";	# print "red"

	my $value = $object->raw_attribute( $name );

	my $g = Graph::Easy->new();
	my $n = $g->add_node('A');

	$g->set_attribute('color','red');

	print $n->raw_attribute('color');		# undef
	$n->set_attribute('color','inherit');
	print $n->raw_attribute('color');		# 'red'

	# returns f.i. #ff0000
	my $color = $graph->raw_color_attribute('color' );

	my $att = $object->raw_attributes();

	# Set the attribute on the given class.
	$graph->set_attribute( $class, $name, $val );

	# Set the attribute on the graph itself. This is synonymous
	# to using 'graph' as class in the form above.
	$graph->set_attribute( $name, $val );

	$graph->set_attribute( 'graph', 'gid', '123' );

	$node->set_attribute('label', 'my node');
	$edge->set_attribute('color', 'red');
	$group->set_attribute('fill', 'green');

	$graph->set_attributes( $class, $att );

	$graph->set_attributes( 'node', { color => 'red', background => 'none' } );

	$graph->del_attribute('border');

	$node->del_attribute('label');
	$edge->del_attribute('color');
	$group->del_attribute('fill');

	# returns '"Hello World!"'
	my $value = $self->unquote_attribute('node','label','"Hello World!"');
	# returns 'red'
	my $color = $self->unquote_attribute('node','color','"red"');

  	my $border = $graph->border_attribute();

  	my ($style,$width,$color) = $graph->split_border_attribute($border);

	my $cmt = $node->comment();

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

	my @roots = $graph->source_nodes();

	my @roots = $graph->predecessorless_nodes();

	my $root = $graph->root_node();

	print $graph->timeout(), " seconds timeout for layouts.\n";
	$graph->timeout(12);

	print "Graph has strict checking\n" if $graph->strict();
	$graph->strict(undef);		# disable strict attribute checks

	print "Graph is " . $graph->type() . "\n";

	$graph->layout();
	$graph->layout( type => 'force', timeout => 60 );

	type		the type of the layout, possible values:
			'force'		- force based layouter
			'adhoc'		- the default layouter
	timeout		timeout in seconds

	$graph->output_format('html');

	my $out = $graph->output();

	print $graph->as_ascii();

	print $graph->as_ascii_file();

	print $graph->as_ascii_html();

	print $graph->as_box();

	print $graph->as_boxart_file();

	print $graph->as_boxart_html();

	print $graph->as_boxart_html_file();

	print $graph->as_html();

	print $graph->as_html_page();

	print $graph->as_html_file();

	my $group = $graph->add_group('Group name');

	my $group = $graph->group('Name');

	$group = $graph->rename_group($group, $new_name);

	my @groups = $graph->groups();

	# equivalent to $graph->groups():
	my @groups = $graph->groups_within();		# all
	my @toplevel_groups = $graph->groups_within(0);	# level 0 only

	my $anon_groups = $graph->anon_groups();

	$graph->del_group($name);

	my @edges = $graph->edges();

	if ($graph->is_simple())
	  {
	  }

	if ($graph->is_directed())
	  {
	  }

	if ($graph->is_undirected())
	  {
	  }

	my $parent = $graph->parent();

	my $label = $graph->label();

	my $title = $graph->title();

	my $link = $graph->link();

	print $graph->as_graphviz();

	print $graph->as_graphviz_file();

        my $degrees = Graph::Easy->angle( 'south' );
        my $degrees = Graph::Easy->angle( 120 );

	my $nodes = $graph->nodes();

	my $anon_nodes = $graph->anon_nodes();

	my $header = $graph->html_page_header();
	my $header = $graph->html_page_header($css);

	my $footer = $graph->html_page_footer();

	my $css = $graph->css();

	print $graph->as_txt();

	print $graph->as_txt_file();

	print $graph->as_svg();

	print $graph->as_svg_file();

	my $info = $graph->svg_information();

	print "Size: $info->{width}, $info->{height}\n";

	width		width of the SVG in pixels
	height		height of the SVG in pixels

	print $graph->as_vcg();

	print $graph->as_vcg_file();

	print $graph->as_gdl();

	print $graph->as_gdl_file();

	print $graph->as_graphml();

	print $graph->as_graphml_file();

	my $nodes =
	 $graph->sorted_nodes( );		# default sort on 'id'
	my $nodes = 
	 $graph->sorted_nodes( 'name' );	# sort on 'name'
	my $nodes = 
	 $graph->sorted_nodes( 'layer', 'id' );	# sort on 'layer', then on 'id'

	print $graph->as_debug();

	my $node = $graph->node('node name');

	my $edge = $graph->edge( $x, $y );

	my $graph_id = $graph->id();
	$graph->id('123');

	my $seed = $graph->seed();
	$graph->seed(2);

	$graph->randomize();

	my $debug = $graph->debug();	# get
	$graph->debug(1);		# enable
	$graph->debug(0);		# disable

	my $score = $graph->score();

	my $max = undef;

	$graph->randomize();
	my $seed = $graph->seed(); 

	$graph->layout();
	$max = $graph->score(); 

	for (1..10)
	  {
	  $graph->randomize();			# select random seed
	  $graph->layout();			# layout with that seed
	  if ($graph->score() > $max)
	    {
	    $max = $graph->score();		# store the new max store
	    $seed = $graph->seed();		# and it's seed
	    }
	  }

	# redo the best layout
	if ($seed ne $graph->seed())
	  {
	  $graph->seed($seed);
	  $graph->layout();
	  }
	# output graph:
	print $graph->as_ascii();		# or as_html() etc

	my $graph = Graph::Easy->new();
	my $new_value =
	  $graph->valid_attribute( $name, $value, $class );

	if (ref($new_value) eq 'ARRAY' && @$new_value == 0)
	  {
	  # throw error
          die ("'$name' is not a valid attribute name for '$class'")
		if $self->{_warn_on_unused_attributes};
	  }
	elsif (!defined $new_value)
	  {
	  # throw error
          die ("'$value' is no valid '$name' for '$class'");
	  }

	print $graph->valid_attribute( 'color', 'red' );

	my $graph = Graph::Easy->new();
	my ($rc,$new_name, $new_value) =
	  $graph->validate_attribute( $name, $value, $class );

	1			unknown attribute name
	2			invalid attribute value
	4			found multiple attributes, but these arent
				allowed at this place

	my $hexred   = Graph::Easy->color_as_hex( 'red' );
	my $hexblue  = Graph::Easy->color_as_hex( '#0000ff' );
	my $hexcyan  = Graph::Easy->color_as_hex( '#f0f' );
	my $hexgreen = Graph::Easy->color_as_hex( 'rgb(0,255,0)' );

	my $color = Graph::Easy->color_name( 'red' );	# #ff0000
	print Graph::Easy->color_name( '#ff0000' );	# #ff0000

	print Graph::Easy->color_name( 'snow', 'x11' );

	my $color = Graph::Easy->color_name( 'red' );	# red
	print Graph::Easy->color_name( '#ff0000' );	# red

	print Graph::Easy->color_name( 'snow', 'x11' );

 w3c			(the default)
 x11			(what graphviz uses as default)

 accent3 accent4 accent5 accent6 accent7 accent8

 blues3 blues4 blues5 blues6 blues7 blues8 blues9

 brbg3 brbg4 brbg5 brbg6 brbg7 brbg8 brbg9 brbg10 brbg11

 bugn3 bugn4 bugn5 bugn6 bugn7 bugn8 bugn9 bupu3 bupu4 bupu5 bupu6 bupu7
 bupu8 bupu9

 dark23 dark24 dark25 dark26 dark27 dark28

 gnbu3 gnbu4 gnbu5 gnbu6 gnbu7 gnbu8 gnbu9

 greens3 greens4 greens5 greens6 greens7 greens8 greens9

 greys3 greys4 greys5 greys6 greys7 greys8 greys9

 oranges3 oranges4 oranges5 oranges6 oranges7 oranges8 oranges9

 orrd3 orrd4 orrd5 orrd6 orrd7 orrd8 orrd9

 paired3 paired4 paired5 paired6 paired7 paired8 paired9 paired10 paired11
 paired12 pastel13 pastel14 pastel15 pastel16 pastel17 pastel18 pastel19

 pastel23 pastel24 pastel25 pastel26 pastel27 pastel28

 piyg3 piyg4 piyg5 piyg6 piyg7 piyg8 piyg9 piyg10 piyg11

 prgn3 prgn4 prgn5 prgn6 prgn7 prgn8 prgn9 prgn10 prgn11

 pubu3 pubu4 pubu5 pubu6 pubu7 pubu8 pubu9

 pubugn3 pubugn4 pubugn5 pubugn6 pubugn7 pubugn8 pubugn9

 puor3 puor4 puor5 puor6 puor7 puor8 puor9 purd3 purd4 purd5 purd6 purd7 purd8
 purd9 puor10 puor11

 purples3 purples4 purples5 purples6 purples7 purples8 purples9

 rdbu10 rdbu11 rdbu3 rdbu4 rdbu5 rdbu6 rdbu7 rdbu8 rdbu9 rdgy3 rdgy4 rdgy5 rdgy6

 rdgy7 rdgy8 rdgy9 rdpu3 rdpu4 rdpu5 rdpu6 rdpu7 rdpu8 rdpu9 rdgy10 rdgy11

 rdylbu3 rdylbu4 rdylbu5 rdylbu6 rdylbu7 rdylbu8 rdylbu9 rdylbu10 rdylbu11

 rdylgn3 rdylgn4 rdylgn5 rdylgn6 rdylgn7 rdylgn8 rdylgn9 rdylgn10 rdylgn11

 reds3 reds4 reds5 reds6 reds7 reds8 reds9

 set13 set14 set15 set16 set17 set18 set19 set23 set24 set25 set26 set27 set28
 set33 set34 set35 set36 set37 set38 set39

 set310 set311 set312

 spectral3 spectral4 spectral5 spectral6 spectral7 spectral8 spectral9
 spectral10spectral11

 ylgn3 ylgn4 ylgn5 ylgn6 ylgn7 ylgn8 ylgn9

 ylgnbu3 ylgnbu4 ylgnbu5 ylgnbu6 ylgnbu7 ylgnbu8 ylgnbu9

 ylorbr3 ylorbr4 ylorbr5 ylorbr6 ylorbr7 ylorbr8 ylorbr9

 ylorrd3 ylorrd4 ylorrd5 ylorrd6 ylorrd7 ylorrd8 ylorrd9

	my $names = Graph::Easy->color_names();

	if ($graph->text_style('bold, italic'))
	  {
	  ...
	  }

	my $styles = $graph->text_styles();	# or $edge->text_styles() etc.

	if ($styles->{'italic'})
	  {
	  print 'is italic\n';
	  }

	my $styles = $graph->text_styles_as_css();	# or $edge->...() etc.

	$graph->use_class('node', 'Graph::Easy::MyNode');

	node
	edge
	group

	my $graph_2 = $graph->animation_as_graph();
	print $graph_2->as_ascii();

	$graph->add_cycle('A','B','C');		# A -> B -> C -> A

	$graph->add_path('A','B','C');		# A -> B -> C

	$graph->add_vertex('A');

	$graph->add_vertices('A','B');

	$graph->has_edge('A','B');

	$graph->set_vertex_attribute( 'A', 'fill', '#deadff' );

	$graph->set_vertex_attribute( 'A', 'x-foo', 'bar' );

	my $fill = $graph->get_vertex_attribute( 'A', 'fill' );

############################################################################
# Manage, and layout graphs on a flat plane.
#
#############################################################################

package Graph::Easy;

use 5.008002;
use Graph::Easy::Base;
use Graph::Easy::Attributes;
use Graph::Easy::Edge;
use Graph::Easy::Group;
use Graph::Easy::Group::Anon;
use Graph::Easy::Layout;
use Graph::Easy::Node;
use Graph::Easy::Node::Anon;
use Graph::Easy::Node::Empty;
use Scalar::Util qw/weaken/;

$VERSION = '0.70';
@ISA = qw/Graph::Easy::Base/;

use strict;
my $att_aliases;

BEGIN 
  {
  # a few aliases for backwards compatibility
  *get_attribute = \&attribute; 
  *as_html_page = \&as_html_file;
  *as_graphviz_file = \&as_graphviz;
  *as_ascii_file = \&as_ascii;
  *as_boxart_file = \&as_boxart;
  *as_txt_file = \&as_txt;
  *as_vcg_file = \&as_vcg;
  *as_gdl_file = \&as_gdl;
  *as_graphml_file = \&as_graphml;

  # a few aliases for code re-use
  *_aligned_label = \&Graph::Easy::Node::_aligned_label;
  *quoted_comment = \&Graph::Easy::Node::quoted_comment;
  *_un_escape = \&Graph::Easy::Node::_un_escape;
  *_convert_pod = \&Graph::Easy::Node::_convert_pod;
  *_label_as_html = \&Graph::Easy::Node::_label_as_html;
  *_wrapped_label = \&Graph::Easy::Node::_wrapped_label;
  *get_color_attribute = \&color_attribute;
  *get_custom_attributes = \&Graph::Easy::Node::get_custom_attributes;
  *custom_attributes = \&Graph::Easy::Node::get_custom_attributes;
  $att_aliases = Graph::Easy::_att_aliases();

  # backwards compatibility
  *is_simple_graph = \&is_simple;

  # compatibility to Graph
  *vertices = \&nodes;
  }

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

sub new
  {
  # override new() as to not set the {id}
  my $class = shift;

  # called like "new->('[A]->[B]')":
  if (@_ == 1 && !ref($_[0]))
    {
    require Graph::Easy::Parser;
    my $parser = Graph::Easy::Parser->new();
    my $self = eval { $parser->from_text($_[0]); };
    if (!defined $self)
      {
      $self = Graph::Easy->new( fatal_errors => 0 );
      $self->error( 'Error: ' . $parser->error() ||
        'Unknown error while parsing initial text' );
      $self->catch_errors( 0 );
      }
    return $self;
    }

  my $self = bless {}, $class;

  my $args = $_[0];
  $args = { @_ } if ref($args) ne 'HASH';

  $self->_init($args);
  }

sub DESTROY
  {
  my $self = shift;
 
  # Be carefull to not delete ->{graph}, these will be cleaned out by
  # Perl automatically in O(1) time, manual delete is O(N) instead.

  delete $self->{chains};
  # clean out pointers in child-objects so that they can safely be reused
  for my $n (values %{$self->{nodes}})
    {
    if (ref($n))
      {
      delete $n->{edges};
      delete $n->{group};
      }
    }
  for my $e (values %{$self->{edges}})
    {
    if (ref($e))
      {
      delete $e->{cells};
      delete $e->{to};
      delete $e->{from};
      }
    }
  for my $g (values %{$self->{groups}})
    {
    if (ref($g))
      {
      delete $g->{nodes};
      delete $g->{edges};
      }
    }
  }

# Attribute overlay for HTML output:

my $html_att = {
  node => {
    borderstyle => 'solid',
    borderwidth => '1px',
    bordercolor => '#000000',
    align => 'center',
    padding => '0.2em',
    'padding-left' => '0.3em',
    'padding-right' => '0.3em',
    margin => '0.1em',
    fill => 'white',
    },
  'node.anon' => {
    'borderstyle' => 'none',
    # ' inherit' to protect the value from being replaced by the one from "node"
    'background' => ' inherit',
    },
  graph => {
    margin => '0.5em',
    padding => '0.5em',
    'empty-cells' => 'show',
    },
  edge => { 
    border => 'none',
    padding => '0.2em',
    margin => '0.1em',
    'font' => 'monospaced, courier-new, courier, sans-serif',
    'vertical-align' => 'bottom',
    },
  group => { 
    'borderstyle' => 'dashed',
    'borderwidth' => '1',
    'fontsize' => '0.8em',
    fill => '#a0d0ff',
    padding => '0.2em',
# XXX TODO:
# in HTML, align left is default, so we could omit this:
    align => 'left',
    },
  'group.anon' => {
    'borderstyle' => 'none',
    background => 'white',
    },
  };


sub _init
  {
  my ($self,$args) = @_;

  $self->{debug} = 0;
  $self->{timeout} = 5;			# in seconds
  $self->{strict} = 1;			# check attributes strict?
  
  $self->{class} = 'graph';
  $self->{id} = '';
  $self->{groups} = {};

  # node objects, indexed by their unique name
  $self->{nodes} = {};
  # edge objects, indexed by unique ID
  $self->{edges} = {};

  $self->{output_format} = 'html';

  $self->{_astar_bias} = 0.001;

  # default classes to use in add_foo() methods
  $self->{use_class} = {
    edge => 'Graph::Easy::Edge',
    group => 'Graph::Easy::Group',
    node => 'Graph::Easy::Node',
  };

  # Graph::Easy will die, Graph::Easy::Parser::Graphviz will warn
  $self->{_warn_on_unknown_attributes} = 0;
  $self->{fatal_errors} = 1;

  # The attributes of the graph itself, _and_ the class/subclass attributes.
  # These can share a hash, because:
  # *  {att}->{graph} contains both the graph attributes and the class, since
  #    these are synonymous, it is not possible to have more than one graph.
  # *  'node', 'group', 'edge' are not valid attributes for a graph, so
  #    setting "graph { node: 1; }" is not possible and can thus not overwrite
  #    the entries from att->{node}.
  # *  likewise for "node.subclass", attribute names never have a "." in them
  $self->{att} = {};

  foreach my $k (keys %$args)
    {
    if ($k !~ /^(timeout|debug|strict|fatal_errors|undirected)\z/)
      {
      $self->error ("Unknown option '$k'");
      }
    if ($k eq 'undirected' && $args->{$k})
      {
      $self->set_attribute('type', 'undirected'); next;
      }
    $self->{$k} = $args->{$k};
    }

  binmode(STDERR,'utf8') or die ("Cannot do binmode(STDERR,'utf8'")
    if $self->{debug};

  $self->{score} = undef;

  $self->randomize();

  $self;
  }

#############################################################################
# accessors

sub timeout
  {
  my $self = shift;

  $self->{timeout} = $_[0] if @_;
  $self->{timeout};
  }

sub debug
  {
  my $self = shift;

  $self->{debug} = $_[0] if @_;
  $self->{debug};
  }

sub strict
  {
  my $self = shift;

  $self->{strict} = $_[0] if @_;
  $self->{strict};
  }

sub type
  {
  # return the type of the graph, "undirected" or "directed"
  my $self = shift;

  $self->{att}->{type} || 'directed';
  }

sub is_simple
  {
  # return true if the graph does not have multiedges
  my $self = shift;

  my %count;
  for my $e (values %{$self->{edges}})
    {
    my $id = "$e->{to}->{id},$e->{from}->{id}";
    return 0 if exists $count{$id};
    $count{$id} = undef;
    }

  1;					# found none
  }

sub is_directed
  {
  # return true if the graph is directed
  my $self = shift;

  $self->attribute('type') eq 'directed' ? 1 : 0;
  }

sub is_undirected
  {
  # return true if the graph is undirected
  my $self = shift;

  $self->attribute('type') eq 'undirected' ? 1 : 0;
  }

sub id
  {
  my $self = shift;

  $self->{id} = shift if defined $_[0];
  $self->{id};
  }

sub score
  {
  my $self = shift;

  $self->{score};
  }

sub randomize
  {
  my $self = shift;

  srand();
  $self->{seed} = rand(2 ** 31);

  $self->{seed};
  }

sub root_node
  {
  # Return the root node
  my $self = shift;
  
  my $root = $self->{att}->{root};
  $root = $self->{nodes}->{$root} if defined $root;

  $root;
  }

sub source_nodes
  {
  # return nodes with only outgoing edges
  my $self = shift;

  my @roots;
  for my $node (values %{$self->{nodes}})
    {
    push @roots, $node 
      if (keys %{$node->{edges}} != 0) && !$node->has_predecessors();
    }
  @roots;
  }

sub predecessorless_nodes
  {
  # return nodes with no incoming (but maybe outgoing) edges
  my $self = shift;

  my @roots;
  for my $node (values %{$self->{nodes}})
    {
    push @roots, $node 
      if (keys %{$node->{edges}} == 0) || !$node->has_predecessors();
    }
  @roots;
  }

sub label
  {
  my $self = shift;

  my $label = $self->{att}->{graph}->{label}; $label = '' unless defined $label;
  $label = $self->_un_escape($label) if !$_[0] && $label =~ /\\[EGHNT]/;
  $label;
  }

sub link
  {
  # return the link, build from linkbase and link (or autolink)
  my $self = shift;

  my $link = $self->attribute('link');
  my $autolink = ''; $autolink = $self->attribute('autolink') if $link eq '';
  if ($link eq '' && $autolink ne '')
    {
    $link = $self->{name} if $autolink eq 'name';
    # defined to avoid overriding "name" with the non-existant label attribute
    $link = $self->{att}->{label} if $autolink eq 'label' && defined $self->{att}->{label};
    $link = $self->{name} if $autolink eq 'label' && !defined $self->{att}->{label};
    }
  $link = '' unless defined $link;

  # prepend base only if link is relative
  if ($link ne '' && $link !~ /^([\w]{3,4}:\/\/|\/)/)
    {
    $link = $self->attribute('linkbase') . $link;
    }

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

  $link;
  }

sub parent
  {
  # return parent object, for graphs that is undef
  undef;
  }

sub seed
  {
  my $self = shift;

  $self->{seed} = $_[0] if @_ > 0;

  $self->{seed};
  }

sub nodes
  {
  # return all nodes as objects, in scalar context their count
  my ($self) = @_;

  my $n = $self->{nodes};

  return scalar keys %$n unless wantarray;	# shortcut

  values %$n;
  }

sub anon_nodes
  {
  # return all anon nodes as objects
  my ($self) = @_;

  my $n = $self->{nodes};

  if (!wantarray)
    {
    my $count = 0;
    for my $node (values %$n)
      {
      $count++ if $node->is_anon();
      }
    return $count;
    }

  my @anon = ();
  for my $node (values %$n)
    {
    push @anon, $node if $node->is_anon();
    }
  @anon;
  }

sub edges
  {
  # Return all the edges this graph contains as objects
  my ($self) = @_;

  my $e = $self->{edges};

  return scalar keys %$e unless wantarray;	# shortcut

  values %$e;
  }

sub edges_within
  {
  # return all the edges as objects
  my ($self) = @_;

  my $e = $self->{edges};

  return scalar keys %$e unless wantarray;	# shortcut

  values %$e;
  }

sub sorted_nodes
  {
  # return all nodes as objects, sorted by $f1 or $f1 and $f2
  my ($self, $f1, $f2) = @_;

  return scalar keys %{$self->{nodes}} unless wantarray;	# shortcut

  $f1 = 'id' unless defined $f1;
  # sorting on a non-unique field alone will result in unpredictable
  # sorting order due to hashing
  $f2 = 'name' if !defined $f2 && $f1 !~ /^(name|id)$/;

  my $sort;
  $sort = sub { $a->{$f1} <=> $b->{$f1} } if $f1;
  $sort = sub { abs($a->{$f1}) <=> abs($b->{$f1}) } if $f1 && $f1 eq 'rank';
  $sort = sub { $a->{$f1} cmp $b->{$f1} } if $f1 && $f1 =~ /^(name|title|label)$/;
  $sort = sub { $a->{$f1} <=> $b->{$f1} || $a->{$f2} <=> $b->{$f2} } if $f2;
  $sort = sub { abs($a->{$f1}) <=> abs($b->{$f1}) || $a->{$f2} <=> $b->{$f2} } if $f2 && $f1 eq 'rank';
  $sort = sub { $a->{$f1} <=> $b->{$f1} || abs($a->{$f2}) <=> abs($b->{$f2}) } if $f2 && $f2 eq 'rank';
  $sort = sub { $a->{$f1} <=> $b->{$f1} || $a->{$f2} cmp $b->{$f2} } if $f2 &&
           $f2 =~ /^(name|title|label)$/;
  $sort = sub { abs($a->{$f1}) <=> abs($b->{$f1}) || $a->{$f2} cmp $b->{$f2} } if 
           $f1 && $f1 eq 'rank' &&
           $f2 && $f2 =~ /^(name|title|label)$/;
  # 'name', 'id'
  $sort = sub { $a->{$f1} cmp $b->{$f1} || $a->{$f2} <=> $b->{$f2} } if $f2 &&
           $f2 eq 'id' && $f1 ne 'rank';

  # the 'return' here should not be removed
  return sort $sort values %{$self->{nodes}};
  }

sub add_edge_once
  {
  # add an edge, unless it already exists. In that case it returns undef
  my ($self, $x, $y, $edge) = @_;

  # got an edge object? Don't add it twice!
  return undef if ref($edge);

  # turn plaintext scalars into objects 
  my $x1 = $self->{nodes}->{$x} unless ref $x;
  my $y1 = $self->{nodes}->{$y} unless ref $y;

  # nodes do exist => maybe the edge also exists
  if (ref($x1) && ref($y1))
    {
    my @ids = $x1->edges_to($y1);

    return undef if @ids;	# found already one edge?
    }

  $self->add_edge($x,$y,$edge);
  }

sub edge
  {
  # return an edge between two nodes as object
  my ($self, $x, $y) = @_;

  # turn plaintext scalars into objects 
  $x = $self->{nodes}->{$x} unless ref $x;
  $y = $self->{nodes}->{$y} unless ref $y;

  # node does not exist => edge does not exist
  return undef unless ref($x) && ref($y);

  my @ids = $x->edges_to($y);
  
  wantarray ? @ids : $ids[0];
  }

sub flip_edges
  {
  # turn all edges going from $x to $y around
  my ($self, $x, $y) = @_;

  # turn plaintext scalars into objects 
  $x = $self->{nodes}->{$x} unless ref $x;
  $y = $self->{nodes}->{$y} unless ref $y;

  # node does not exist => edge does not exist
  # if $x == $y, return early (no need to turn selfloops)

  return $self unless ref($x) && ref($y) && ($x != $y);

  for my $e (values %{$x->{edges}})
    {
    $e->flip() if $e->{from} == $x && $e->{to} == $y;
    }

  $self;
  }

sub node
  {
  # return node by name
  my ($self,$name) = @_;
  $name = '' unless defined $name;

  $self->{nodes}->{$name};
  }

sub rename_node
  {
  # change the name of a node
  my ($self, $node, $new_name) = @_;

  $node = $self->{nodes}->{$node} unless ref($node);

  if (!ref($node))
    {
    $node = $self->add_node($new_name);
    }
  else
    {
    if (!ref($node->{graph}))
      {
      # add node to ourself
      $node->{name} = $new_name;
      $self->add_node($node);
      }
    else
      {
      if ($node->{graph} != $self)
        {
	$node->{graph}->del_node($node);
	$node->{name} = $new_name;
	$self->add_node($node);
	}
      else
	{
	delete $self->{nodes}->{$node->{name}};
	$node->{name} = $new_name;
	$self->{nodes}->{$node->{name}} = $node;
	}
      }
    }
  if ($node->is_anon())
    {
    # turn anon nodes into a normal node (since it got a new name):
    bless $node, $self->{use_class}->{node} || 'Graph::Easy::Node';
    delete $node->{att}->{label} if $node->{att}->{label} eq ' ';
    $node->{class} = 'group';
    }
  $node;
  }

sub rename_group
  {
  # change the name of a group
  my ($self, $group, $new_name) = @_;

  if (!ref($group))
    {
    $group = $self->add_group($new_name);
    }
  else
    {
    if (!ref($group->{graph}))
      {
      # add node to ourself
      $group->{name} = $new_name;
      $self->add_group($group);
      }
    else
      {
      if ($group->{graph} != $self)
        {
	$group->{graph}->del_group($group);
	$group->{name} = $new_name;
	$self->add_group($group);
	}
      else
	{
	delete $self->{groups}->{$group->{name}};
	$group->{name} = $new_name;
	$self->{groups}->{$group->{name}} = $group;
	}
      }
    }
  if ($group->is_anon())
    {
    # turn anon groups into a normal group (since it got a new name):
    bless $group, $self->{use_class}->{group} || 'Graph::Easy::Group';
    delete $group->{att}->{label} if $group->{att}->{label} eq '';
    $group->{class} = 'group';
    }
  $group;
  }

#############################################################################
# attribute handling

sub _check_class
  {
  # Check the given class ("graph", "node.foo" etc.) or class selector
  # (".foo") for being valid, and return a list of base classes this applies
  # to. Handles also a list of class selectors like ".foo, .bar, node.foo".
  my ($self, $selector) = @_;

  my @parts = split /\s*,\s*/, $selector;

  my @classes = ();
  for my $class (@parts)
    {
    # allowed classes, subclasses (except "graph."), selectors (excpet ".")
    return unless $class =~ /^(\.\w|node|group|edge|graph\z)/;
    # "node." is invalid, too
    return if $class =~ /\.\z/;

    # run a loop over all classes: "node.foo" => ("node"), ".foo" => ("node","edge","group")
    $class =~ /^(\w*)/; 
    my $base_class = $1; 
    if ($base_class eq '')
      {
      push @classes, ('edge'.$class, 'group'.$class, 'node'.$class);
      }
    else
      {
      push @classes, $class;
      }
    } # end for all parts

  @classes;
  }

sub set_attribute
  {
  my ($self, $class_selector, $name, $val) = @_;

  # allow calling in the style of $graph->set_attribute($name,$val);
  if (@_ == 3)
    {
    $val = $name;
    $name = $class_selector;
    $class_selector = 'graph';
    }

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

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

  my @classes = $self->_check_class($class_selector);

  return $self->error ("Illegal class '$class_selector' when trying to set attribute '$name' to '$val'")
    if @classes == 0;

  for my $class (@classes)
    {
    $val = $self->unquote_attribute($class,$name,$val);

    if ($self->{strict})
      {
      my ($rc, $newname, $v) = $self->validate_attribute($name,$val,$class);
      return if defined $rc;		# error?

      $val = $v;
      }

    $self->{score} = undef;	# invalidate layout to force a new layout
    delete $self->{cache};	# setting a class or flow must invalidate the cache

    # handle special attribute 'gid' like in "graph { gid: 123; }"
    if ($class eq 'graph')
      {
      if ($name =~ /^g?id\z/)
        {
        $self->{id} = $val;
        }
      # handle special attribute 'output' like in "graph { output: ascii; }"
      if ($name eq 'output')
        {
        $self->{output_format} = $val;
        }
      }

    my $att = $self->{att};
    # create hash if it doesn't exist yet
    $att->{$class} = {} unless ref $att->{$class};

    if ($name eq 'border')
      {
      my $c = $att->{$class};

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

      return $val;
      }

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

    } # end for all selected classes

  $val;
  }

sub set_attributes
  {
  my ($self, $class_selector, $att) = @_;

  # if called as $graph->set_attributes( { color => blue } ), assume
  # class eq 'graph'

  if (defined $class_selector && !defined $att)
    {
    $att = $class_selector; $class_selector = 'graph';
    }

  my @classes = $self->_check_class($class_selector);

  return $self->error ("Illegal class '$class_selector' when trying to set attributes")
    if @classes == 0;

  foreach my $a (keys %$att)
    {
    for my $class (@classes)
      {
      $self->set_attribute($class, $a, $att->{$a});
      }
    } 
  $self;
  }

sub del_attribute
  {
  # delete the attribute with the name in the selected class(es)
  my ($self, $class_selector, $name) = @_;

  if (@_ == 2)
    {
    $name = $class_selector; $class_selector = 'graph';
    }

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

  my @classes = $self->_check_class($class_selector);

  return $self->error ("Illegal class '$class_selector' when trying to delete attribute '$name'")
    if @classes == 0;

  for my $class (@classes)
    {
    my $a = $self->{att}->{$class};

    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;
  }

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

# for determining the absolute graph 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 flow
  {
  # return out flow as number
  my ($self)  = @_;

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

  return 90 unless defined $flow;

  my $f = $p_flow->{$flow}; $f = $flow unless defined $f;
  $f;
  }

#############################################################################
#############################################################################
# Output (as_ascii, as_html) routines; as_txt() is in As_txt.pm, as_graphml
# is in As_graphml.pm

sub output_format
  {
  # set the output format
  my $self = shift;

  $self->{output_format} = shift if $_[0];
  $self->{output_format};
  }

sub output
  {
  # general output routine, to output the graph as the format that was
  # specified in the graph source itself
  my $self = shift;

  no strict 'refs';

  my $method = 'as_' . $self->{output_format};

  $self->_croak("Cannot find a method to generate '$self->{output_format}'")
    unless $self->can($method);

  $self->$method();
  }

sub _class_styles
  {
  # Create the style sheet with the class lists. This is used by both
  # css() and as_svg(). $skip is a qr// object that returns true for
  # attribute names to be skipped (e.g. excluded), and $map is a
  # HASH that contains mapping for attribute names for the output.
  # "$base" is the basename for classes (either "table.graph$id" if 
  # not defined, or whatever you pass in, like "" for svg).
  # $indent is a left-indenting spacer like "  ".
  # $overlay contains a HASH with attribute-value pairs to set as defaults.

  my ($self, $skip, $map, $base, $indent, $overlay) = @_;

  my $a = $self->{att};

  $indent = '' unless defined $indent;
  my $indent2 = $indent x 2; $indent2 = '  ' if $indent2 eq '';

  my $class_list = { edge => {}, node => {}, group => {} };
  if (defined $overlay)
    {
    $a = {};

    # make a copy from $self->{att} to $a:

    for my $class (keys %{$self->{att}})
      {
      my $ac = $self->{att}->{$class};
      $a->{$class} = {};
      my $acc = $a->{$class};
      for my $k (keys %$ac)
        {
        $acc->{$k} = $ac->{$k};
        }
      }

    # add the extra keys
    for my $class (keys %$overlay)
      {
      my $oc = $overlay->{$class};
      # create the hash if it doesn't exist yet
      $a->{$class} = {} unless ref $a->{$class};
      my $acc = $a->{$class};
      for my $k (keys %$oc)
        {
        $acc->{$k} = $oc->{$k} unless exists $acc->{$k};
        }
      $class_list->{$class} = {};
      }
    }

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

  my @primaries = sort keys %$class_list;
  foreach my $primary (@primaries)
    {
    my $cl = $class_list->{$primary};			# shortcut
    foreach my $class (sort keys %$a)
      {
      if ($class =~ /^$primary\.(.*)/)
        {
        $cl->{$1} = undef;				# note w/o doubles
        }
      }
    }

  $base = "table.graph$id " unless defined $base;

  my $groups = $self->groups();				# do we have groups?

  my $css = '';
  foreach my $class (sort keys %$a)
    {
    next if keys %{$a->{$class}} == 0;			# skip empty ones

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

    next if $class eq 'group' and $groups == 0;

    my $css_txt = '';
    my $cls = '';
    if ($class eq 'graph' && $base eq '')
      {
      $css_txt .= "${indent}.$class \{\n";			# for SVG
      }
    elsif ($class eq 'graph')
      {
      $css_txt .= "$indent$base\{\n";
      }
    else
      {
      if ($c !~ /\./)					# one of our primary ones
        {
        # generate also class list 			# like: "cities,node_rivers"
        $cls = join (",$base.${c}_", sort keys %{ $class_list->{$c} });
        $cls = ",$base.${c}_$cls" if $cls ne '';		# like: ",node_cities,node_rivers"
        }
      $css_txt .= "$indent$base.$c$cls {\n";
      }
    my $done = 0;
    foreach my $att (sort keys %{$a->{$class}})
      {
      # should be skipped?
      next if $att =~ $skip || $att eq 'border';

      # do not specify attributes for the entire graph (only for the label)
      # $base ne '' skips this rule for SVG output
      next if $class eq 'graph' && $base ne '' && $att =~ /^(color|font|fontsize|align|fill)\z/;

      $done++;						# how many did we really?
      my $val = $a->{$class}->{$att};

      next if !defined $val;

      # for groups, set to none, it will be later overriden for the different
      # cells (like "ga") with a border only on the appropriate side:
      $val = 'none' if $att eq 'borderstyle' && $class eq 'group';
      # fix border-widths to be in pixel
      $val .= 'px' if $att eq 'borderwidth' && $val !~ /(px|em|%)\z/;

      # for color attributes, convert to hex
      my $entry = $self->_attribute_entry($class, $att);

      if (defined $entry)
	{
	my $type = $entry->[ ATTR_TYPE_SLOT ] || ATTR_STRING;
	if ($type == ATTR_COLOR)
	  {
	  # create as RGB color
	  $val = $self->get_color_attribute($class,$att) || $val;
	  }
	}
      # change attribute name/value?
      if (exists $map->{$att})
	{
        $att = $map->{$att} unless ref $map->{$att};		# change attribute name?
        ($att,$val) = &{$map->{$att}}($self,$att,$val,$class) if ref $map->{$att};
	}

      # value is "inherit"?
      if ($class ne 'graph' && $att && $val && $val eq 'inherit')
        {
        # get the value from one class "up"

	# node.foo => node, node => graph
        my $base_class = $class; $base_class = 'graph' unless $base_class =~ /\./;
	$base_class =~ s/\..*//;

        $val = $a->{$base_class}->{$att};

	if ($base_class ne 'graph' && (!defined $val || $val eq 'inherit'))
	  {
	  # node.foo => node, inherit => graph
          $val = $a->{graph}->{$att};
	  $att = undef if !defined $val;
	  }
	}

      $css_txt .= "$indent2$att: $val;\n" if defined $att && defined $val;
      }

    $css_txt .= "$indent}\n";
    $css .= $css_txt if $done > 0;			# skip if no attributes at all
    }
  $css;
  }

sub _skip
  {
  # return a regexp that specifies which attributes to suppress in CSS
  my ($self) = shift;

  # skip these for CSS
  qr/^(basename|columns|colorscheme|comment|class|flow|format|group|rows|root|size|offset|origin|linkbase|(auto)?(label|link|title)|auto(join|split)|(node|edge)class|shape|arrowstyle|label(color|pos)|point(style|shape)|textstyle|style)\z/;
  }

#############################################################################
# These routines are used by as_html for the generation of CSS

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

  return (undef,undef) if $style ne 'auto';

  # make text wrap again
  ('white-space','normal');
  }

sub _remap_fill
  {
  my ($self,$name,$color,$class) = @_;

  return ('background',$color) unless $class =~ /edge/;

  # for edges, the fill is ignored
  (undef,undef);
  }

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

sub css
  {
  my $self = shift;

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

  # for each primary class (node/group/edge) we need to find all subclasses,
  # and list them in the CSS, too. Otherwise "node_city" would not inherit
  # the attributes from "node".

  my $css = $self->_class_styles( $self->_skip(),
    {
      fill => \&_remap_fill,
      textwrap => \&_remap_text_wrap,
      align => 'text-align',
      font => 'font-family',
      fontsize => 'font-size',
      bordercolor => 'border-color',
      borderstyle => 'border-style',
      borderwidth => 'border-width',
    },
    undef,
    undef, 
    $html_att,
    );

  my @groups = $self->groups();

  # Set attributes for all TDs that start with "group":
  $css .= <<CSS
table.graph##id## td[class|="group"] { padding: 0.2em; }
CSS
  if @groups > 0;

  $css .= <<CSS
table.graph##id## td {
  padding: 2px;
  background: inherit;
  white-space: nowrap;
  }
table.graph##id## span.l { float: left; }
table.graph##id## span.r { float: right; }
CSS
;

  # append CSS for edge cells (and their parts like va (vertical arrow
  # (left/right), vertical empty), etc)

  # eb	- empty bottom or arrow pointing down/up
  # el  - (vertical) empty left space of ver edge
  #       or empty vertical space on hor edge starts
  # lh  - edge label horizontal
  # le  - edge label, but empty (no label)
  # lv  - edge label vertical
  # sh  - shifted arrow horizontal (shift right)
  # sa  - shifted arrow horizontal (shift left for corners)
  # shl - shifted arrow horizontal (shift left)
  # sv  - shifted arrow vertical (pointing down)
  # su  - shifted arrow vertical (pointing up)

  $css .= <<CSS
table.graph##id## .va {
  vertical-align: middle;
  line-height: 1em;
  width: 0.4em;
  }
table.graph##id## .el {
  width: 0.1em;
  max-width: 0.1em;
  min-width: 0.1em;
  }
table.graph##id## .lh, table.graph##id## .lv {
  font-size: 0.8em;
  padding-left: 0.4em;
  }
table.graph##id## .sv, table.graph##id## .sh, table.graph##id## .shl, table.graph##id## .sa, table.graph##id## .su {
  max-height: 1em;
  line-height: 1em;
  position: relative;
  top: 0.55em;
  left: -0.3em;
  overflow: visible;
  }
table.graph##id## .sv, table.graph##id## .su {
  max-height: 0.5em;
  line-height: 0.5em;
  }
table.graph##id## .shl { left: 0.3em; }
table.graph##id## .sv { left: -0.5em; top: -0.4em; }
table.graph##id## .su { left: -0.5em; top: 0.4em; }
table.graph##id## .sa { left: -0.3em; top: 0; }
table.graph##id## .eb { max-height: 0; line-height: 0; height: 0; }
CSS
  # if we have edges
  if keys %{$self->{edges}}  > 0;

  # if we have nodes with rounded shapes:
  my $rounded = 0;
  for my $n (values %{$self->{nodes}})
    {
    $rounded ++ and last if $n->shape() =~ /circle|ellipse|rounded/;
    }

  $css .= <<CSS
table.graph##id## span.c { position: relative; top: 1.5em; }
table.graph##id## div.c { -moz-border-radius: 100%; border-radius: 100%; }
table.graph##id## div.r { -moz-border-radius: 1em; border-radius: 1em; }
CSS
  if $rounded > 0;

  # append CSS for group cells (only if we actually have groups)

  if (@groups > 0)
    {
    foreach my $group (@groups)
      {
      my $class = $group->class();

      my $border = $group->attribute('borderstyle'); 

      $class =~ s/.*\.//;	# leave only subclass
      $css .= Graph::Easy::Group::Cell->_css($self->{id}, $class, $border); 
      }
    }

  # replace the id with either '' or '123', depending on our ID
  $css =~ s/##id##/$id/g;

  $css;
  }

sub html_page_header
  {
  # return the HTML header for as_html_file()
  my ($self, $css) = @_;
  
  my $html = <<HTML
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
 <head>
 <meta http-equiv="Content-Type" content="text/html; charset=##charset##">
 <title>##title##</title>##CSS##
</head>
<body bgcolor=white text=black>
HTML
;

  $html =~ s/\n\z//;
  $html =~ s/##charset##/utf-8/g;
  my $t = $self->title();
  $html =~ s/##title##/$t/g;

  # insert CSS if requested
  $css = $self->css() unless defined $css;

  $html =~ s/##CSS##/\n <style type="text\/css">\n <!--\n $css -->\n <\/style>/ if $css ne '';
  $html =~ s/##CSS##//;

  $html;
  }

sub title
  {
  my $self = shift;

  my $title = $self->{att}->{graph}->{title};
  $title = $self->{att}->{graph}->{label} if !defined $title;
  $title = 'Untitled graph' if !defined $title;

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

sub html_page_footer
  {
  # return the HTML footer for as_html_file()
  my $self = shift;

  "\n</body></html>\n";
  }

sub as_html_file
  {
  my $self = shift;

  $self->html_page_header() . $self->as_html() . $self->html_page_footer();
  }

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

sub _caption
  {
  # create the graph label as caption
  my $self = shift;

  my ($caption,$switch_to_center) = $self->_label_as_html();

  return ('','') unless defined $caption && $caption ne '';

  my $bg = $self->raw_color_attribute('fill');

  my $style = ' style="';
  $style .= "background: $bg;" if $bg;
    
  # the font family
  my $f = $self->raw_attribute('font') || '';
  $style .= "font-family: $f;" if $f ne '';

  # the text color
  my $c = $self->raw_color_attribute('color');
  $style .= "color: $c;" if $c;

  # bold, italic, underline, incl. fontsize and align
  $style .= $self->text_styles_as_css();

  $style =~ s/;\z//;				# remove last ';'
  $style .= '"' unless $style eq ' style="';

  $style =~ s/style="\s/style="/;		# remove leading space

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

  if ($link ne '')
    {
    # encode critical entities
    $link =~ s/\s/\+/g;				# space
    $link =~ s/'/%27/g;				# replace quotation marks
    $caption = "<a href='$link'>$caption</a>";
    }

  $caption = "<tr>\n  <td colspan=##cols##$style>$caption</td>\n</tr>\n";

  my $pos = $self->attribute('labelpos');

  ($caption,$pos);
  } 

sub as_html
  {
  # convert the graph to HTML+CSS
  my ($self) = shift;

  $self->layout() unless defined $self->{score};

  my $top = "\n" . $self->quoted_comment();
  
  my $cells = $self->{cells};
  my ($rows,$cols);
  
  my $max_x = undef;
  my $min_x = undef;

  # find all x and y occurances to sort them by row/columns
  for my $k (keys %$cells)
    {
    my ($x,$y) = split/,/, $k;
    my $node = $cells->{$k};

    $max_x = $x if !defined $max_x || $x > $max_x;
    $min_x = $x if !defined $min_x || $x < $min_x;
    
    # trace the rows we do have
    $rows->{$y}->{$x} = $node;
    # record all possible columns
    $cols->{$x} = undef;
    }
  
  $max_x = 1, $min_x = 1 unless defined $max_x;
  
  # number of cells in the table, maximum  
  my $max_cells = $max_x - $min_x + 1;
  
  my $groups = scalar $self->groups();

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

  $top .=  "\n<table class=\"graph$id\" cellpadding=0 cellspacing=0";
  $top .= ">\n";

  my $html = '';

  # prepare the graph label
  my ($caption,$pos) = $self->_caption();

  my $row_id = 0;
  # now run through all rows, and for each of them through all columns 
  for my $y (sort { ($a||0) <=> ($b||0) } keys %$rows)
    {

    # four rows at a time
    my $rs = [ [], [], [], [] ];

    # for all possible columns
    for my $x (sort { $a <=> $b } keys %$cols)
      {
      if (!exists $rows->{$y}->{$x})
	{
	# fill empty spaces with undef, but not for parts of multicelled objects:
	push @{$rs->[0]}, undef;
	next;
	}
      my $node = $rows->{$y}->{$x};
      next if $node->isa('Graph::Easy::Node::Cell');		# skip empty cells

      my $h = $node->as_html();

      if (ref($h) eq 'ARRAY')
        {
        #print STDERR '# expected 4 rows, but got ' . scalar @$h if @$h != 4;
        local $_; my $i = 0;
        push @{$rs->[$i++]}, $_ for @$h;
        }
      else
        {
        push @{$rs->[0]}, $h;
        }
      }

    ######################################################################
    # remove trailing empty tag-pairs, then replace undef with empty tags

    for my $row (@$rs)
      {
      pop @$row while (@$row > 0 && !defined $row->[-1]);
      local $_;
      foreach (@$row)
        {
        $_ = " <td colspan=4 rowspan=4></td>\n" unless defined $_;
        }
      }

    # now combine equal columns to shorten output
    for my $row (@$rs)
      {
      next;

      # append row to output
      my $i = 0;
      while ($i < @$row)
        {
        next if $row->[$i] =~ /border(:|-left)/;
#        next if $row->[$i] !~ />(\&nbsp;)?</;	# non-empty?
#        next if $row->[$i] =~ /span /;		# non-empty?
#        next if $row->[$i] =~ /^(\s|\n)*\z/;	# empty?

	# Combining these cells shows wierd artefacts when using the Firefox
	# WebDeveloper toolbar and outlining table cells, but it does not
	# seem to harm rendering in browsers:
        #next if $row->[$i] =~ /class="[^"]+ eb"/;	# is class=".. eb"

	# contains wo succ. cell?
        next if $row->[$i] =~ /(row|col)span.*\1span/m;	

        # count all sucessive equal ones
        my $j = $i + 1;

        $j++ while ($j < @$row && $row->[$j] eq $row->[$i]); # { $j++; }

        if ($j > $i + 1)
          {
          my $cnt = $j - $i - 1;

#         print STDERR "combining row $i to $j ($cnt) (\n'$row->[$i]'\n'$row->[$i+1]'\n'$row->[$j-1]'\n";

          # throw away
          splice (@$row, $i + 1, $cnt);

          # insert empty colspan if not already there
          $row->[$i] =~ s/<td/<td colspan=0/ unless $row->[$i] =~ /colspan/;
          # replace
          $row->[$i] =~ s/colspan=(\d+)/'colspan='.($1+$cnt*4)/e;
          }
        } continue { $i++; }
      }

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

    my $i = 0;    
    for my $row (@$rs)
      {
      # append row to output
      my $r = join('',@$row);

      if ($r !~ s/^[\s\n]*\z//)
	{
        # non empty rows get "\n</tr>"
        $r = "\n" . $r; # if length($r) > 0;
        }

      $html .= "<!-- row $row_id line $i -->\n" . '<tr>' . $r . "</tr>\n\n";
      $i++;
      }
    $row_id++;
    }

  ###########################################################################
  # finally insert the graph label
  $max_cells *= 4;					# 4 rows for each cell
  $caption =~ s/##cols##/$max_cells/ if defined $caption;

  $html .= $caption if $pos eq 'bottom';
  $top .= $caption if $pos eq 'top';

  $html = $top . $html;

  # remove empty trailing <tr></tr> pairs
  $html =~ s#(<tr></tr>\n\n)+\z##;

  $html .= "</table>\n";
 
  $html;
  } 

############################################################################# 
# as_boxart_*
  
sub as_boxart
  {
  # Create box-drawing art using Unicode characters - will return utf-8.
  my ($self) = shift;

  require Graph::Easy::As_ascii;
  
  # select Unicode box drawing characters
  $self->{_ascii_style} = 1;

  $self->_as_ascii(@_);
  }

sub as_boxart_html
  {
  # Output a box-drawing using Unicode, then return it as a HTML chunk
  # suitable to be embedded into an HTML page.
  my ($self) = shift;

  "<pre style='line-height: 1em; line-spacing: 0;'>\n" . 
    $self->as_boxart(@_) . 
    "\n</pre>\n";
  }

sub as_boxart_html_file
  {
  my $self = shift;

  $self->layout() unless defined $self->{score};

  $self->html_page_header(' ') . "\n" . 
    $self->as_boxart_html() . $self->html_page_footer();
  }

#############################################################################
# as_ascii_*

sub as_ascii
  {
  # Convert the graph to pretty ASCII art - will return utf-8.
  my $self = shift;

  # select 'ascii' characters
  $self->{_ascii_style} = 0;

  $self->_as_ascii(@_);
  }

sub _as_ascii
  {
  # Convert the graph to pretty ASCII or box art art - will return utf-8.
  my $self = shift;

  require Graph::Easy::As_ascii;
  require Graph::Easy::Layout::Grid;

  my $opt = ref($_[0]) eq 'HASH' ? $_[0] : { @_ };

  # include links?
  $self->{_links} = $opt->{links};

  $self->layout() unless defined $self->{score};

  # generate for each cell the width/height etc

  my ($rows,$cols,$max_x,$max_y) = $self->_prepare_layout('ascii');
  my $cells = $self->{cells};

  # offset where to draw the graph (non-zero if graph has label)
  my $y_start = 0;
  my $x_start = 0;

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

  # get the label lines and their alignment
  my ($label,$aligns) = $self->_aligned_label($align);

  # if the graph has a label, reserve space for it
  my $label_pos = 'top';
  if (@$label > 0)
    {
    # insert one line over and below
    unshift @$label, '';   push @$label, '';
    unshift @$aligns, 'c'; push @$aligns, 'c';

    $label_pos = $self->attribute('graph','label-pos') || 'top';
    $y_start += scalar @$label if $label_pos eq 'top';
    $max_y += scalar @$label + 1;
    print STDERR "# Graph with label, position $label_pos\n" if $self->{debug};

    my $old_max_x = $max_x;
    # find out the dimensions of the label and make sure max_x is big enough
    for my $l (@$label)
      {
      $max_x = length($l)+2 if (length($l) > $max_x+2);
      }
    $x_start = int(($max_x - $old_max_x) / 2);
    }

  print STDERR "# Allocating framebuffer $max_x x $max_y\n" if $self->{debug};

  # generate the actual framebuffer for the output
  my $fb = Graph::Easy::Node->_framebuffer($max_x, $max_y);

  # output the label
  if (@$label > 0)
    {
    my $y = 0; $y = $max_y - scalar @$label if $label_pos eq 'bottom';
    Graph::Easy::Node->_printfb_aligned($fb, 0, $y, $max_x, $max_y, $label, $aligns, 'top');
    }

  # draw all cells into framebuffer
  foreach my $v (values %$cells)
    {
    next if $v->isa('Graph::Easy::Node::Cell');		# skip empty cells

    # get as ASCII box
    my $x = $cols->{ $v->{x} } + $x_start;
    my $y = $rows->{ $v->{y} } + $y_start;
 
    my @lines = split /\n/, $v->as_ascii($x,$y);
    # get position from cell
    for my $i (0 .. scalar @lines-1)
      {
      next if length($lines[$i]) == 0;
      # XXX TODO: framebuffer shouldn't be to small!
      $fb->[$y+$i] = ' ' x $max_x if !defined $fb->[$y+$i];
      substr($fb->[$y+$i], $x, length($lines[$i])) = $lines[$i]; 
      }
    }

  for my $y (0..$max_y)
    {
    $fb->[$y] = '' unless defined $fb->[$y];
    $fb->[$y] =~ s/\s+\z//;		# remove trailing whitespace
    }
  my $out = join("\n", @$fb) . "\n";

  $out =~ s/\n+\z/\n/;		# remove trailing empty lines

  # restore height/width of cells from minw/minh
  foreach my $v (values %$cells)
    {
    $v->{h} = $v->{minh};
    $v->{w} = $v->{minw};
    } 
  $out;				# return output
  }

sub as_ascii_html
  {
  # Convert the graph to pretty ASCII art, then return it as a HTML chunk
  # suitable to be embedded into an HTML page.
  my ($self) = shift;

  "<pre>\n" . $self->_as_ascii(@_) . "\n</pre>\n";
  }

#############################################################################
# as_txt, as_debug, as_graphviz

sub as_txt
  {
  require Graph::Easy::As_txt;

  _as_txt(@_);
  }

sub as_graphviz
  {
  require Graph::Easy::As_graphviz;

  _as_graphviz(@_);
  }

sub as_debug
  {
  require Graph::Easy::As_txt;
  eval { require Graph::Easy::As_svg; };

  my $self = shift;

  my $output = '';
 
  $output .= '# Using Graph::Easy v' . $Graph::Easy::VERSION . "\n";
  if ($Graph::Easy::As_svg::VERSION)
    {
    $output .= '# Using Graph::Easy::As_svg v' . $Graph::Easy::As_svg::VERSION . "\n";
    }
  $output .= '# Running Perl v' . $] . " under $^O\n";

  $output . "\n# Input normalized as_txt:\n\n" . $self->_as_txt(@_);
  }

#############################################################################
# as_vcg(as_gdl

sub as_vcg
  {
  require Graph::Easy::As_vcg;

  _as_vcg(@_);
  }

sub as_gdl
  {
  require Graph::Easy::As_vcg;

  _as_vcg(@_, { gdl => 1 });
  }

#############################################################################
# as_svg

sub as_svg
  {
  require Graph::Easy::As_svg;
  require Graph::Easy::Layout::Grid;

  _as_svg(@_);
  }

sub as_svg_file
  {
  require Graph::Easy::As_svg;
  require Graph::Easy::Layout::Grid;

  _as_svg( $_[0], { standalone => 1 } );
  }

sub svg_information
  {
  my ($self) = @_;

  require Graph::Easy::As_svg;
  require Graph::Easy::Layout::Grid;

  # if it doesn't exist, render as SVG and thus create it
  _as_svg(@_) unless $self->{svg_info};

  $self->{svg_info};
  }

#############################################################################
# as_graphml

sub as_graphml
  {
  require Graph::Easy::As_graphml;

  _as_graphml(@_);
  }

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

sub add_edge
  {
  my ($self,$x,$y,$edge) = @_;
 
  my $uc = $self->{use_class};

  my $ec = $uc->{edge};
  $edge = $ec->new() unless defined $edge;
  $edge = $ec->new(label => $edge) unless ref($edge);

  $self->_croak("Adding an edge object twice is not possible")
    if (exists ($self->{edges}->{$edge->{id}}));

  $self->_croak("Cannot add edge $edge ($edge->{id}), it already belongs to another graph")
    if ref($edge->{graph}) && $edge->{graph} != $self;

  my $nodes = $self->{nodes};
  my $groups = $self->{groups};

  $self->_croak("Cannot add edge for undefined node names ($x -> $y)")
    unless defined $x && defined $y;

  my $xn = $x; my $yn = $y;
  $xn = $x->{name} if ref($x);
  $yn = $y->{name} if ref($y);

  # convert plain scalars to Node objects if nec.

  # XXX TODO: this might be a problem when adding an edge from a group with the same
  #           name as a node

  $x = $nodes->{$xn} if exists $nodes->{$xn};		# first look them up
  $y = $nodes->{$yn} if exists $nodes->{$yn};

  $x = $uc->{node}->new( $x ) unless ref $x;		# if this fails, create
  $y = $x if !ref($y) && $y eq $xn;			# make add_edge('A','A') work
  $y = $uc->{node}->new( $y ) unless ref $y;

  print STDERR "# add_edge '$x->{name}' ($x->{id}) -> '$y->{name}' ($y->{id}) (edge $edge->{id}) ($x -> $y)\n" if $self->{debug};

  for my $n ($x,$y)
    {
    $self->_croak("Cannot add node $n ($n->{name}), it already belongs to another graph")
      if ref($n->{graph}) && $n->{graph} != $self;
    }

  # Register the nodes and the edge with our graph object
  # and weaken the references. Be carefull to not needlessly
  # override and weaken again an already existing reference, this
  # is an O(N) operation in most Perl versions, and thus very slow.

  weaken($x->{graph} = $self) unless ref($x->{graph});
  weaken($y->{graph} = $self) unless ref($y->{graph});
  weaken($edge->{graph} = $self) unless ref($edge->{graph});

  # Store at the edge from where to where it goes for easier reference
  $edge->{from} = $x;
  $edge->{to} = $y;
 
  # store the edge at the nodes/groups, too
  $x->{edges}->{$edge->{id}} = $edge;
  $y->{edges}->{$edge->{id}} = $edge;

  # index nodes by their name so that we can find $x from $x->{name} fast
  my $store = $nodes; $store = $groups if $x->isa('Graph::Easy::Group');
  $store->{$x->{name}} = $x;
  $store = $nodes; $store = $groups if $y->isa('Graph::Easy::Group');
  $store->{$y->{name}} = $y;

  # index edges by "edgeid" so we can find them fast
  $self->{edges}->{$edge->{id}} = $edge;

  $self->{score} = undef;			# invalidate last layout

  wantarray ? ($x,$y,$edge) : $edge;
  }

sub add_anon_node
  {
  my ($self) = shift;

  $self->warn('add_anon_node does not take argumens') if @_ > 0;

  my $node = Graph::Easy::Node::Anon->new();

  $self->add_node($node);

  $node;
  }

sub add_node
  {
  my ($self,$x) = @_;

  my $n = $x;
  if (ref($x))
    {
    $n = $x->{name}; $n = '0' unless defined $n;
    }

  return $self->_croak("Cannot add node with empty name to graph.") if $n eq '';

  return $self->_croak("Cannot add node $x ($n), it already belongs to another graph")
    if ref($x) && ref($x->{graph}) && $x->{graph} != $self;

  my $no = $self->{nodes};
  # already exists?
  return $no->{$n} if exists $no->{$n};

  my $uc = $self->{use_class};
  $x = $uc->{node}->new( $x ) unless ref $x;

  # store the node
  $no->{$n} = $x;

  # Register the nodes and the edge with our graph object
  # and weaken the references. Be carefull to not needlessly
  # override and weaken again an already existing reference, this
  # is an O(N) operation in most Perl versions, and thus very slow.

  weaken($x->{graph} = $self) unless ref($x->{graph});

  $self->{score} = undef;			# invalidate last layout

  $x;
  }

sub add_nodes
  {
  my $self = shift;

  my @rc;
  for my $x (@_)
    {
    my $n = $x;
    if (ref($x))
      {
      $n = $x->{name}; $n = '0' unless defined $n;
      }

    return $self->_croak("Cannot add node with empty name to graph.") if $n eq '';

    return $self->_croak("Cannot add node $x ($n), it already belongs to another graph")
      if ref($x) && ref($x->{graph}) && $x->{graph} != $self;

    my $no = $self->{nodes};
    # this one already exists
    next if exists $no->{$n};

    my $uc = $self->{use_class};
    # make it work with read-only scalars:
    my $xx = $x;
    $xx = $uc->{node}->new( $x ) unless ref $x;

    # store the node
    $no->{$n} = $xx;

    # Register the nodes and the edge with our graph object
    # and weaken the references. Be carefull to not needlessly
    # override and weaken again an already existing reference, this
    # is an O(N) operation in most Perl versions, and thus very slow.

    weaken($xx->{graph} = $self) unless ref($xx->{graph});

    push @rc, $xx;
    }

  $self->{score} = undef;			# invalidate last layout

  @rc;
  }

#############################################################################
#############################################################################
# Cloning/merging of graphs and objects

sub copy
  {
  # create a copy of this graph and return it as new graph
  my $self = shift;

  my $new = Graph::Easy->new();

  # clone all the settings
  for my $k (keys %$self)
    {
    $new->{$k} = $self->{$k} unless ref($self->{$k});
    }

  for my $g (keys %{$self->{groups}})
    {
    my $ng = $new->add_group($g);
    # clone the attributes
    $ng->{att} = $self->_clone( $self->{groups}->{$g}->{att} );
    }
  for my $n (values %{$self->{nodes}})
    {
    my $nn = $new->add_node($n->{name});
    # clone the attributes
    $nn->{att} = $self->_clone( $n->{att} );
    # restore group membership for the node
    $nn->add_to_group( $n->{group}->{name} ) if $n->{group};
    }
  for my $e (values %{$self->{edges}})
    {
    my $ne = $new->add_edge($e->{from}->{name}, $e->{to}->{name} );
    # clone the attributes
    $ne->{att} = $self->_clone( $e->{att} );
    }
  # clone the attributes
  $new->{att} = $self->_clone( $self->{att});

  $new;
  }

sub _clone
  {
  # recursively clone a data structure
  my ($self,$in) = @_;

  my $out = { };

  for my $k (keys %$in)
    {
    if (ref($k) eq 'HASH')
      {
      $out->{$k} = $self->_clone($in->{$k});
      }
    elsif (ref($k))
      {
      $self->error("Can't clone $k");
      }
    else
      {
      $out->{$k} = $in->{$k};
      }
    }
  $out;
  }

sub merge_nodes
  {
  # Merge two nodes, by dropping all connections between them, and then
  # drawing all connections from/to $B to $A, then drop $B
  my ($self, $A, $B, $joiner) = @_;

  $A = $self->node($A) unless ref($A);
  $B = $self->node($B) unless ref($B);

  # if the node is part of a group, deregister it first from there
  $B->{group}->del_node($B) if ref($B->{group});

  my @edges = values %{$A->{edges}};

  # drop all connections from A --> B
  for my $edge (@edges)
    {
    next unless $edge->{to} == $B;

#    print STDERR "# dropping $edge->{from}->{name} --> $edge->{to}->{name}\n";
    $self->del_edge($edge);
    }

  # Move all edges from/to B over to A, but drop "B --> B" and "B --> A".
  for my $edge (values %{$B->{edges}})
    {
    # skip if going from B --> A or B --> B
    next if $edge->{to} == $A || ($edge->{to} == $B && $edge->{from} == $B);

#    print STDERR "# moving $edge->{from}->{name} --> $edge->{to}->{name} to ";

    $edge->{from} = $A if $edge->{from} == $B;
    $edge->{to} = $A if $edge->{to} == $B;

#   print STDERR " $edge->{from}->{name} --> $edge->{to}->{name}\n";

    delete $B->{edges}->{$edge->{id}};
    $A->{edges}->{$edge->{id}} = $edge;
    }

  # should we join the label from B to A?
  $A->set_attribute('label', $A->label() . $joiner . $B->label() ) if defined $joiner;

  $self->del_node($B);

  $self;
  }

#############################################################################
# deletion

sub del_node
  {
  my ($self, $node) = @_;

  # make object
  $node = $self->{nodes}->{$node} unless ref($node);

  # doesn't exist, so we don't need to do anything
  return unless ref($node);

  # if node is part of a group, delete it there, too
  $node->{group}->del_node($node) if ref $node->{group};

  delete $self->{nodes}->{$node->{name}};

  # delete all edges from/to this node
  for my $edge (values %{$node->{edges}})
    {
    # drop the edge from our global edge list
    delete $self->{edges}->{$edge->{id}};
 
    my $to = $edge->{to}; my $from = $edge->{from};

    # drop the edge from the other node
    delete $from->{edges}->{$edge->{id}} if $from != $node;
    delete $to->{edges}->{$edge->{id}} if $to != $node;
    }

  # decouple node from the graph
  $node->{graph} = undef;
  # reset cached size
  $node->{w} = undef;

  # drop all edges from the node locally
  $node->{edges} = { };

  # if the node is a child of another node, deregister it there
  delete $node->{origin}->{children}->{$node->{id}} if defined $node->{origin};

  $self->{score} = undef;			# invalidate last layout

  $self;
  }

sub del_edge
  {
  my ($self, $edge) = @_;

  $self->_croak("del_edge() needs an object") unless ref $edge;

  # if edge is part of a group, delete it there, too
  $edge->{group}->_del_edge($edge) if ref $edge->{group};

  my $to = $edge->{to}; my $from = $edge->{from};

  # delete the edge from the nodes
  delete $from->{edges}->{$edge->{id}};
  delete $to->{edges}->{$edge->{id}};
  
  # drop the edge from our global edge list
  delete $self->{edges}->{$edge->{id}};

  $edge->{from} = undef;
  $edge->{to} = undef;

  $self;
  }

#############################################################################
# group management

sub add_group
  {
  # add a group object
  my ($self,$group) = @_;

  my $uc = $self->{use_class};

  # group with that name already exists?
  my $name = $group; 
  $group = $self->{groups}->{ $group } unless ref $group;

  # group with that name doesn't exist, so create new one
  $group = $uc->{group}->new( name => $name ) unless ref $group;

  # index under the group name for easier lookup
  $self->{groups}->{ $group->{name} } = $group;

  # register group with ourself and weaken the reference
  $group->{graph} = $self;
  {
    no warnings; # dont warn on already weak references
    weaken($group->{graph});
  } 
  $self->{score} = undef;			# invalidate last layout

  $group;
  }

sub del_group
  {
  # delete group
  my ($self,$group) = @_;

  delete $self->{groups}->{ $group->{name} };
 
  $self->{score} = undef;			# invalidate last layout

  $self;
  }

sub group
  {
  # return group by name
  my ($self,$name) = @_;

  $self->{groups}->{ $name };
  }

sub groups
  {
  # return number of groups (or groups as object list)
  my ($self) = @_;

  return sort { $a->{name} cmp $b->{name} } values %{$self->{groups}}
    if wantarray;

  scalar keys %{$self->{groups}};
  }

sub groups_within
  {
  # Return the groups that are directly inside this graph/group. The optional
  # level is either -1 (meaning return all groups contained within), or a
  # positive number indicating how many levels down we need to go.
  my ($self, $level) = @_;

  $level = -1 if !defined $level || $level < 0;

  # inline call to $self->groups;
  if ($level == -1)
    {
    return sort { $a->{name} cmp $b->{name} } values %{$self->{groups}}
      if wantarray;

    return scalar keys %{$self->{groups}};
    }

  my $are_graph = $self->{graph} ? 0 : 1;

  # get the groups at level 0
  my $current = 0;
  my @todo;
  for my $g (values %{$self->{groups}})
    {
    # no group set => belongs to graph, set to ourself => belongs to ourself
    push @todo, $g if ( ($are_graph && !defined $g->{group}) || $g->{group} == $self);
    }

  if ($level == 0)
    {
    return wantarray ? @todo : scalar @todo;
    }

  # we need to recursively count groups until the wanted level is reached
  my @cur = @todo;
  for my $g (@todo)
    {
    # _groups_within() is defined in Graph::Easy::Group
    $g->_groups_within(1, $level, \@cur);
    }

  wantarray ? @cur : scalar @cur;
  }

sub anon_groups
  {
  # return all anon groups as objects
  my ($self) = @_;

  my $n = $self->{groups};

  if (!wantarray)
    {
    my $count = 0;
    for my $group (values %$n)
      {
      $count++ if $group->is_anon();
      }
    return $count;
    }

  my @anon = ();
  for my $group (values %$n)
    {
    push @anon, $group if $group->is_anon();
    }
  @anon;
  }

sub use_class
  {
  # use the provided class for generating objects of the type $object
  my ($self, $object, $class) = @_;

  $self->_croak("Expected one of node, edge or group, but got $object")
    unless $object =~ /^(node|group|edge)\z/;

  $self->{use_class}->{$object} = $class;

  $self;  
  }

#############################################################################
#############################################################################
# Support for Graph interface to make Graph::Maker happy:

sub add_vertex
  {
  my ($self,$x) = @_;
  
  $self->add_node($x);
  $self;
  }

sub add_vertices
  {
  my ($self) = shift;
  
  $self->add_nodes(@_);
  $self;
  }

sub add_path
  {
  my ($self) = shift;

  my $first = shift;

  while (@_)
    {
    my $second = shift;
    $self->add_edge($first, $second );
    $first = $second; 
    }
  $self;
  }

sub add_cycle
  {
  my ($self) = shift;

  my $first = shift; my $a = $first;

  while (@_)
    {
    my $second = shift;
    $self->add_edge($first, $second );
    $first = $second; 
    }
  # complete the cycle
  $self->add_edge($first, $a);
  $self;
  }

sub has_edge
  {
  # return true if at least one edge between X and Y exists
  my ($self, $x, $y) = @_;

  # turn plaintext scalars into objects 
  $x = $self->{nodes}->{$x} unless ref $x;
  $y = $self->{nodes}->{$y} unless ref $y;

  # node does not exist => edge does not exist
  return 0 unless ref($x) && ref($y);

  scalar $x->edges_to($y) ? 1 : 0;
  }

sub set_vertex_attribute
  {
  my ($self, $node, $name, $value) = @_;

  $node = $self->add_node($node);
  $node->set_attribute($name,$value);

  $self;
  }

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

  $self->node($node)->get_attribute($name);
  }

#############################################################################
#############################################################################
# Animation support

sub animation_as_graph
  {
  my $self = shift;

  my $graph = Graph::Easy->new();

  $graph->add_node('onload');

  # XXX TODO

  $graph;
  }

1;
__END__