first commit

perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/As_graphml.pm

@@ -0,0 +1,396 @@
+#############################################################################
+# Output an Graph::Easy object as GraphML text
+#
+#############################################################################
+
+package Graph::Easy::As_graphml;
+
+$VERSION = '0.76';
+
+#############################################################################
+#############################################################################
+
+package Graph::Easy;
+
+use strict;
+use warnings;
+
+use Graph::Easy::Attributes;
+
+# map the Graph::Easy attribute types to a GraphML name:
+my $attr_type_to_name =
+  {
+  ATTR_STRING()	=> 'string',
+  ATTR_COLOR()	=> 'string',
+  ATTR_ANGLE()	=> 'double',
+  ATTR_PORT()	=> 'string',
+  ATTR_UINT()	=> 'integer',
+  ATTR_URL()	=> 'string',
+
+  ATTR_LIST()	=> 'string',
+  ATTR_LCTEXT()	=> 'string',
+  ATTR_TEXT()	=> 'string',
+  };
+
+sub _graphml_attr_keys
+  {
+  my ($self, $tpl, $tpl_no_default, $class, $att, $ids, $id) = @_;
+
+  my $base_class = $class; $base_class =~ s/\..*//;
+  $base_class = 'graph' if $base_class =~ /group/;
+  $ids->{$base_class} = {} unless ref $ids->{$base_class};
+
+  my $txt = '';
+  for my $name (sort keys %$att)
+    {
+    my $entry = $self->_attribute_entry($class,$name);
+    # get a fresh template
+    my $t = $tpl;
+    $t = $tpl_no_default unless defined $entry->[ ATTR_DEFAULT_SLOT ];
+
+    # only keep it once
+    next if exists $ids->{$base_class}->{$name};
+
+    $t =~ s/##id##/$$id/;
+
+    # node.foo => node, group.bar => graph
+    $t =~ s/##class##/$base_class/;
+    $t =~ s/##name##/$name/;
+    $t =~ s/##type##/$attr_type_to_name->{ $entry->[ ATTR_TYPE_SLOT ] || ATTR_COLOR }/eg;
+
+    # will only be there and thus replaced if we have a default
+    if ($t =~ /##default##/)
+      {
+      my $def = $entry->[ ATTR_DEFAULT_SLOT ];
+      # not a simple value?
+      $def = $self->default_attribute($name) if ref $def;
+      $t =~ s/##default##/$def/;
+      }
+
+    # remember name => ID
+    $ids->{$base_class}->{$name} = $$id; $$id++;
+    # append the definition
+    $txt .= $t;
+    }
+  $txt;
+  }
+
+# yED example:
+
+# <data key="d0">
+#  <y:ShapeNode>
+#    <y:Geometry height="30.0" width="30.0" x="277.0" y="96.0"/>
+#    <y:Fill color="#FFCC00" transparent="false"/>
+#    <y:BorderStyle color="#000000" type="line" width="1.0"/>
+#    <y:NodeLabel alignment="center" autoSizePolicy="content" fontFamily="Dialog" fontSize="12" fontStyle="plain" hasBackgroundColor="false" hasLineColor="false" height="18.701171875" modelName="internal" modelPosition="c" textColor="#000000" visible="true" width="11.0" x="9.5" y="5.6494140625">1</y:NodeLabel>
+#    <y:Shape type="ellipse"/>
+#   </y:ShapeNode>
+# </data>
+
+use Graph::Easy::Util qw(ord_values);
+
+sub _as_graphml
+  {
+  my $self = shift;
+
+  my $args = $_[0];
+  $args = { name => $_[0] } if ref($args) ne 'HASH' && @_ == 1;
+  $args = { @_ } if ref($args) ne 'HASH' && @_ > 1;
+
+  $args->{format} = 'graph-easy' unless defined $args->{format};
+
+  if ($args->{format} !~ /^(graph-easy|Graph::Easy|yED)\z/i)
+    {
+    return $self->error("Format '$args->{format}' not understood by as_graphml.");
+    }
+  my $format = $args->{format};
+
+  # Convert the graph to a textual representation - does not need layout().
+
+  my $schema = "http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd";
+  $schema = "http://www.yworks.com/xml/schema/graphml/1.0/ygraphml.xsd" if $format eq 'yED';
+  my $y_schema = '';
+  $y_schema = "\n    xmlns:y=\"http://www.yworks.com/xml/graphml\"" if $format eq 'yED';
+
+  my $txt = <<EOF
+<?xml version="1.0" encoding="UTF-8"?>
+<graphml xmlns="http://graphml.graphdrawing.org/xmlns"
+    xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"##Y##
+    xsi:schemaLocation="http://graphml.graphdrawing.org/xmlns
+     ##SCHEMA##">
+
+  <!-- Created by Graph::Easy v##VERSION## at ##DATE## -->
+
+EOF
+;
+
+  $txt =~ s/##DATE##/scalar localtime()/e;
+  $txt =~ s/##VERSION##/$Graph::Easy::VERSION/;
+  $txt =~ s/##SCHEMA##/$schema/;
+  $txt =~ s/##Y##/$y_schema/;
+
+  # <key id="d0" for="node" attr.name="color" attr.type="string">
+  #   <default>yellow</default>
+  # </key>
+  # <key id="d1" for="edge" attr.name="weight" attr.type="double"/>
+
+  # First gather all possible attributes, then add defines for them. This
+  # avoids lengthy re-definitions of attributes that aren't used:
+
+  my %keys;
+
+  my $tpl = '  <key id="##id##" for="##class##" attr.name="##name##" attr.type="##type##">'
+      ."\n    <default>##default##</default>\n"
+      ."  </key>\n";
+  my $tpl_no_default = '  <key id="##id##" for="##class##" attr.name="##name##" attr.type="##type##"/>'."\n";
+
+  # for yED:
+  # <key for="node" id="d0" yfiles.type="nodegraphics"/>
+  # <key attr.name="description" attr.type="string" for="node" id="d1"/>
+  # <key for="edge" id="d2" yfiles.type="edgegraphics"/>
+  # <key attr.name="description" attr.type="string" for="edge" id="d3"/>
+  # <key for="graphml" id="d4" yfiles.type="resources"/>
+
+  # we need to remember the mapping between attribute name and ID:
+  my $ids = {};
+  my $id = 'd0';
+
+  ###########################################################################
+  # first the class attributes
+  for my $class (sort keys %{$self->{att}})
+    {
+    my $att =  $self->{att}->{$class};
+
+    $txt .=
+	$self->_graphml_attr_keys( $tpl, $tpl_no_default, $class, $att, $ids, \$id);
+
+    }
+
+  my @nodes = $self->sorted_nodes('name','id');
+
+  ###########################################################################
+  # now the attributes on the objects:
+  for my $o (@nodes, ord_values ( $self->{edges} ))
+    {
+    $txt .=
+	$self->_graphml_attr_keys( $tpl, $tpl_no_default, $o->class(),
+				   $o->raw_attributes(), $ids, \$id);
+    }
+  $txt .= "\n" unless $id eq 'd0';
+
+  my $indent = '  ';
+  $txt .= $indent . '<graph id="G" edgedefault="' . $self->type() . "\">\n";
+
+  # output graph attributes:
+  $txt .= $self->_attributes_as_graphml($self,'  ',$ids->{graph});
+
+  # output groups recursively
+  my @groups = $self->groups_within(0);
+  foreach my $g (@groups)
+    {
+    $txt .= $g->as_graphml($indent.'  ',$ids);			# marks nodes as processed if nec.
+    }
+
+  $indent = '    ';
+  foreach my $n (@nodes)
+    {
+    next if $n->{group};				# already done in a group
+    $txt .= $n->as_graphml($indent,$ids);		# <node id="..." ...>
+    }
+
+  $txt .= "\n";
+
+  foreach my $n (@nodes)
+    {
+    next if $n->{group};				# already done in a group
+
+    my @out = $n->sorted_successors();
+    # for all outgoing connections
+    foreach my $other (@out)
+      {
+      # in case there exists more than one edge from $n --> $other
+      my @edges = $n->edges_to($other);
+      for my $edge (sort { $a->{id} <=> $b->{id} } @edges)
+        {
+        $txt .= $edge->as_graphml($indent,$ids);	# <edge id="..." ...>
+        }
+      }
+    }
+
+  $txt .= "  </graph>\n</graphml>\n";
+  $txt;
+  }
+
+sub _safe_xml
+  {
+  # make a text XML safe
+  my ($self,$txt) = @_;
+
+  $txt =~ s/&/&amp;/g;			# quote &
+  $txt =~ s/>/&gt;/g;			# quote >
+  $txt =~ s/</&lt;/g;			# quote <
+  $txt =~ s/"/&quot;/g;			# quote "
+  $txt =~ s/'/&apos;/g;			# quote '
+  $txt =~ s/\\\\/\\/g;			# "\\" to "\"
+
+  $txt;
+  }
+
+sub _attributes_as_graphml
+  {
+  # output the attributes of an object
+  my ($graph, $self, $indent, $ids) = @_;
+
+  my $tpl = "$indent  <data key=\"##id##\">##value##</data>\n";
+  my $att = $self->get_attributes();
+  my $txt = '';
+  for my $n (sort keys %$att)
+    {
+    next unless exists $ids->{$n};
+    my $def = $self->default_attribute($n);
+    next if defined $def && $def eq $att->{$n};
+    my $t = $tpl;
+    $t =~ s/##id##/$ids->{$n}/;
+    $t =~ s/##value##/$graph->_safe_xml($att->{$n})/e;
+    $txt .= $t;
+    }
+  $txt;
+  }
+
+#############################################################################
+
+package Graph::Easy::Group;
+
+use strict;
+
+use Graph::Easy::Util qw(ord_values);
+
+sub as_graphml
+  {
+  my ($self, $indent, $ids) = @_;
+
+  my $txt = $indent . '<graph id="' . $self->_safe_xml($self->{name}) . '" edgedefault="' .
+	$self->{graph}->type() . "\">\n";
+  $txt .= $self->{graph}->_attributes_as_graphml($self, $indent, $ids->{graph});
+
+  foreach my $n (ord_values ( $self->{nodes} ))
+    {
+    my @out = $n->sorted_successors();
+
+    $txt .= $n->as_graphml($indent.'  ', $ids); 		# <node id="..." ...>
+
+    # for all outgoing connections
+    foreach my $other (@out)
+      {
+      # in case there exists more than one edge from $n --> $other
+      my @edges = $n->edges_to($other);
+      for my $edge (sort { $a->{id} <=> $b->{id} } @edges)
+        {
+        $txt .= $edge->as_graphml($indent.'  ',$ids);
+        }
+      $txt .= "\n" if @edges > 0;
+      }
+    }
+
+  # output groups recursively
+  my @groups = $self->groups_within(0);
+  foreach my $g (@groups)
+    {
+    $txt .= $g->_as_graphml($indent.'  ',$ids);		# marks nodes as processed if nec.
+    }
+
+  # XXX TODO: edges from/to this group
+
+  # close this group
+  $txt .= $indent . "</graph>";
+
+  $txt;
+  }
+
+#############################################################################
+
+package Graph::Easy::Node;
+
+use strict;
+
+sub as_graphml
+  {
+  my ($self, $indent, $ids) = @_;
+
+  my $g = $self->{graph};
+  my $txt = $indent . '<node id="' . $g->_safe_xml($self->{name}) . "\">\n";
+
+  $txt .= $g->_attributes_as_graphml($self, $indent, $ids->{node});
+
+  $txt .= "$indent</node>\n";
+
+  return $txt;
+  }
+
+#############################################################################
+
+package Graph::Easy::Edge;
+
+use strict;
+
+sub as_graphml
+  {
+  my ($self, $indent, $ids) = @_;
+
+  my $g = $self->{graph};
+  my $txt = $indent . '<edge source="' . $g->_safe_xml($self->{from}->{name}) .
+		     '" target="' . $g->_safe_xml($self->{to}->{name}) . "\">\n";
+
+  $txt .= $g->_attributes_as_graphml($self, $indent, $ids->{edge});
+
+  $txt .= "$indent</edge>\n";
+
+  $txt;
+  }
+
+1;
+__END__
+
+=head1 NAME
+
+Graph::Easy::As_graphml - Generate a GraphML text from a Graph::Easy object
+
+=head1 SYNOPSIS
+
+	use Graph::Easy;
+
+	my $graph = Graph::Easy->new();
+
+	$graph->add_edge ('Bonn', 'Berlin');
+
+	print $graph->as_graphml();
+
+=head1 DESCRIPTION
+
+C<Graph::Easy::As_graphml> contains just the code for converting a
+L<Graph::Easy|Graph::Easy> object to a GraphML text.
+
+=head2 Attributes
+
+Attributes are output in the format that C<Graph::Easy> specifies. More
+details about the valid attributes and their default values can be found
+in the Graph::Easy online manual:
+
+L<http://bloodgate.com/perl/graph/manual/>.
+
+=head1 EXPORT
+
+Exports nothing.
+
+=head1 SEE ALSO
+
+L<Graph::Easy>, L<http://graphml.graphdrawing.org/>.
+
+=head1 AUTHOR
+
+Copyright (C) 2004 - 2008 by Tels L<http://bloodgate.com>
+
+See the LICENSE file for information.
+
+=cut
+

perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/As_txt.pm

@@ -0,0 +1,487 @@
+#############################################################################
+# Output an Graph::Easy object as textual description
+#
+
+package Graph::Easy::As_txt;
+
+$VERSION = '0.76';
+
+#############################################################################
+#############################################################################
+
+package Graph::Easy;
+
+use strict;
+use warnings;
+
+sub _as_txt
+  {
+  my ($self) = @_;
+
+  # Convert the graph to a textual representation - does not need layout().
+  $self->_assign_ranks();
+
+  # generate the class attributes first
+  my $txt = '';
+  my $att =  $self->{att};
+  for my $class (sort keys %$att)
+    {
+
+    my $out = $self->_remap_attributes(
+     $class, $att->{$class}, {}, 'noquote', 'encode' );
+
+    my $att = '';
+    for my $atr (sort keys %$out)
+      {
+      # border is handled special below
+      next if $atr =~ /^border/;
+      $att .= "  $atr: $out->{$atr};\n";
+      }
+
+    # edges do not have a border
+    if ($class !~ /^edge/)
+      {
+      my $border = $self->border_attribute($class) || '';
+
+      # 'solid 1px #000000' =~ /^solid/;
+      # 'solid 1px #000000' =~ /^solid 1px #000000/;
+      $border = '' if $self->default_attribute($class,'border') =~ /^$border/;
+
+      $att .= "  border: $border;\n" if $border ne '';
+      }
+
+    if ($att ne '')
+      {
+      # the following makes short, single definitions to fit on one line
+      if ($att !~ /\n.*\n/ && length($att) < 40)
+        {
+        $att =~ s/\n/ /; $att =~ s/^  / /;
+        }
+      else
+        {
+        $att = "\n$att";
+        }
+      $txt .= "$class {$att}\n";
+      }
+    }
+
+  $txt .= "\n" if $txt ne '';		# insert newline
+
+  my @nodes = $self->sorted_nodes('name','id');
+
+  my $count = 0;
+  # output nodes with attributes first, sorted by their name
+  foreach my $n (@nodes)
+    {
+    $n->{_p} = undef;			# mark as not yet processed
+    my $att = $n->attributes_as_txt();
+    if ($att ne '')
+      {
+      $n->{_p} = 1;			# mark as processed
+      $count++;
+      $txt .= $n->as_pure_txt() . $att . "\n";
+      }
+    }
+
+  $txt .= "\n" if $count > 0;		# insert a newline
+
+  # output groups first, with their nodes
+  foreach my $gn (sort keys %{$self->{groups}})
+    {
+    my $group = $self->{groups}->{$gn};
+    $txt .= $group->as_txt();		# marks nodes as processed if nec.
+    $count++;
+    }
+
+  # XXX TODO:
+  # Output all nodes with rank=0 first, and also follow their successors
+  # What is left will then be done next, with rank=1 etc.
+  # This output order let's us output node chains in compact form as:
+  # [A]->[B]->[C]->[D]
+  # [B]->[E]
+  # instead of having:
+  # [A]->[B]
+  # [B]->[E]
+  # [B]->[C] etc
+
+  @nodes = $self->sorted_nodes('rank','name');
+  foreach my $n (@nodes)
+    {
+    my @out = $n->sorted_successors();
+    my $first = $n->as_pure_txt(); 		# [ A | B ]
+    if ( defined $n->{autosplit} || ((@out == 0) && ( (scalar $n->predecessors() || 0) == 0)))
+      {
+      # single node without any connections (unless already output)
+      next if exists $n->{autosplit} && !defined $n->{autosplit};
+      $txt .= $first . "\n" unless defined $n->{_p};
+      }
+
+    $first = $n->_as_part_txt();		# [ A.0 ]
+    # for all outgoing connections
+    foreach my $other (@out)
+      {
+      # in case there exists more than one edge from $n --> $other
+      my @edges = $n->edges_to($other);
+      for my $edge (sort { $a->{id} <=> $b->{id} } @edges)
+        {
+        $txt .= $first . $edge->as_txt() . $other->_as_part_txt() . "\n";
+        }
+      }
+    }
+
+  foreach my $n (@nodes)
+    {
+    delete $n->{_p};			# clean up
+    }
+
+  $txt;
+  }
+
+#############################################################################
+
+package Graph::Easy::Group;
+
+use strict;
+
+sub as_txt
+  {
+  my $self = shift;
+
+  my $n = '';
+  if (!$self->isa('Graph::Easy::Group::Anon'))
+    {
+    $n = $self->{name};
+    # quote special chars in name
+    $n =~ s/([\[\]\(\)\{\}\#])/\\$1/g;
+    $n = ' ' . $n;
+    }
+
+  my $txt = "($n";
+
+  $n = $self->{nodes};
+
+  $txt .= (keys %$n > 0 ? "\n" : ' ');
+  for my $name ( sort keys %$n )
+    {
+    $n->{$name}->{_p} = 1;                              # mark as processed
+    $txt .= '  ' . $n->{$name}->as_pure_txt() . "\n";
+    }
+  $txt .= ")" . $self->attributes_as_txt() . "\n\n";
+
+  # insert all the edges of the group
+
+  #
+  $txt;
+  }
+
+#############################################################################
+
+package Graph::Easy::Node;
+
+use strict;
+
+sub attributes_as_txt
+  {
+  # return the attributes of this node as text description
+  my ($self, $remap) = @_;
+
+  # nodes that were autosplit
+  if (exists $self->{autosplit})
+    {
+    # other nodes are invisible in as_txt:
+    return '' unless defined $self->{autosplit};
+    # the first one might have had a label set
+    }
+
+  my $att = '';
+  my $class = $self->class();
+  my $g = $self->{graph};
+
+  # XXX TODO: remove atttributes that are simple the default attributes
+
+  my $attributes = $self->{att};
+  if (exists $self->{autosplit})
+    {
+    # for the first node in a row of autosplit nodes, we need to create
+    # the correct attributes, e.g. "silver|red|" instead of just silver:
+    my $basename = $self->{autosplit_basename};
+    $attributes = { };
+
+    my $parts = $self->{autosplit_parts};
+    # gather all possible attribute names, otherwise an attribute set
+    # on only one part (like via "color: |red;" would not show up:
+    my $names = {};
+    for my $child ($self, @$parts)
+      {
+      for my $k (sort keys %{$child->{att}})
+        {
+        $names->{$k} = undef;
+        }
+      }
+
+    for my $k (sort keys %$names)
+      {
+      next if $k eq 'basename';
+      my $val = $self->{att}->{$k};
+      $val = '' unless defined $val;
+      my $first = $val; my $not_equal = 0;
+      $val .= '|';
+      for my $child (@$parts)
+        {
+        # only consider our own autosplit parts (check should not be nec.)
+#        next if !exists $child->{autosplit_basename} ||
+#                        $child->{autosplit_basename} ne $basename;
+
+        my $v = $child->{att}->{$k}; $v = '' if !defined $v;
+        $not_equal ++ if $v ne $first;
+        $val .= $v . '|';
+        }
+      # all parts equal, so do "red|red|red" => "red"
+      $val = $first if $not_equal == 0;
+
+      $val =~ s/\|+\z/\|/;				# "silver|||" => "silver|"
+      $val =~ s/\|\z// if $val =~ /\|.*\|/;		# "silver|" => "silver|"
+      							# but "red|blue|" => "red|blue"
+      $attributes->{$k} = $val unless $val eq '|';	# skip '|'
+      }
+    $attributes->{basename} = $self->{att}->{basename} if defined $self->{att}->{basename};
+    }
+
+  my $new = $g->_remap_attributes( $self, $attributes, $remap, 'noquote', 'encode' );
+
+  # For nodes, we do not output their group attribute, since they simple appear
+  # at the right place in the txt:
+  delete $new->{group};
+
+  # for groups inside groups, insert their group attribute
+  $new->{group} = $self->{group}->{name}
+    if $self->isa('Graph::Easy::Group') && exists $self->{group};
+
+  if (defined $self->{origin})
+    {
+    $new->{origin} = $self->{origin}->{name};
+    $new->{offset} = join(',', $self->offset());
+    }
+
+  # shorten output for multi-celled nodes
+  # for "rows: 2;" still output "rows: 2;", because it is shorter
+  if (exists $new->{columns})
+    {
+    $new->{size} = ($new->{columns}||1) . ',' . ($new->{rows}||1);
+    delete $new->{rows};
+    delete $new->{columns};
+    # don't output the default size
+    delete $new->{size} if $new->{size} eq '1,1';
+    }
+
+  for my $atr (sort keys %$new)
+    {
+    next if $atr =~ /^border/;                  # handled special
+
+    $att .= "$atr: $new->{$atr}; ";
+    }
+
+  if (!$self->isa_cell())
+    {
+    my $border;
+    if (!exists $self->{autosplit})
+      {
+      $border = $self->border_attribute();
+      }
+    else
+      {
+      $border = Graph::Easy::_border_attribute(
+	$attributes->{borderstyle}||'',
+	$attributes->{borderwidth}||'',
+	$attributes->{bordercolor}||'');
+      }
+
+    # XXX TODO: should do this for all attributes, not only for border
+    # XXX TODO: this seems wrong anyway
+
+    # don't include default border
+    $border = '' if ref $g && $g->attribute($class,'border') eq $border;
+    $att .= "border: $border; " if $border ne '';
+    }
+
+  # if we have a subclass, we probably need to include it
+  my $c = '';
+  $c = $1 if $class =~ /\.(\w+)/;
+
+  # but we do not need to include it if our group has a nodeclass attribute
+  $c = '' if ref($self->{group}) && $self->{group}->attribute('nodeclass') eq $c;
+
+  # include our subclass as attribute
+  $att .= "class: $c; " if $c ne '' && $c ne 'anon';
+
+  # generate attribute text if nec.
+  $att = ' { ' . $att . '}' if $att ne '';
+
+  $att;
+  }
+
+sub _as_part_txt
+  {
+  # for edges, we need the name of the part of the first part, not the entire
+  # autosplit text
+  my $self = shift;
+
+  my $name = $self->{name};
+
+  # quote special chars in name
+  $name =~ s/([\[\]\|\{\}\#])/\\$1/g;
+
+  '[ ' .  $name . ' ]';
+  }
+
+sub as_pure_txt
+  {
+  my $self = shift;
+
+  if (exists $self->{autosplit} && defined $self->{autosplit})
+    {
+    my $name = $self->{autosplit};
+
+    # quote special chars in name (but not |)
+    $name =~ s/([\[\]\{\}\#])/\\$1/g;
+
+    return '[ '. $name .' ]'
+    }
+
+  my $name = $self->{name};
+
+  # quote special chars in name
+  $name =~ s/([\[\]\|\{\}\#])/\\$1/g;
+
+  '[ ' .  $name . ' ]';
+  }
+
+sub as_txt
+  {
+  my $self = shift;
+
+  if (exists $self->{autosplit})
+    {
+    return '' unless defined $self->{autosplit};
+    my $name = $self->{autosplit};
+    # quote special chars in name (but not |)
+    $name =~ s/([\[\]\{\}\#])/\\$1/g;
+    return '[ ' . $name . ' ]'
+    }
+
+  my $name = $self->{name};
+
+  # quote special chars in name
+  $name =~ s/([\[\]\|\{\}\#])/\\$1/g;
+
+  '[ ' .  $name . ' ]' . $self->attributes_as_txt();
+  }
+
+#############################################################################
+
+package Graph::Easy::Edge;
+
+my $styles = {
+  solid => '--',
+  dotted => '..',
+  double => '==',
+  'double-dash' => '= ',
+  dashed => '- ',
+  'dot-dash' => '.-',
+  'dot-dot-dash' => '..-',
+  wave => '~~',
+  };
+
+sub _as_txt
+  {
+  my $self = shift;
+
+  # '- Name ' or ''
+  my $n = $self->{att}->{label}; $n = '' unless defined $n;
+
+  my $left = ' '; $left = ' <' if $self->{bidirectional};
+  my $right = '> '; $right = ' ' if $self->{undirected};
+
+  my $s = $self->style() || 'solid';
+
+  my $style = '--';
+
+  # suppress border on edges
+  my $suppress = { all => { label => undef } };
+  if ($s =~ /^(bold|bold-dash|broad|wide|invisible)\z/)
+    {
+    # output "--> { style: XXX; }"
+    $style = '--';
+    }
+  else
+    {
+    # output "-->" or "..>" etc
+    $suppress->{all}->{style} = undef;
+
+    $style = $styles->{ $s };
+    if (!defined $style)
+      {
+      require Carp;
+      Carp::confess ("Unknown edge style '$s'\n");
+      }
+    }
+
+  $n = $style . " $n " if $n ne '';
+
+  # make " -  " into " - -  "
+  $style = $style . $style if $self->{undirected} && substr($style,1,1) eq ' ';
+
+  # ' - Name -->' or ' --> ' or ' -- '
+  my $a = $self->attributes_as_txt($suppress) . ' '; $a =~ s/^\s//;
+  $left . $n . $style . $right . $a;
+  }
+
+1;
+__END__
+
+=head1 NAME
+
+Graph::Easy::As_txt - Generate textual description from graph object
+
+=head1 SYNOPSIS
+
+	use Graph::Easy;
+
+	my $graph = Graph::Easy->new();
+
+	my $bonn = Graph::Easy::Node->new(
+		name => 'Bonn',
+	);
+	my $berlin = Graph::Easy::Node->new(
+		name => 'Berlin',
+	);
+
+	$graph->add_edge ($bonn, $berlin);
+
+	print $graph->as_txt();
+
+	# prints something like:
+
+	# [ Bonn ] -> [ Berlin ]
+
+=head1 DESCRIPTION
+
+C<Graph::Easy::As_txt> contains just the code for converting a
+L<Graph::Easy|Graph::Easy> object to a human-readable textual description.
+
+=head1 EXPORT
+
+Exports nothing.
+
+=head1 SEE ALSO
+
+L<Graph::Easy>.
+
+=head1 AUTHOR
+
+Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>
+
+See the LICENSE file for information.
+
+=cut
+

perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/As_vcg.pm

@@ -0,0 +1,586 @@
+#############################################################################
+# Output the graph as VCG or GDL text.
+#
+#############################################################################
+
+package Graph::Easy::As_vcg;
+
+$VERSION = '0.76';
+
+#############################################################################
+#############################################################################
+
+package Graph::Easy;
+
+use strict;
+use warnings;
+
+my $vcg_remap = {
+  node => {
+    align => \&_vcg_remap_align,
+    autolabel => undef,
+    autolink => undef,
+    autotitle => undef,
+    background => undef,
+    basename => undef,
+    class => undef,
+    colorscheme => undef,
+    columns => undef,
+    flow => undef,
+    fontsize => undef,
+    format => undef,
+    group => undef,
+    id => undef,
+    link => undef,
+    linkbase => undef,
+    offset => undef,
+    origin => undef,
+    pointstyle => undef,
+    rank => 'level',
+    rotate => undef,
+    rows => undef,
+    shape => \&_vcg_remap_shape,
+    size => undef,
+    textstyle => undef,
+    textwrap => undef,
+    title => undef,
+    },
+  edge => {
+    color => 'color',			# this entry overrides 'all'!
+    align => undef,
+    arrowshape => undef,
+    arrowstyle => undef,
+    autojoin => undef,
+    autolabel => undef,
+    autolink => undef,
+    autosplit => undef,
+    autotitle => undef,
+    border => undef,
+    bordercolor => undef,
+    borderstyle => undef,
+    borderwidth => undef,
+    colorscheme => undef,
+    end => undef,
+    fontsize => undef,
+    format => undef,
+    id => undef,
+    labelcolor => 'textcolor',
+    link => undef,
+    linkbase => undef,
+    minlen => undef,
+    start => undef,
+    # XXX TODO: remap unknown styles
+    style => 'linestyle',
+    textstyle => undef,
+    textwrap => undef,
+    title => undef,
+    },
+  graph => {
+    align => \&_vcg_remap_align,
+    flow => \&_vcg_remap_flow,
+    label => 'title',
+    type => undef,
+    },
+  group => {
+    },
+  all => {
+    background => undef,
+    color => 'textcolor',
+    comment => undef,
+    fill => 'color',
+    font => 'fontname',
+    },
+  always => {
+    },
+  # this routine will handle all custom "x-dot-..." attributes
+  x => \&_remap_custom_vcg_attributes,
+  };
+
+sub _remap_custom_vcg_attributes
+  {
+  my ($self, $name, $value) = @_;
+
+  # drop anything that is not starting with "x-vcg-..."
+  return (undef,undef) unless $name =~ /^x-vcg-/;
+
+  $name =~ s/^x-vcg-//;			# "x-vcg-foo" => "foo"
+  ($name,$value);
+  }
+
+my $vcg_shapes = {
+  rect => 'box',
+  diamond => 'rhomb',
+  triangle => 'triangle',
+  invtriangle => 'triangle',
+  ellipse => 'ellipse',
+  circle => 'circle',
+  hexagon => 'hexagon',
+  trapezium => 'trapeze',
+  invtrapezium => 'uptrapeze',
+  invparallelogram => 'lparallelogram',
+  parallelogram => 'rparallelogram',
+  };
+
+sub _vcg_remap_shape
+  {
+  my ($self, $name, $shape) = @_;
+
+  return ('invisible','yes') if $shape eq 'invisible';
+
+  ('shape', $vcg_shapes->{$shape} || 'box');
+  }
+
+sub _vcg_remap_align
+  {
+  my ($self, $name, $style) = @_;
+
+  # center => center, left => left_justify, right => right_justify
+  $style .= '_justify' unless $style eq 'center';
+
+  ('textmode', $style);
+  }
+
+my $vcg_flow = {
+  'south' => 'top_to_bottom',
+  'north' => 'bottom_to_top',
+  'down' => 'top_to_bottom',
+  'up' => 'bottom_to_top',
+  'east' => 'left_to_right',
+  'west' => 'right_to_left',
+  'right' => 'left_to_right',
+  'left' => 'right_to_left',
+  };
+
+sub _vcg_remap_flow
+  {
+  my ($self, $name, $style) = @_;
+
+  ('orientation', $vcg_flow->{$style} || 'top_to_bottom');
+  }
+
+sub _class_attributes_as_vcg
+  {
+  # convert a hash with attribute => value mappings to a string
+  my ($self, $a, $class) = @_;
+
+
+  my $att = '';
+  $class = '' if $class eq 'graph';
+  $class .= '.' if $class ne '';
+
+  # create the attributes as text:
+  for my $atr (sort keys %$a)
+    {
+    my $v = $a->{$atr};
+    $v =~ s/"/\\"/g;            # '2"' => '2\"'
+    $v = '"' . $v . '"' unless $v =~ /^[0-9]+\z/;       # 1, "1a"
+    $att .= "  $class$atr: $v\n";
+    }
+  $att =~ s/,\s$//;             # remove last ","
+
+  $att = "\n$att" unless $att eq '';
+  $att;
+  }
+
+#############################################################################
+
+sub _generate_vcg_edge
+  {
+  # Given an edge, generate the VCG code for it
+  my ($self, $e, $indent) = @_;
+
+  # skip links from/to groups, these will be done later
+  return '' if
+    $e->{from}->isa('Graph::Easy::Group') ||
+    $e->{to}->isa('Graph::Easy::Group');
+
+  my $edge_att = $e->attributes_as_vcg();
+
+  $e->{_p} = undef;				# mark as processed
+  "  edge:$edge_att\n";				# return edge text
+  }
+
+use Graph::Easy::Util qw(ord_values);
+
+sub _as_vcg
+  {
+  my ($self) = @_;
+
+  # convert the graph to a textual representation
+  # does not need a layout() beforehand!
+
+  # gather all edge classes to build the classname attribute from them:
+  $self->{_vcg_edge_classes} = {};
+  for my $e (ord_values ( $self->{edges} ))
+    {
+    my $class = $e->sub_class();
+    $self->{_vcg_edge_classes}->{$class} = undef if defined $class && $class ne '';
+    }
+  # sort gathered class names and map them to integers
+  my $class_names = '';
+  if (keys %{$self->{_vcg_edge_classes}} > 0)
+    {
+    my $i = 1;
+    $class_names = "\n";
+    for my $ec (sort keys %{$self->{_vcg_edge_classes}})
+      {
+      $self->{_vcg_edge_classes}->{$ec} = $i;	# remember mapping
+      $class_names .= "  classname $i: \"$ec\"\n";
+      $i++;
+      }
+    }
+
+  # generate the class attributes first
+  my $label = $self->label();
+  my $t = ''; $t = "\n  title: \"$label\"" if $label ne '';
+
+  my $txt = "graph: {$t\n\n" .
+            "  // Generated by Graph::Easy $Graph::Easy::VERSION" .
+	    " at " . scalar localtime() . "\n" .
+	    $class_names;
+
+  my $groups = $self->groups();
+
+  # to keep track of invisible helper nodes
+  $self->{_vcg_invis} = {};
+  # name for invisible helper nodes
+  $self->{_vcg_invis_id} = 'joint0';
+
+  my $atts = $self->{att};
+  # insert the class attributes
+  for my $class (qw/edge graph node/)
+    {
+    next if $class =~ /\./;		# skip subclasses
+
+    my $out = $self->_remap_attributes( $class, $atts->{$class}, $vcg_remap, 'noquote');
+    $txt .= $self->_class_attributes_as_vcg($out, $class);
+    }
+
+  $txt .= "\n" if $txt ne '';		# insert newline
+
+  ###########################################################################
+  # output groups as subgraphs
+
+  # insert the edges into the proper group
+  $self->_edges_into_groups() if $groups > 0;
+
+  # output the groups (aka subclusters)
+  my $indent = '    ';
+  for my $group (sort { $a->{name} cmp $b->{name} } values %{$self->{groups}})
+    {
+    # quote special chars in group name
+    my $name = $group->{name}; $name =~ s/([\[\]\(\)\{\}\#"])/\\$1/g;
+
+#    # output group attributes first
+#    $txt .= "  subgraph \"cluster$group->{id}\" {\n${indent}label=\"$name\";\n";
+
+    # Make a copy of the attributes, including our class attributes:
+    my $copy = {};
+    my $attribs = $group->get_attributes();
+
+    for my $a (keys %$attribs)
+      {
+      $copy->{$a} = $attribs->{$a};
+      }
+#    # set some defaults
+#    $copy->{'borderstyle'} = 'solid' unless defined $copy->{'borderstyle'};
+
+    my $out = {};
+#    my $out = $self->_remap_attributes( $group->class(), $copy, $vcg_remap, 'noquote');
+
+    # Set some defaults:
+    $out->{fillcolor} = '#a0d0ff' unless defined $out->{fillcolor};
+#    $out->{labeljust} = 'l' unless defined $out->{labeljust};
+
+    my $att = '';
+    # we need to output style first ("filled" and "color" need come later)
+    for my $atr (reverse sort keys %$out)
+      {
+      my $v = $out->{$atr};
+      $v = '"' . $v . '"';
+      $att .= "    $atr: $v\n";
+      }
+    $txt .= $att . "\n" if $att ne '';
+
+#    # output nodes (w/ or w/o attributes) in that group
+#    for my $n ($group->sorted_nodes())
+#      {
+#      my $att = $n->attributes_as_vcg();
+#      $n->{_p} = undef;			# mark as processed
+#      $txt .= $indent . $n->as_graphviz_txt() . $att . "\n";
+#      }
+
+#    # output node connections in this group
+#    for my $e (ord_values ( $group->{edges} ))
+#      {
+#      next if exists $e->{_p};
+#      $txt .= $self->_generate_edge($e, $indent);
+#      }
+
+    $txt .= "  }\n";
+    }
+
+  my $root = $self->attribute('root');
+  $root = '' unless defined $root;
+
+  my $count = 0;
+  # output nodes with attributes first, sorted by their name
+  for my $n (sort { $a->{name} cmp $b->{name} } values %{$self->{nodes}})
+    {
+    next if exists $n->{_p};
+    my $att = $n->attributes_as_vcg($root);
+    if ($att ne '')
+      {
+      $n->{_p} = undef;			# mark as processed
+      $count++;
+      $txt .= "  node:" . $att . "\n";
+      }
+    }
+
+  $txt .= "\n" if $count > 0;		# insert a newline
+
+  my @nodes = $self->sorted_nodes();
+
+  foreach my $n (@nodes)
+    {
+    my @out = $n->successors();
+    my $first = $n->as_vcg_txt();
+    if ((@out == 0) && ( (scalar $n->predecessors() || 0) == 0))
+      {
+      # single node without any connections (unless already output)
+      $txt .= "  node: { title: " . $first . " }\n" unless exists $n->{_p};
+      }
+    # for all outgoing connections
+    foreach my $other (reverse @out)
+      {
+      # in case there is more than one edge going from N to O
+      my @edges = $n->edges_to($other);
+      foreach my $e (@edges)
+        {
+        next if exists $e->{_p};
+        $txt .= $self->_generate_vcg_edge($e, '  ');
+        }
+      }
+    }
+
+  # insert now edges between groups (clusters/subgraphs)
+
+#  foreach my $e (ord_values ( $self->{edges} ))
+#    {
+#    $txt .= $self->_generate_group_edge($e, '  ')
+#     if $e->{from}->isa('Graph::Easy::Group') ||
+#        $e->{to}->isa('Graph::Easy::Group');
+#    }
+
+  # clean up
+  for my $n ( ord_values ( $self->{nodes} ), ord_values ( $self->{edges} ))
+    {
+    delete $n->{_p};
+    }
+  delete $self->{_vcg_invis};		# invisible helper nodes for joints
+  delete $self->{_vcg_invis_id};	# invisible helper node name
+  delete $self->{_vcg_edge_classes};
+
+  $txt .  "\n}\n";			# close the graph
+  }
+
+package Graph::Easy::Node;
+
+sub attributes_as_vcg
+  {
+  # return the attributes of this node as text description
+  my ($self, $root) = @_;
+  $root = '' unless defined $root;
+
+  my $att = '';
+  my $class = $self->class();
+
+  return '' unless ref $self->{graph};
+
+  my $g = $self->{graph};
+
+  # get all attributes, excluding the class attributes
+  my $a = $self->raw_attributes();
+
+  # add the attributes that are listed under "always":
+  my $attr = $self->{att};
+  my $base_class = $class; $base_class =~ s/\..*//;
+  my $list = $vcg_remap->{always}->{$class} || $vcg_remap->{always}->{$base_class};
+
+  for my $name (@$list)
+    {
+    # for speed, try to look it up directly
+
+    # look if we have a code ref, if yes, simple set the value to undef
+    # and let the coderef handle it later:
+    if ( ref($vcg_remap->{$base_class}->{$name}) ||
+         ref($vcg_remap->{all}->{$name}) )
+      {
+      $a->{$name} = $attr->{$name};
+      }
+    else
+      {
+      $a->{$name} = $attr->{$name};
+      $a->{$name} = $self->attribute($name) unless defined $a->{$name} && $a->{$name} ne 'inherit';
+      }
+    }
+
+  $a = $g->_remap_attributes( $self, $a, $vcg_remap, 'noquote');
+
+  if ($self->isa('Graph::Easy::Edge'))
+    {
+    $a->{sourcename} = $self->{from}->{name};
+    $a->{targetname} = $self->{to}->{name};
+    my $class = $self->sub_class();
+    $a->{class} = $self->{graph}->{_vcg_edge_classes}->{ $class } if defined $class && $class ne '';
+    }
+  else
+    {
+    # title: "Bonn"
+    $a->{title} = $self->{name};
+    }
+
+  # do not needlessly output labels:
+  delete $a->{label} if !$self->isa('Graph::Easy::Edge') &&		# not an edge
+	exists $a->{label} && $a->{label} eq $self->{name};
+
+  # bidirectional and undirected edges
+  if ($self->{bidirectional})
+    {
+    delete $a->{dir};
+    my ($n,$s) = Graph::Easy::_graphviz_remap_arrow_style(
+	$self,'', $self->attribute('arrowstyle'));
+    $a->{arrowhead} = $s;
+    $a->{arrowtail} = $s;
+    }
+  if ($self->{undirected})
+    {
+    delete $a->{dir};
+    $a->{arrowhead} = 'none';
+    $a->{arrowtail} = 'none';
+    }
+
+  # borderstyle: double:
+  if (!$self->isa('Graph::Easy::Edge'))
+    {
+    my $style = $self->attribute('borderstyle');
+    $a->{peripheries} = 2 if $style =~ /^double/;
+    }
+
+  # For nodes with shape plaintext, set the fillcolor to the background of
+  # the graph/group
+  my $shape = $a->{shape} || 'rect';
+  if ($class =~ /node/ && $shape eq 'plaintext')
+    {
+    my $p = $self->parent();
+    $a->{fillcolor} = $p->attribute('fill');
+    $a->{fillcolor} = 'white' if $a->{fillcolor} eq 'inherit';
+    }
+
+  $shape = $self->attribute('shape') unless $self->isa_cell();
+
+  # for point-shaped nodes, include the point as label and set width/height
+  if ($shape eq 'point')
+    {
+    require Graph::Easy::As_ascii;		# for _u8 and point-style
+
+    my $style = $self->_point_style( $self->attribute('pointstyle') );
+
+    $a->{label} = $style;
+    # for point-shaped invisible nodes, set height/width = 0
+    $a->{width} = 0, $a->{height} = 0 if $style eq '';
+    }
+  if ($shape eq 'invisible')
+    {
+    $a->{label} = ' ';
+    }
+
+  $a->{rank} = '0' if $root ne '' && $root eq $self->{name};
+
+  # create the attributes as text:
+  for my $atr (sort keys %$a)
+    {
+    my $v = $a->{$atr};
+    $v =~ s/"/\\"/g;		# '2"' => '2\"'
+    $v = '"' . $v . '"' unless $v =~ /^[0-9]+\z/;	# 1, "1a"
+    $att .= "$atr: $v ";
+    }
+  $att =~ s/,\s$//;             # remove last ","
+
+  # generate attribute text if nec.
+  $att = ' { ' . $att . '}' if $att ne '';
+
+  $att;
+  }
+
+sub as_vcg_txt
+  {
+  # return the node itself (w/o attributes) as VCG representation
+  my $self = shift;
+
+  my $name = $self->{name};
+
+  # escape special chars in name (including doublequote!)
+  $name =~ s/([\[\]\(\)\{\}"])/\\$1/g;
+
+  # quote:
+  '"' . $name . '"';
+  }
+
+1;
+__END__
+
+=head1 NAME
+
+Graph::Easy::As_vcg - Generate VCG/GDL text from Graph::Easy object
+
+=head1 SYNOPSIS
+
+	use Graph::Easy;
+
+	my $graph = Graph::Easy->new();
+
+	my $bonn = Graph::Easy::Node->new(
+		name => 'Bonn',
+	);
+	my $berlin = Graph::Easy::Node->new(
+		name => 'Berlin',
+	);
+
+	$graph->add_edge ($bonn, $berlin);
+
+	print $graph->as_vcg();
+
+
+This prints something like this:
+
+	graph: {
+		node: { title: "Bonn" }
+		node: { title: "Berlin" }
+		edge: { sourcename: "Bonn" targetname: "Berlin" }
+	}
+
+=head1 DESCRIPTION
+
+C<Graph::Easy::As_vcg> contains just the code for converting a
+L<Graph::Easy|Graph::Easy> object to either a VCG
+or GDL textual description.
+
+Note that the generated format is compatible to C<GDL> aka I<Graph
+Description Language>.
+
+=head1 EXPORT
+
+Exports nothing.
+
+=head1 SEE ALSO
+
+L<Graph::Easy>, L<http://rw4.cs.uni-sb.de/~sander/html/gsvcg1.html>.
+
+=head1 AUTHOR
+
+Copyright (C) 2004-2008 by Tels L<http://bloodgate.com>
+
+See the LICENSE file for information.
+
+=cut

perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Base.pm

@@ -0,0 +1,486 @@
+#############################################################################
+# A baseclass for Graph::Easy objects like nodes, edges etc.
+#
+#############################################################################
+
+package Graph::Easy::Base;
+
+$VERSION = '0.76';
+
+use strict;
+use warnings;
+
+#############################################################################
+
+{
+  # protected vars
+  my $id = 0;
+  sub _new_id { $id++; }
+  sub _reset_id { $id = 0; }
+}
+
+#############################################################################
+
+sub new
+  {
+  # Create a new object. This is a generic routine that is inherited
+  # by many other things like Edge, Cell etc.
+  my $self = bless { id => _new_id() }, shift;
+
+  my $args = $_[0];
+  $args = { name => $_[0] } if ref($args) ne 'HASH' && @_ == 1;
+  $args = { @_ } if ref($args) ne 'HASH' && @_ > 1;
+
+  $self->_init($args);
+  }
+
+sub _init
+  {
+  # Generic init routine, to be overriden in subclasses.
+  my ($self,$args) = @_;
+
+  $self;
+  }
+
+sub self
+  {
+  my $self = shift;
+
+  $self;
+  }
+
+#############################################################################
+
+sub no_fatal_errors
+  {
+  my $self = shift;
+
+  $self->{fatal_errors} = ($_[1] ? 1 : 0) if @_ > 0;
+
+  ~ ($self->{fatal_errors} || 0);
+  }
+
+sub fatal_errors
+  {
+  my $self = shift;
+
+  $self->{fatal_errors} = ($_[1] ? 0 : 1) if @_ > 0;
+
+  $self->{fatal_errors} || 0;
+  }
+
+sub error
+  {
+  my $self = shift;
+
+  # If we switched to a temp. Graphviz parser, then set the error on the
+  # original parser object, too:
+  $self->{_old_self}->error(@_) if ref($self->{_old_self});
+
+  # if called on a member on a graph, call error() on the graph itself:
+  return $self->{graph}->error(@_) if ref($self->{graph});
+
+  if (defined $_[0])
+    {
+    $self->{error} = $_[0];
+    if ($self->{_catch_errors})
+      {
+      push @{$self->{_errors}}, $self->{error};
+      }
+    else
+      {
+      $self->_croak($self->{error}, 2)
+        if ($self->{fatal_errors}) && $self->{error} ne '';
+      }
+    }
+  $self->{error} || '';
+  }
+
+sub error_as_html
+  {
+  # return error() properly escaped
+  my $self = shift;
+
+  my $msg = $self->{error};
+
+  $msg =~ s/&/&/g;
+  $msg =~ s/</&lt;/g;
+  $msg =~ s/>/&gt;/g;
+  $msg =~ s/"/&quot;/g;
+
+  $msg;
+  }
+
+sub catch_messages
+  {
+  # Catch all warnings (and errors if no_fatal_errors() was used)
+  # these can later be retrieved with warnings() and errors():
+  my $self = shift;
+
+  if (@_ > 0)
+    {
+    if ($_[0])
+      {
+      $self->{_catch_warnings} = 1;
+      $self->{_catch_errors} = 1;
+      $self->{_warnings} = [];
+      $self->{_errors} = [];
+      }
+    else
+      {
+      $self->{_catch_warnings} = 0;
+      $self->{_catch_errors} = 0;
+      }
+    }
+  $self;
+  }
+
+sub catch_warnings
+  {
+  # Catch all warnings
+  # these can later be retrieved with warnings():
+  my $self = shift;
+
+  if (@_ > 0)
+    {
+    if ($_[0])
+      {
+      $self->{_catch_warnings} = 1;
+      $self->{_warnings} = [];
+      }
+    else
+      {
+      $self->{_catch_warnings} = 0;
+      }
+    }
+  $self->{_catch_warnings};
+  }
+
+sub catch_errors
+  {
+  # Catch all errors
+  # these can later be retrieved with errors():
+  my $self = shift;
+
+  if (@_ > 0)
+    {
+    if ($_[0])
+      {
+      $self->{_catch_errors} = 1;
+      $self->{_errors} = [];
+      }
+    else
+      {
+      $self->{_catch_errors} = 0;
+      }
+    }
+  $self->{_catch_errors};
+  }
+
+sub warnings
+  {
+  # return all warnings that occurred after catch_messages(1)
+  my $self = shift;
+
+  @{$self->{_warnings}};
+  }
+
+sub errors
+  {
+  # return all errors that occurred after catch_messages(1)
+  my $self = shift;
+
+  @{$self->{_errors}};
+  }
+
+sub warn
+  {
+  my ($self, $msg) = @_;
+
+  if ($self->{_catch_warnings})
+    {
+    push @{$self->{_warnings}}, $msg;
+    }
+  else
+    {
+    require Carp;
+    Carp::carp('Warning: ' . $msg);
+    }
+  }
+
+sub _croak
+  {
+  my ($self, $msg, $level) = @_;
+  $level = 1 unless defined $level;
+
+  require Carp;
+  if (ref($self) && $self->{debug})
+    {
+    $Carp::CarpLevel = $level;			# don't report Base itself
+    Carp::confess($msg);
+    }
+  else
+    {
+    Carp::croak($msg);
+    }
+  }
+
+#############################################################################
+# class management
+
+sub sub_class
+  {
+  # get/set the subclass
+  my $self = shift;
+
+  if (defined $_[0])
+    {
+    $self->{class} =~ s/\..*//;		# nix subclass
+    $self->{class} .= '.' . $_[0];	# append new one
+    delete $self->{cache};
+    $self->{cache}->{subclass} = $_[0];
+    $self->{cache}->{class} = $self->{class};
+    return;
+    }
+  $self->{class} =~ /\.(.*)/;
+
+  return $1 if defined $1;
+
+  return $self->{cache}->{subclass} if defined $self->{cache}->{subclass};
+
+  # Subclass not defined, so check our base class for a possible set class
+  # attribute and return this:
+
+  # take a shortcut
+  my $g = $self->{graph};
+  if (defined $g)
+    {
+    my $subclass = $g->{att}->{$self->{class}}->{class};
+    $subclass = '' unless defined $subclass;
+    $self->{cache}->{subclass} = $subclass;
+    $self->{cache}->{class} = $self->{class};
+    return $subclass;
+    }
+
+  # not part of a graph?
+  $self->{cache}->{subclass} = $self->attribute('class');
+  }
+
+sub class
+  {
+  # return our full class name like "node.subclass" or "node"
+  my $self = shift;
+
+  $self->error("class() method does not take arguments") if @_ > 0;
+
+  $self->{class} =~ /\.(.*)/;
+
+  return $self->{class} if defined $1;
+
+  return $self->{cache}->{class} if defined $self->{cache}->{class};
+
+  # Subclass not defined, so check our base class for a possible set class
+  # attribute and return this:
+
+  my $subclass;
+  # take a shortcut:
+  my $g = $self->{graph};
+  if (defined $g)
+    {
+    $subclass = $g->{att}->{$self->{class}}->{class};
+    $subclass = '' unless defined $subclass;
+    }
+
+  $subclass = $self->{att}->{class} unless defined $subclass;
+  $subclass = '' unless defined $subclass;
+  $self->{cache}->{subclass} = $subclass;
+  $subclass = '.' . $subclass if $subclass ne '';
+
+  $self->{cache}->{class} = $self->{class} . $subclass;
+  }
+
+sub main_class
+  {
+  my $self = shift;
+
+  $self->{class} =~ /^(.+?)(\.|\z)/;	# extract first part
+
+  $1;
+  }
+
+1;
+__END__
+
+=head1 NAME
+
+Graph::Easy::Base - base class for Graph::Easy objects like nodes, edges etc
+
+=head1 SYNOPSIS
+
+	package Graph::Easy::My::Node;
+	use Graph::Easy::Base;
+	@ISA = qw/Graph::Easy::Base/;
+
+=head1 DESCRIPTION
+
+Used automatically and internally by L<Graph::Easy> - should not be used
+directly.
+
+=head1 METHODS
+
+=head2 new()
+
+	my $object = Graph::Easy::Base->new();
+
+Create a new object, and call C<_init()> on it.
+
+=head2 error()
+
+	$last_error = $object->error();
+
+	$object->error($error);			# set new messages
+	$object->error('');			# clear the error
+
+Returns the last error message, or '' for no error.
+
+When setting a new error message, C<< $self->_croak($error) >> will be called
+unless C<< $object->no_fatal_errors() >> is true.
+
+=head2 error_as_html()
+
+	my $error = $object->error_as_html();
+
+Returns the same error message as L<error()>, but properly escaped
+as HTML so it is safe to output to the client.
+
+=head2 warn()
+
+	$object->warn('Warning!');
+
+Warn on STDERR with the given message.
+
+=head2 no_fatal_errors()
+
+	$object->no_fatal_errors(1);
+
+Set the flag that determines whether setting an error message
+via C<error()> is fatal, e.g. results in a call to C<_croak()>.
+
+A true value will make errors non-fatal. See also L<fatal_errors>.
+
+=head2 fatal_errors()
+
+	$fatal = $object->fatal_errors();
+	$object->fatal_errors(0);		# turn off
+	$object->fatal_errors(1);		# turn on
+
+Set/get the flag that determines whether setting an error message
+via C<error()> is fatal, e.g. results in a call to C<_croak()>.
+
+A true value makes errors fatal.
+
+=head2 catch_errors()
+
+	my $catch_errors = $object->catch_errors();	# query
+	$object->catch_errors(1);			# enable
+
+	$object->...();					# some error
+	if ($object->error())
+	  {
+	  my @errors = $object->errors();		# retrieve
+	  }
+
+Enable/disable catching of all error messages. When enabled,
+all previously caught error messages are thrown away, and from this
+poin on new errors are non-fatal and stored internally. You can
+retrieve these errors later with the errors() method.
+
+=head2 catch_warnings()
+
+	my $catch_warns = $object->catch_warnings();	# query
+	$object->catch_warnings(1);			# enable
+
+	$object->...();					# some error
+	if ($object->warning())
+	  {
+	  my @warnings = $object->warnings();		# retrieve
+	  }
+
+Enable/disable catching of all warnings. When enabled, all previously
+caught warning messages are thrown away, and from this poin on new
+warnings are stored internally. You can retrieve these errors later
+with the errors() method.
+
+=head2 catch_messages()
+
+	# catch errors and warnings
+	$object->catch_messages(1);
+	# stop catching errors and warnings
+	$object->catch_messages(0);
+
+A true parameter is equivalent to:
+
+	$object->catch_warnings(1);
+	$object->catch_errors(1);
+
+See also: L<catch_warnings()> and L<catch_errors()> as well as
+L<errors()> and L<warnings()>.
+
+=head2 errors()
+
+	my @errors = $object->errors();
+
+Return all error messages that occurred after L<catch_messages()> was
+called.
+
+=head2 warnings()
+
+	my @warnings = $object->warnings();
+
+Return all warning messages that occurred after L<catch_messages()>
+or L<catch_errors()> was called.
+
+=head2 self()
+
+	my $self = $object->self();
+
+Returns the object itself.
+
+=head2 class()
+
+	my $class = $object->class();
+
+Returns the full class name like C<node.cities>. See also C<sub_class>.
+
+=head2 sub_class()
+
+	my $sub_class = $object->sub_class();
+
+Returns the sub class name like C<cities>. See also C<class>.
+
+=head2 main_class()
+
+	my $main_class = $object->main_class();
+
+Returns the main class name like C<node>. See also C<sub_class>.
+
+=head1 EXPORT
+
+None by default.
+
+=head1 SEE ALSO
+
+L<Graph::Easy>.
+
+=head1 AUTHOR
+
+Copyright (C) 2004 - 2008 by Tels L<http://bloodgate.com>.
+
+See the LICENSE file for more details.
+
+X<tels>
+X<bloodgate>
+X<license>
+X<gpl>
+
+=cut

perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Edge.pm

@@ -0,0 +1,751 @@
+#############################################################################
+# An edge connecting two nodes in Graph::Easy.
+#
+#############################################################################
+
+package Graph::Easy::Edge;
+
+use Graph::Easy::Node;
+@ISA = qw/Graph::Easy::Node/;		# an edge is just a special node
+$VERSION = '0.76';
+
+use strict;
+use warnings;
+
+use constant isa_cell => 1;
+
+#############################################################################
+
+sub _init
+  {
+  # generic init, override in subclasses
+  my ($self,$args) = @_;
+
+  $self->{class} = 'edge';
+
+  # leave this unitialized until we need it
+  # $self->{cells} = [ ];
+
+  foreach my $k (sort keys %$args)
+    {
+    if ($k !~ /^(label|name|style)\z/)
+      {
+      require Carp;
+      Carp::confess ("Invalid argument '$k' passed to Graph::Easy::Node->new()");
+      }
+    my $n = $k; $n = 'label' if $k eq 'name';
+
+    $self->{att}->{$n} = $args->{$k};
+    }
+
+  $self;
+  }
+
+#############################################################################
+# accessor methods
+
+sub bidirectional
+  {
+  my $self = shift;
+
+  if (@_ > 0)
+    {
+    my $old = $self->{bidirectional} || 0;
+    $self->{bidirectional} = $_[0] ? 1 : 0;
+
+    # invalidate layout?
+    $self->{graph}->{score} = undef if $old != $self->{bidirectional} && ref($self->{graph});
+    }
+
+  $self->{bidirectional};
+  }
+
+sub undirected
+  {
+  my $self = shift;
+
+  if (@_ > 0)
+    {
+    my $old = $self->{undirected} || 0;
+    $self->{undirected} = $_[0] ? 1 : 0;
+
+    # invalidate layout?
+    $self->{graph}->{score} = undef if $old != $self->{undirected} && ref($self->{graph});
+    }
+
+  $self->{undirected};
+  }
+
+sub has_ports
+  {
+  my $self = shift;
+
+  my $s_port = $self->{att}->{start} || $self->attribute('start');
+
+  return 1 if $s_port ne '';
+
+  my $e_port = $self->{att}->{end} || $self->attribute('end');
+
+  return 1 if $e_port ne '';
+
+  0;
+  }
+
+sub start_port
+  {
+  # return the side and portnumber if the edge has a shared source port
+  # undef for none
+  my $self = shift;
+
+  my $s = $self->{att}->{start} || $self->attribute('start');
+  return undef if !defined $s || $s !~ /,/;	# "south, 0" => ok, "south" => no
+
+  return (split /\s*,\s*/, $s) if wantarray;
+
+  $s =~ s/\s+//g;		# remove spaces to normalize "south, 0" to "south,0"
+  $s;
+  }
+
+sub end_port
+  {
+  # return the side and portnumber if the edge has a shared source port
+  # undef for none
+  my $self = shift;
+
+  my $s = $self->{att}->{end} || $self->attribute('end');
+  return undef if !defined $s || $s !~ /,/;	# "south, 0" => ok, "south" => no
+
+  return split /\s*,\s*/, $s if wantarray;
+
+  $s =~ s/\s+//g;		# remove spaces to normalize "south, 0" to "south,0"
+  $s;
+  }
+
+sub style
+  {
+  my $self = shift;
+
+  $self->{att}->{style} || $self->attribute('style');
+  }
+
+sub name
+  {
+  # returns actually the label
+  my $self = shift;
+
+  $self->{att}->{label} || '';
+  }
+
+#############################################################################
+# cell management - used by the cell-based layouter
+
+sub _cells
+  {
+  # return all the cells this edge currently occupies
+  my $self = shift;
+
+  $self->{cells} = [] unless defined $self->{cells};
+
+  @{$self->{cells}};
+  }
+
+sub _clear_cells
+  {
+  # remove all belonging cells
+  my $self = shift;
+
+  $self->{cells} = [];
+
+  $self;
+  }
+
+sub _unplace
+  {
+  # Take an edge, and remove all the cells it covers from the cells area
+  my ($self, $cells) = @_;
+
+  print STDERR "# clearing path from $self->{from}->{name} to $self->{to}->{name}\n" if $self->{debug};
+
+  for my $key (@{$self->{cells}})
+    {
+    # XXX TODO: handle crossed edges differently (from CROSS => HOR or VER)
+    # free in our cells area
+    delete $cells->{$key};
+    }
+
+  $self->clear_cells();
+
+  $self;
+  }
+
+sub _distance
+  {
+  # estimate the distance from SRC to DST node
+  my ($self) = @_;
+
+  my $src = $self->{from};
+  my $dst = $self->{to};
+
+  # one of them not yet placed?
+  return 100000 unless defined $src->{x} && defined $dst->{x};
+
+  my $cells = $self->{graph}->{cells};
+
+  # get all the starting positions
+  # distance = 1: slots, generate starting types, the direction is shifted
+  # by 90° counter-clockwise
+
+  my @start = $src->_near_places($cells, 1, undef, undef, $src->_shift(-90) );
+
+  # potential stop positions
+  my @stop = $dst->_near_places($cells, 1);		# distance = 1: slots
+
+  my ($s_p,@ss_p) = $self->port('start');
+  my ($e_p,@ee_p) = $self->port('end');
+
+  # the edge has a port description, limiting the start places
+  @start = $src->_allowed_places( \@start, $src->_allow( $s_p, @ss_p ), 3)
+    if defined $s_p;
+
+  # the edge has a port description, limiting the stop places
+  @stop = $dst->_allowed_places( \@stop, $dst->_allow( $e_p, @ee_p ), 3)
+    if defined $e_p;
+
+  my $stop = scalar @stop;
+
+  return 0 unless @stop > 0 && @start > 0;	# no free slots on one node?
+
+  my $lowest;
+
+  my $i = 0;
+  while ($i < scalar @start)
+    {
+    my $sx = $start[$i]; my $sy = $start[$i+1]; $i += 2;
+
+    # for each start point, calculate the distance to each stop point, then use
+    # the smallest as value
+
+    for (my $u = 0; $u < $stop; $u += 2)
+      {
+      my $dist = Graph::Easy::_astar_distance($sx,$sy, $stop[$u], $stop[$u+1]);
+      $lowest = $dist if !defined $lowest || $dist < $lowest;
+      }
+    }
+
+  $lowest;
+  }
+
+sub _add_cell
+  {
+  # add a cell to the list of cells this edge covers. If $after is a ref
+  # to a cell, then the new cell will be inserted right after this cell.
+  # if after is defined, but not a ref, the new cell will be inserted
+  # at the specified position.
+  my ($self, $cell, $after, $before) = @_;
+
+  $self->{cells} = [] unless defined $self->{cells};
+  my $cells = $self->{cells};
+
+  # if both are defined, but belong to different edges, just ignore $before:
+  $before = undef if ref($before) && $before->{edge} != $self;
+  $after = undef if ref($after) && $after->{edge} != $self;
+  if (!defined $after && ref($before))
+    {
+    $after = $before; $before = undef;
+    }
+
+  if (defined $after)
+    {
+    # insert the new cell right after $after
+    my $ofs = $after;
+    if (ref($after) && !ref($before))
+      {
+      # insert after $after
+      $ofs = 1;
+      for my $cell (@$cells)
+        {
+        last if $cell == $after;
+        $ofs++;
+        }
+      }
+    elsif (ref($after) && ref($before))
+      {
+      # insert between after and before (or before/after for "reversed edges)
+      $ofs = 0;
+      my $found = 0;
+      while ($ofs < scalar @$cells - 1)		# 0,1,2,3 => 0 .. 2
+        {
+        my $c1 = $cells->[$ofs];
+        my $c2 = $cells->[$ofs+1];
+	$ofs++;
+        $found++, last if (($c1 == $after && $c2 == $before) ||
+                 ($c1 == $before && $c2 == $after));
+        }
+      if (!$found)
+	{
+        # XXX TODO: last effort
+
+        # insert after $after
+        $ofs = 1;
+        for my $cell (@$cells)
+          {
+          last if $cell == $after;
+          $ofs++;
+          }
+        $found++;
+	}
+      $self->_croak("Could not find $after and $before") unless $found;
+      }
+    splice (@$cells, $ofs, 0, $cell);
+    }
+  else
+    {
+    # insert new cell at the end
+    push @$cells, $cell;
+    }
+
+  $cell->_update_boundaries();
+
+  $self;
+  }
+
+#############################################################################
+
+sub from
+  {
+  my $self = shift;
+
+  $self->{from};
+  }
+
+sub to
+  {
+  my $self = shift;
+
+  $self->{to};
+  }
+
+sub nodes
+  {
+  my $self = shift;
+
+  ($self->{from}, $self->{to});
+  }
+
+sub start_at
+  {
+  # move the edge's start point from the current node to the given node
+  my ($self, $node) = @_;
+
+  # if not a node yet, or not part of this graph, make into one proper node
+  $node = $self->{graph}->add_node($node);
+
+  $self->_croak("start_at() needs a node object, but got $node")
+    unless ref($node) && $node->isa('Graph::Easy::Node');
+
+  # A => A => nothing to do
+  return $node if $self->{from} == $node;
+
+  # delete self at A
+  delete $self->{from}->{edges}->{ $self->{id} };
+
+  # set "from" to B
+  $self->{from} = $node;
+
+  # add to B
+  $self->{from}->{edges}->{ $self->{id} } = $self;
+
+  # invalidate layout
+  $self->{graph}->{score} = undef if ref($self->{graph});
+
+  # return new start point
+  $node;
+  }
+
+sub end_at
+  {
+  # move the edge's end point from the current node to the given node
+  my ($self, $node) = @_;
+
+  # if not a node yet, or not part of this graph, make into one proper node
+  $node = $self->{graph}->add_node($node);
+
+  $self->_croak("start_at() needs a node object, but got $node")
+    unless ref($node) && $node->isa('Graph::Easy::Node');
+
+  # A => A => nothing to do
+  return $node if $self->{to} == $node;
+
+  # delete self at A
+  delete $self->{to}->{edges}->{ $self->{id} };
+
+  # set "to" to B
+  $self->{to} = $node;
+
+  # add to node B
+  $self->{to}->{edges}->{ $self->{id} } = $self;
+
+  # invalidate layout
+  $self->{graph}->{score} = undef if ref($self->{graph});
+
+  # return new end point
+  $node;
+  }
+
+sub edge_flow
+  {
+  # return the flow at this edge  or '' if the edge itself doesn't have a flow
+  my $self = shift;
+
+  # our flow comes from ourselves
+  my $flow = $self->{att}->{flow};
+  $flow = $self->raw_attribute('flow') unless defined $flow;
+
+  $flow;
+  }
+
+sub flow
+  {
+  # return the flow at this edge (including inheriting flow from node)
+  my ($self) = @_;
+
+  # print STDERR "# flow from $self->{from}->{name} to $self->{to}->{name}\n";
+
+  # our flow comes from ourselves
+  my $flow = $self->{att}->{flow};
+  # or maybe our class
+  $flow = $self->raw_attribute('flow') unless defined $flow;
+
+  # if the edge doesn't have a flow, maybe the node has a default out flow
+  $flow = $self->{from}->{att}->{flow} if !defined $flow;
+
+  # if that didn't work out either, use the parents flows
+  $flow = $self->parent()->attribute('flow') if !defined $flow;
+  # or finally, the default "east":
+  $flow = 90 if !defined $flow;
+
+  # absolute flow does not depend on the in-flow, so can return early
+  return $flow if $flow =~ /^(0|90|180|270)\z/;
+
+  # in-flow comes from our "from" node
+  my $in = $self->{from}->flow();
+
+# print STDERR "# in: $self->{from}->{name} = $in\n";
+
+  my $out = $self->{graph}->_flow_as_direction($in,$flow);
+  $out;
+  }
+
+sub port
+  {
+  my ($self, $which) = @_;
+
+  $self->_croak("'$which' must be one of 'start' or 'end' in port()") unless $which =~ /^(start|end)/;
+
+  # our flow comes from ourselves
+  my $sp = $self->attribute($which);
+
+  return (undef,undef) unless defined $sp && $sp ne '';
+
+  my ($side, $port) = split /\s*,\s*/, $sp;
+
+  # if absolut direction, return as is
+  my $s = Graph::Easy->_direction_as_side($side);
+
+  if (defined $s)
+    {
+    my @rc = ($s); push @rc, $port if defined $port;
+    return @rc;
+    }
+
+  # in_flow comes from our "from" node
+  my $in = 90; $in = $self->{from}->flow() if ref($self->{from});
+
+  # turn left in "south" etc:
+  $s = Graph::Easy->_flow_as_side($in,$side);
+
+  my @rc = ($s); push @rc, $port if defined $port;
+  @rc;
+  }
+
+sub flip
+  {
+  # swap from and to for this edge
+  my ($self) = @_;
+
+  ($self->{from}, $self->{to}) = ($self->{to}, $self->{from});
+
+  # invalidate layout
+  $self->{graph}->{score} = undef if ref($self->{graph});
+
+  $self;
+  }
+
+sub as_ascii
+  {
+  my ($self, $x,$y) = @_;
+
+  # invisible nodes, or very small ones
+  return '' if $self->{w} == 0 || $self->{h} == 0;
+
+  my $fb = $self->_framebuffer($self->{w}, $self->{h});
+
+  ###########################################################################
+  # "draw" the label into the framebuffer (e.g. the edge and the text)
+  $self->_draw_label($fb, $x, $y, '');
+
+  join ("\n", @$fb);
+  }
+
+sub as_txt
+  {
+  require Graph::Easy::As_ascii;
+
+  _as_txt(@_);
+  }
+
+1;
+__END__
+
+=head1 NAME
+
+Graph::Easy::Edge - An edge (a path connecting one ore more nodes)
+
+=head1 SYNOPSIS
+
+        use Graph::Easy;
+
+	my $ssl = Graph::Easy::Edge->new(
+		label => 'encrypted connection',
+		style => 'solid',
+	);
+	$ssl->set_attribute('color', 'red');
+
+	my $src = Graph::Easy::Node->new('source');
+
+	my $dst = Graph::Easy::Node->new('destination');
+
+	$graph = Graph::Easy->new();
+
+	$graph->add_edge($src, $dst, $ssl);
+
+	print $graph->as_ascii();
+
+=head1 DESCRIPTION
+
+A C<Graph::Easy::Edge> represents an edge between two (or more) nodes in a
+simple graph.
+
+Each edge has a direction (from source to destination, or back and forth),
+plus a style (line width and style), colors etc. It can also have a label,
+e.g. a text associated with it.
+
+During the layout phase, each edge also contains a list of path-elements
+(also called cells), which make up the path from source to destination.
+
+=head1 METHODS
+
+=head2 error()
+
+	$last_error = $edge->error();
+
+	$cvt->error($error);			# set new messages
+	$cvt->error('');			# clear error
+
+Returns the last error message, or '' for no error.
+
+=head2 as_ascii()
+
+	my $ascii = $edge->as_ascii();
+
+Returns the edge as a little ascii representation.
+
+=head2 as_txt()
+
+	my $txt = $edge->as_txt();
+
+Returns the edge as a little Graph::Easy textual representation.
+
+=head2 label()
+
+	my $label = $edge->label();
+
+Returns the label (also known as 'name') of the edge.
+
+=head2 name()
+
+	my $label = $edge->name();
+
+To make the interface more consistent, the C<name()> method of
+an edge can also be called, and it will returned either the edge
+label, or the empty string if the edge doesn't have a label.
+
+=head2 style()
+
+	my $style = $edge->style();
+
+Returns the style of the edge, like 'solid', 'dotted', 'double', etc.
+
+=head2 nodes()
+
+	my @nodes = $edge->nodes();
+
+Returns the source and target node that this edges connects as objects.
+
+=head2 bidirectional()
+
+	$edge->bidirectional(1);
+	if ($edge->bidirectional())
+	  {
+	  }
+
+Returns true if the edge is bidirectional, aka has arrow heads on both ends.
+An optional parameter will set the bidirectional status of the edge.
+
+=head2 undirected()
+
+	$edge->undirected(1);
+	if ($edge->undirected())
+	  {
+	  }
+
+Returns true if the edge is undirected, aka has now arrow at all.
+An optional parameter will set the undirected status of the edge.
+
+=head2 has_ports()
+
+	if ($edge->has_ports())
+	  {
+	  ...
+	  }
+
+Return true if the edge has restriction on the starting or ending
+port, e.g. either the C<start> or C<end> attribute is set on
+this edge.
+
+=head2 start_port()
+
+	my $port = $edge->start_port();
+
+Return undef if the edge does not have a fixed start port, otherwise
+returns the port as "side, number", for example "south, 0".
+
+=head2 end_port()
+
+	my $port = $edge->end_port();
+
+Return undef if the edge does not have a fixed end port, otherwise
+returns the port as "side, number", for example "south, 0".
+
+=head2 from()
+
+	my $from = $edge->from();
+
+Returns the node that this edge starts at. See also C<to()>.
+
+=head2 to()
+
+	my $to = $edge->to();
+
+Returns the node that this edge leads to. See also C<from()>.
+
+=head2 start_at()
+
+	$edge->start_at($other);
+	my $other = $edge->start_at('some node');
+
+Set the edge's start point to the given node. If given a node name,
+will add that node to the graph first.
+
+Returns the new edge start point node.
+
+=head2 end_at()
+
+	$edge->end_at($other);
+	my $other = $edge->end_at('some other node');
+
+Set the edge's end point to the given node. If given a node name,
+will add that node to the graph first.
+
+Returns the new edge end point node.
+
+=head2 flip()
+
+	$edge->flip();
+
+Swaps the C<start> and C<end> nodes on this edge, e.g. reverses the direction
+of the edge.
+
+X<transpose>
+
+=head2 flow()
+
+	my $flow = $edge->flow();
+
+Returns the flow for this edge, honoring inheritance. An edge without
+a specific flow set will inherit the flow from the node it comes from.
+
+=head2 edge_flow()
+
+	my $flow = $edge->edge_flow();
+
+Returns the flow for this edge, or undef if it has none set on either
+the object itself or its class.
+
+=head2 port()
+
+	my ($side, $number) = $edge->port('start');
+	my ($side, $number) = $edge->port('end');
+
+Return the side and port number where this edge starts or ends.
+
+Returns undef for $side if the edge has no port restriction. The
+returned side will be one absolute direction of C<east>, C<west>,
+C<north> or C<south>, depending on the port restriction and
+flow at that edge.
+
+=head2 get_attributes()
+
+        my $att = $object->get_attributes();
+
+Return all effective attributes on this object (graph/node/group/edge) as
+an anonymous hash ref. This respects inheritance and default values.
+
+See also L<raw_attributes()>.
+
+=head2 raw_attributes()
+
+        my $att = $object->get_attributes();
+
+Return all set attributes on this object (graph/node/group/edge) as
+an anonymous hash ref. This respects inheritance, but does not include
+default values for unset attributes.
+
+See also L<get_attributes()>.
+
+=head2 attribute related methods
+
+You can call all the various attribute related methods like C<set_attribute()>,
+C<get_attribute()>, etc. on an edge, too. For example:
+
+	$edge->set_attribute('label', 'by train');
+	my $attr = $edge->get_attributes();
+	my $raw_attr = $edge->raw_attributes();
+
+You can find more documentation in L<Graph::Easy>.
+
+=head1 EXPORT
+
+None by default.
+
+=head1 SEE ALSO
+
+L<Graph::Easy>.
+
+=head1 AUTHOR
+
+Copyright (C) 2004 - 2008 by Tels L<http://bloodgate.com>.
+
+See the LICENSE file for more details.
+
+=cut

perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Group.pm

@@ -0,0 +1,828 @@
+#############################################################################
+# A group of nodes. Part of Graph::Easy.
+#
+#############################################################################
+
+package Graph::Easy::Group;
+
+use Graph::Easy::Group::Cell;
+use Graph::Easy;
+use Scalar::Util qw/weaken/;
+
+@ISA = qw/Graph::Easy::Node Graph::Easy/;
+$VERSION = '0.76';
+
+use strict;
+use warnings;
+
+use Graph::Easy::Util qw(ord_values);
+
+#############################################################################
+
+sub _init
+  {
+  # generic init, override in subclasses
+  my ($self,$args) = @_;
+
+  $self->{name} = 'Group #'. $self->{id};
+  $self->{class} = 'group';
+  $self->{_cells} = {};				# the Group::Cell objects
+#  $self->{cx} = 1;
+#  $self->{cy} = 1;
+
+  foreach my $k (sort keys %$args)
+    {
+    if ($k !~ /^(graph|name)\z/)
+      {
+      require Carp;
+      Carp::confess ("Invalid argument '$k' passed to Graph::Easy::Group->new()");
+      }
+    $self->{$k} = $args->{$k};
+    }
+
+  $self->{nodes} = {};
+  $self->{groups} = {};
+  $self->{att} = {};
+
+  $self;
+  }
+
+#############################################################################
+# accessor methods
+
+sub nodes
+  {
+  my $self = shift;
+
+  wantarray ? ( ord_values ( $self->{nodes} ) ) : scalar keys %{$self->{nodes}};
+  }
+
+sub edges
+  {
+  # edges leading from/to this group
+  my $self = shift;
+
+  wantarray ? ( ord_values ( $self->{edges} ) ) : scalar keys %{$self->{edges}};
+  }
+
+sub edges_within
+  {
+  # edges between nodes inside this group
+  my $self = shift;
+
+  wantarray ? ( ord_values ( $self->{edges_within} ) ) :
+		scalar keys %{$self->{edges_within}};
+  }
+
+sub _groups_within
+  {
+  my ($self, $level, $max_level, $cur) = @_;
+
+  no warnings 'recursion';
+
+  push @$cur, ord_values ( $self->{groups} );
+
+  return if $level >= $max_level;
+
+  for my $g (ord_values ( $self->{groups} ))
+    {
+    $g->_groups_within($level+1,$max_level, $cur) if scalar keys %{$g->{groups}} > 0;
+    }
+  }
+
+#############################################################################
+
+sub set_attribute
+  {
+  my ($self, $name, $val, $class) = @_;
+
+  $self->SUPER::set_attribute($name, $val, $class);
+
+  # if defined attribute "nodeclass", put our nodes into that class
+  if ($name eq 'nodeclass')
+    {
+    my $class = $self->{att}->{nodeclass};
+    for my $node (ord_values ( $self->{nodes} ) )
+      {
+      $node->sub_class($class);
+      }
+    }
+  $self;
+  }
+
+sub shape
+  {
+  my ($self) = @_;
+
+  # $self->{att}->{shape} || $self->attribute('shape');
+  '';
+  }
+
+#############################################################################
+# node handling
+
+sub add_node
+  {
+  # add a node to this group
+  my ($self,$n) = @_;
+
+  if (!ref($n) || !$n->isa("Graph::Easy::Node"))
+    {
+    if (!ref($self->{graph}))
+      {
+      return $self->error("Cannot add non node-object $n to group '$self->{name}'");
+      }
+    $n = $self->{graph}->add_node($n);
+    }
+  $self->{nodes}->{ $n->{name} } = $n;
+
+  # if defined attribute "nodeclass", put our nodes into that class
+  $n->sub_class($self->{att}->{nodeclass}) if exists $self->{att}->{nodeclass};
+
+  # register ourselves with the member
+  $n->{group} = $self;
+
+  # set the proper attribute (for layout)
+  $n->{att}->{group} = $self->{name};
+
+  # Register the nodes and the edge with our graph object
+  # and weaken the references. Be careful 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.
+
+  # If the node does not belong to a graph yet or belongs to another
+  # graph, add it to our own graph:
+  weaken($n->{graph} = $self->{graph}) unless
+	$n->{graph} && $self->{graph} && $n->{graph} == $self->{graph};
+
+  $n;
+  }
+
+sub add_member
+  {
+  # add a node or group to this group
+  my ($self,$n) = @_;
+
+  if (!ref($n) || !$n->isa("Graph::Easy::Node"))
+    {
+    if (!ref($self->{graph}))
+      {
+      return $self->error("Cannot add non node-object $n to group '$self->{name}'");
+      }
+    $n = $self->{graph}->add_node($n);
+    }
+  return $self->_add_edge($n) if $n->isa("Graph::Easy::Edge");
+  return $self->add_group($n) if $n->isa('Graph::Easy::Group');
+
+  $self->{nodes}->{ $n->{name} } = $n;
+
+  # if defined attribute "nodeclass", put our nodes into that class
+  my $cl = $self->attribute('nodeclass');
+  $n->sub_class($cl) if $cl ne '';
+
+  # register ourselves with the member
+  $n->{group} = $self;
+
+  # set the proper attribute (for layout)
+  $n->{att}->{group} = $self->{name};
+
+  # Register the nodes and the edge with our graph object
+  # and weaken the references. Be careful 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.
+
+  # If the node does not belong to a graph yet or belongs to another
+  # graph, add it to our own graph:
+  weaken($n->{graph} = $self->{graph}) unless
+	$n->{graph} && $self->{graph} && $n->{graph} == $self->{graph};
+
+  $n;
+  }
+
+sub del_member
+  {
+  # delete a node or group from this group
+  my ($self,$n) = @_;
+
+  # XXX TOOD: groups vs. nodes
+  my $class = 'nodes'; my $key = 'name';
+  if ($n->isa('Graph::Easy::Group'))
+    {
+    # XXX TOOD: groups vs. nodes
+    $class = 'groups'; $key = 'id';
+    }
+  delete $self->{$class}->{ $n->{$key} };
+  delete $n->{group};			# unregister us
+
+  if ($n->isa('Graph::Easy::Node'))
+    {
+    # find all edges that mention this node and drop them from the group
+    my $edges = $self->{edges_within};
+    for my $e (ord_values ( $edges))
+      {
+      delete $edges->{ $e->{id} } if $e->{from} == $n || $e->{to} == $n;
+      }
+    }
+
+  $self;
+  }
+
+sub del_node
+  {
+  # delete a node from this group
+  my ($self,$n) = @_;
+
+  delete $self->{nodes}->{ $n->{name} };
+  delete $n->{group};			# unregister us
+  delete $n->{att}->{group};		# delete the group attribute
+
+  # find all edges that mention this node and drop them from the group
+  my $edges = $self->{edges_within};
+  for my $e (ord_values ( $edges))
+    {
+    delete $edges->{ $e->{id} } if $e->{from} == $n || $e->{to} == $n;
+    }
+
+  $self;
+  }
+
+sub add_nodes
+  {
+  my $self = shift;
+
+  # make a copy in case of scalars
+  my @arg = @_;
+  foreach my $n (@arg)
+    {
+    if (!ref($n) && !ref($self->{graph}))
+      {
+      return $self->error("Cannot add non node-object $n to group '$self->{name}'");
+      }
+    return $self->error("Cannot add group-object $n to group '$self->{name}'")
+      if $n->isa('Graph::Easy::Group');
+
+    $n = $self->{graph}->add_node($n) unless ref($n);
+
+    $self->{nodes}->{ $n->{name} } = $n;
+
+    # set the proper attribute (for layout)
+    $n->{att}->{group} = $self->{name};
+
+#   XXX TODO TEST!
+#    # if defined attribute "nodeclass", put our nodes into that class
+#    $n->sub_class($self->{att}->{nodeclass}) if exists $self->{att}->{nodeclass};
+
+    # register ourselves with the member
+    $n->{group} = $self;
+
+    # Register the nodes and the edge with our graph object
+    # and weaken the references. Be careful 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.
+
+    # If the node does not belong to a graph yet or belongs to another
+    # graph, add it to our own graph:
+    weaken($n->{graph} = $self->{graph}) unless
+	$n->{graph} && $self->{graph} && $n->{graph} == $self->{graph};
+
+    }
+
+  @arg;
+  }
+
+#############################################################################
+
+sub _del_edge
+  {
+  # delete an edge from this group
+  my ($self,$e) = @_;
+
+  delete $self->{edges_within}->{ $e->{id} };
+  delete $e->{group};			# unregister us
+
+  $self;
+  }
+
+sub _add_edge
+  {
+  # add an edge to this group (e.g. when both from/to of this edge belong
+  # to this group)
+  my ($self,$e) = @_;
+
+  if (!ref($e) || !$e->isa("Graph::Easy::Edge"))
+    {
+    return $self->error("Cannot add non edge-object $e to group '$self->{name}'");
+    }
+  $self->{edges_within}->{ $e->{id} } = $e;
+
+  # if defined attribute "edgeclass", put our edges into that class
+  my $edge_class = $self->attribute('edgeclass');
+  $e->sub_class($edge_class) if $edge_class ne '';
+
+  # XXX TODO: inline
+  $self->add_node($e->{from});
+  $self->add_node($e->{to});
+
+  # register us, but don't do weaken() if the ref was already set
+  weaken($e->{group} = $self) unless defined $e->{group} && $e->{group} == $self;
+
+  $e;
+  }
+
+sub add_edge
+  {
+  # Add an edge to the graph of this group, then register it with this group.
+  my ($self,$from,$to) = @_;
+
+  my $g = $self->{graph};
+  return $self->error("Cannot add edge to group '$self->{name}' without graph")
+    unless defined $g;
+
+  my $edge = $g->add_edge($from,$to);
+
+  $self->_add_edge($edge);
+  }
+
+sub add_edge_once
+  {
+  # Add an edge to the graph of this group, then register it with this group.
+  my ($self,$from,$to) = @_;
+
+  my $g = $self->{graph};
+  return $self->error("Cannot non edge to group '$self->{name}' without graph")
+    unless defined $g;
+
+  my $edge = $g->add_edge_once($from,$to);
+  # edge already exists => so fetch it
+  $edge = $g->edge($from,$to) unless defined $edge;
+
+  $self->_add_edge($edge);
+  }
+
+#############################################################################
+
+sub add_group
+  {
+  # add a group to us
+  my ($self,$group) = @_;
+
+  # 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 = $self->{graph}->add_group($name) unless ref $group;
+
+  # index under the group name for easier lookup
+  $self->{groups}->{ $group->{name} } = $group;
+
+  # make attribute->('group') work
+  $group->{att}->{group} = $self->{name};
+
+  # register group with the graph and ourself
+  $group->{graph} = $self->{graph};
+  $group->{group} = $self;
+  {
+    no warnings; # don't warn on already weak references
+    weaken($group->{graph});
+    weaken($group->{group});
+  }
+  $self->{graph}->{score} = undef;		# invalidate last layout
+
+  $group;
+  }
+
+# cell management - used by the layouter
+
+sub _cells
+  {
+  # return all the cells this group currently occupies
+  my $self = shift;
+
+  $self->{_cells};
+  }
+
+sub _clear_cells
+  {
+  # remove all belonging cells
+  my $self = shift;
+
+  $self->{_cells} = {};
+
+  $self;
+  }
+
+sub _add_cell
+  {
+  # add a cell to the list of cells this group covers
+  my ($self,$cell) = @_;
+
+  $cell->_update_boundaries();
+  $self->{_cells}->{"$cell->{x},$cell->{y}"} = $cell;
+  $cell;
+  }
+
+sub _del_cell
+  {
+  # delete a cell from the list of cells this group covers
+  my ($self,$cell) = @_;
+
+  delete $self->{_cells}->{"$cell->{x},$cell->{y}"};
+  delete $cell->{group};
+
+  $self;
+  }
+
+sub _find_label_cell
+  {
+  # go through all cells of this group and find one where to attach the label
+  my $self = shift;
+
+  my $g = $self->{graph};
+
+  my $align = $self->attribute('align');
+  my $loc = $self->attribute('labelpos');
+
+  # depending on whether the label should be on top or bottom:
+  my $match = qr/^\s*gt\s*\z/;
+  $match = qr/^\s*gb\s*\z/ if $loc eq 'bottom';
+
+  my $lc;						# the label cell
+
+  for my $c (ord_values ( $self->{_cells} ))
+    {
+    # find a cell where to put the label
+    next unless $c->{cell_class} =~ $match;
+
+    if (defined $lc)
+      {
+      if ($align eq 'left')
+	{
+	# find top-most, left-most cell
+	next if $lc->{x} < $c->{x} || $lc->{y} < $c->{y};
+	}
+      elsif ($align eq 'center')
+	{
+	# just find any top-most cell
+	next if $lc->{y} < $c->{y};
+	}
+      elsif ($align eq 'right')
+	{
+	# find top-most, right-most cell
+	next if $lc->{x} > $c->{x} || $lc->{y} < $c->{y};
+	}
+      }
+    $lc = $c;
+    }
+
+  # find the cell mostly near the center in the found top-row
+  if (ref($lc) && $align eq 'center')
+    {
+    my ($left, $right);
+    # find left/right most coordinates
+    for my $c (ord_values ( $self->{_cells} ))
+      {
+      next if $c->{y} != $lc->{y};
+      $left = $c->{x} if !defined $left || $left > $c->{x};
+      $right = $c->{x} if !defined $right || $right < $c->{x};
+      }
+    my $center = int(($right - $left) / 2 + $left);
+    my $min_dist;
+    # find the cell mostly near the center in the found top-row
+    for my $c (ord_values ( $self->{_cells} ))
+      {
+      next if $c->{y} != $lc->{y};
+      # squared to get rid of sign
+      my $dist = ($center - $c->{x}); $dist *= $dist;
+      next if defined $min_dist && $dist > $min_dist;
+      $min_dist = $dist; $lc = $c;
+      }
+    }
+
+  print STDERR "# Setting label for group '$self->{name}' at $lc->{x},$lc->{y}\n"
+	if $self->{debug};
+
+  $lc->_set_label() if ref($lc);
+  }
+
+sub layout
+  {
+  my $self = shift;
+
+  $self->_croak('Cannot call layout() on a Graph::Easy::Group directly.');
+  }
+
+sub _layout
+  {
+  my $self = shift;
+
+  ###########################################################################
+  # set local {debug} for groups
+  local $self->{debug} = $self->{graph}->{debug};
+
+  $self->SUPER::_layout();
+  }
+
+sub _set_cell_types
+  {
+  my ($self, $cells) = @_;
+
+  # Set the right cell class for all of our cells:
+  for my $cell (ord_values ( $self->{_cells} ))
+    {
+    $cell->_set_type($cells);
+    }
+
+  $self;
+  }
+
+1;
+__END__
+
+=head1 NAME
+
+Graph::Easy::Group - A group of nodes (aka subgraph) in Graph::Easy
+
+=head1 SYNOPSIS
+
+        use Graph::Easy;
+
+        my $bonn = Graph::Easy::Node->new('Bonn');
+
+        $bonn->set_attribute('border', 'solid 1px black');
+
+        my $berlin = Graph::Easy::Node->new( name => 'Berlin' );
+
+	my $cities = Graph::Easy::Group->new(
+		name => 'Cities',
+	);
+        $cities->set_attribute('border', 'dashed 1px blue');
+
+	$cities->add_nodes ($bonn);
+	# $bonn will be ONCE in the group
+	$cities->add_nodes ($bonn, $berlin);
+
+
+=head1 DESCRIPTION
+
+A C<Graph::Easy::Group> represents a group of nodes in an C<Graph::Easy>
+object. These nodes are grouped together on output.
+
+=head1 METHODS
+
+=head2 new()
+
+	my $group = Graph::Easy::Group->new( $options );
+
+Create a new, empty group. C<$options> are the possible options, see
+L<Graph::Easy::Node> for a list.
+
+=head2 error()
+
+	$last_error = $group->error();
+
+	$group->error($error);			# set new messages
+	$group->error('');			# clear error
+
+Returns the last error message, or '' for no error.
+
+=head2 as_ascii()
+
+	my $ascii = $group->as_ascii();
+
+Return the group as a little box drawn in ASCII art as a string.
+
+=head2 name()
+
+	my $name = $group->name();
+
+Return the name of the group.
+
+=head2 id()
+
+	my $id = $group->id();
+
+Returns the group's unique ID number.
+
+=head2 set_attribute()
+
+        $group->set_attribute('border-style', 'none');
+
+Sets the specified attribute of this (and only this!) group to the
+specified value.
+
+=head2 add_member()
+
+	$group->add_member($node);
+	$group->add_member($group);
+
+Add the specified object to this group and returns this member. If the
+passed argument is a scalar, will treat it as a node name.
+
+Note that each object can only be a member of one group at a time.
+
+=head2 add_node()
+
+	$group->add_node($node);
+
+Add the specified node to this group and returns this node.
+
+Note that each object can only be a member of one group at a time.
+
+=head2 add_edge(), add_edge_once()
+
+	$group->add_edge($edge);		# Graph::Easy::Edge
+	$group->add_edge($from, $to);		# Graph::Easy::Node or
+						# Graph::Easy::Group
+	$group->add_edge('From', 'To');		# Scalars
+
+If passed an Graph::Easy::Edge object, moves the nodes involved in
+this edge to the group.
+
+if passed two nodes, adds these nodes to the graph (unless they already
+exist) and adds an edge between these two nodes. See L<add_edge_once()>
+to avoid creating multiple edges.
+
+This method works only on groups that are part of a graph.
+
+Note that each object can only be a member of one group at a time,
+and edges are automatically a member of a group if and only if both
+the target and the destination node are a member of the same group.
+
+=head2 add_group()
+
+	my $inner = $group->add_group('Group name');
+	my $nested = $group->add_group($group);
+
+Add a group as subgroup to this group and returns this group.
+
+=head2 del_member()
+
+	$group->del_member($node);
+	$group->del_member($group);
+
+Delete the specified object from this group.
+
+=head2 del_node()
+
+	$group->del_node($node);
+
+Delete the specified node from this group.
+
+=head2 del_edge()
+
+	$group->del_edge($edge);
+
+Delete the specified edge from this group.
+
+=head2 add_nodes()
+
+	$group->add_nodes($node, $node2, ... );
+
+Add all the specified nodes to this group and returns them as a list.
+
+=head2 nodes()
+
+	my @nodes = $group->nodes();
+
+Returns a list of all node objects that belong to this group.
+
+=head2 edges()
+
+	my @edges = $group->edges();
+
+Returns a list of all edge objects that lead to or from this group.
+
+Note: This does B<not> return edges between nodes that are inside the group,
+for this see L<edges_within()>.
+
+=head2 edges_within()
+
+	my @edges_within = $group->edges_within();
+
+Returns a list of all edge objects that are I<inside> this group, in arbitrary
+order. Edges are automatically considered I<inside> a group if their starting
+and ending node both are in the same group.
+
+Note: This does B<not> return edges between this group and other groups,
+nor edges between this group and nodes outside this group, for this see
+L<edges()>.
+
+=head2 groups()
+
+	my @groups = $group->groups();
+
+Returns the contained groups of this group as L<Graph::Easy::Group> objects,
+in arbitrary order.
+
+=head2 groups_within()
+
+	# equivalent to $group->groups():
+	my @groups = $group->groups_within();		# all
+	my @toplevel_groups = $group->groups_within(0);	# level 0 only
+
+Return the groups that are inside this group, up to the specified level,
+in arbitrary order.
+
+The default level is -1, indicating no bounds and thus all contained
+groups are returned.
+
+A level of 0 means only the direct children, and hence only the toplevel
+groups will be returned. A level 1 means the toplevel groups and their
+toplevel children, and so on.
+
+=head2 as_txt()
+
+	my $txt = $group->as_txt();
+
+Returns the group as Graph::Easy textual description.
+
+=head2 _find_label_cell()
+
+	$group->_find_label_cell();
+
+Called by the layouter once for each group. Goes through all cells of this
+group and finds one where to attach the label to. Internal usage only.
+
+=head2 get_attributes()
+
+        my $att = $object->get_attributes();
+
+Return all effective attributes on this object (graph/node/group/edge) as
+an anonymous hash ref. This respects inheritance and default values.
+
+See also L<raw_attributes()>.
+
+=head2 raw_attributes()
+
+        my $att = $object->get_attributes();
+
+Return all set attributes on this object (graph/node/group/edge) as
+an anonymous hash ref. This respects inheritance, but does not include
+default values for unset attributes.
+
+See also L<get_attributes()>.
+
+=head2 attribute related methods
+
+You can call all the various attribute related methods like C<set_attribute()>,
+C<get_attribute()>, etc. on a group, too. For example:
+
+	$group->set_attribute('label', 'by train');
+	my $attr = $group->get_attributes();
+
+You can find more documentation in L<Graph::Easy>.
+
+=head2 layout()
+
+This routine should not be called on groups, it only works on the graph
+itself.
+
+=head2 shape()
+
+	my $shape = $group->shape();
+
+Returns the shape of the group as string.
+
+=head2 has_as_successor()
+
+	if ($group->has_as_successor($other))
+	  {
+	  ...
+	  }
+
+Returns true if C<$other> (a node or group) is a successor of this group, e.g.
+if there is an edge leading from this group to C<$other>.
+
+=head2 has_as_predecessor()
+
+	if ($group->has_as_predecessor($other))
+	  {
+	  ...
+	  }
+
+Returns true if the group has C<$other> (a group or node) as predecessor, that
+is if there is an edge leading from C<$other> to this group.
+
+=head2 root_node()
+
+	my $root = $group->root_node();
+
+Return the root node as L<Graph::Easy::Node> object, if it was
+set with the 'root' attribute.
+
+=head1 EXPORT
+
+None by default.
+
+=head1 SEE ALSO
+
+L<Graph::Easy>, L<Graph::Easy::Node>, L<Graph::Easy::Manual>.
+
+=head1 AUTHOR
+
+Copyright (C) 2004 - 2008 by Tels L<http://bloodgate.com>
+
+See the LICENSE file for more details.
+
+=cut

perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Group/Anon.pm

@@ -0,0 +1,124 @@
+#############################################################################
+# (c) by Tels 2004. Part of Graph::Easy. An anonymous group.
+#
+#############################################################################
+
+package Graph::Easy::Group::Anon;
+
+use Graph::Easy::Group;
+use warnings;
+
+@ISA = qw/Graph::Easy::Group/;
+$VERSION = '0.76';
+
+use strict;
+
+sub _init
+  {
+  my $self = shift;
+
+  $self->SUPER::_init(@_);
+
+  $self->{name} = 'Group #' . $self->{id};
+  $self->{class} = 'group.anon';
+
+  $self->{att}->{label} = '';
+
+  $self;
+  }
+
+sub _correct_size
+  {
+  my $self = shift;
+
+  $self->{w} = 3;
+  $self->{h} = 3;
+
+  $self;
+  }
+
+sub attributes_as_txt
+  {
+  my $self = shift;
+
+  $self->SUPER::attributes_as_txt( {
+     node => {
+       label => undef,
+       shape => undef,
+       class => undef,
+       } } );
+  }
+
+sub as_pure_txt
+  {
+  '( )';
+  }
+
+sub _as_part_txt
+  {
+  '( )';
+  }
+
+sub as_graphviz_txt
+  {
+  my $self = shift;
+
+  my $name = $self->{name};
+
+  # quote special chars in name
+  $name =~ s/([\[\]\(\)\{\}\#])/\\$1/g;
+
+  '"' .  $name . '"';
+  }
+
+sub text_styles_as_css
+  {
+  '';
+  }
+
+sub is_anon
+  {
+  # is an anon group
+  1;
+  }
+
+1;
+__END__
+
+=head1 NAME
+
+Graph::Easy::Group::Anon - An anonymous group of nodes in Graph::Easy
+
+=head1 SYNOPSIS
+
+	use Graph::Easy::Group::Anon;
+
+	my $anon = Graph::Easy::Group::Anon->new();
+
+=head1 DESCRIPTION
+
+A C<Graph::Easy::Group::Anon> represents an anonymous group of nodes,
+e.g. a group without a name.
+
+The syntax in the Graph::Easy textual description language looks like this:
+
+	( [ Bonn ] -> [ Berlin ] )
+
+This module is loaded and used automatically by Graph::Easy, so there is
+no need to use it manually.
+
+=head1 EXPORT
+
+None by default.
+
+=head1 SEE ALSO
+
+L<Graph::Easy::Group>.
+
+=head1 AUTHOR
+
+Copyright (C) 2004 - 2006 by Tels L<http://bloodgate.com>.
+
+See the LICENSE file for more details.
+
+=cut

perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Group/Cell.pm

@@ -0,0 +1,401 @@
+#############################################################################
+# A cell of a group during layout. Part of Graph::Easy.
+#
+#############################################################################
+
+package Graph::Easy::Group::Cell;
+
+use Graph::Easy::Node;
+
+@ISA = qw/Graph::Easy::Node/;
+$VERSION = '0.76';
+
+use strict;
+use warnings;
+
+BEGIN
+  {
+  *get_attribute = \&attribute;
+  }
+
+#############################################################################
+
+# The different types for a group-cell:
+use constant {
+  GROUP_INNER		=> 0,	# completely sourounded by group cells
+  GROUP_RIGHT		=> 1,	# right border only
+  GROUP_LEFT		=> 2, 	# left border only
+  GROUP_TOP	 	=> 3,	# top border only
+  GROUP_BOTTOM 		=> 4, 	# bottom border only
+  GROUP_ALL	 	=> 5,	# completely sourounded by non-group cells
+
+  GROUP_BOTTOM_RIGHT	=> 6,	# bottom and right border
+  GROUP_BOTTOM_LEFT	=> 7,	# bottom and left border
+  GROUP_TOP_RIGHT	=> 8, 	# top and right border
+  GROUP_TOP_LEFT	=> 9,	# top and left order
+
+  GROUP_MAX		=> 5, 	# max number
+  };
+
+my $border_styles =
+  {
+  # type		    top,	bottom, left,   right,	class
+  GROUP_INNER()		=> [ 0,		0,	0,	0,	['gi'] ],
+  GROUP_RIGHT()		=> [ 0,		0,	0,	1,	['gr'] ],
+  GROUP_LEFT()		=> [ 0,		0,	1,	0,	['gl'] ],
+  GROUP_TOP()		=> [ 1,		0,	0,	0,	['gt'] ],
+  GROUP_BOTTOM()	=> [ 0,		1,	0,	0,	['gb'] ],
+  GROUP_ALL()		=> [ 0,		0,	0,	0,	['ga'] ],
+  GROUP_BOTTOM_RIGHT()	=> [ 0,		1,	0,	1,	['gb','gr'] ],
+  GROUP_BOTTOM_LEFT()	=> [ 0,		1,	1,	0,	['gb','gl'] ],
+  GROUP_TOP_RIGHT()	=> [ 1,		0,	0,	1,	['gt','gr'] ],
+  GROUP_TOP_LEFT()	=> [ 1,		0,	1,	0,	['gt','gl'] ],
+  };
+
+my $border_name = [ 'top', 'bottom', 'left', 'right' ];
+
+sub _css
+  {
+  my ($c, $id, $group, $border) = @_;
+
+  my $css = '';
+
+  for my $type (0 .. 5)
+    {
+    my $b = $border_styles->{$type};
+
+    # If border eq 'none', this would needlessly repeat the "border: none"
+    # from the general group class.
+    next if $border eq 'none';
+
+    my $cl = '.' . $b->[4]->[0]; # $cl .= "-$group" unless $group eq '';
+
+    $css .= "table.graph$id $cl {";
+    if ($type == GROUP_INNER)
+      {
+      $css .= " border: none;";			# shorter CSS
+      }
+    elsif ($type == GROUP_ALL)
+      {
+      $css .= " border-style: $border;";	# shorter CSS
+      }
+    else
+      {
+      for (my $i = 0; $i < 4; $i++)
+        {
+        $css .= ' border-' . $border_name->[$i] . "-style: $border;" if $b->[$i];
+        }
+      }
+    $css .= "}\n";
+    }
+
+  $css;
+  }
+
+#############################################################################
+
+sub _init
+  {
+  # generic init, override in subclasses
+  my ($self,$args) = @_;
+
+  $self->{class} = 'group';
+  $self->{cell_class} = ' gi';
+  $self->{name} = '';
+
+  $self->{'x'} = 0;
+  $self->{'y'} = 0;
+
+  # XXX TODO check arguments
+  foreach my $k (sort keys %$args)
+    {
+    $self->{$k} = $args->{$k};
+    }
+
+  if (defined $self->{group})
+    {
+    # register ourselves at this group
+    $self->{group}->_add_cell ($self);
+    # XXX CHECK also implement sub_class()
+    $self->{class} = $self->{group}->{class};
+    $self->{class} = 'group' unless defined $self->{class};
+    }
+
+  $self;
+  }
+
+sub _set_type
+  {
+  # set the proper type of this cell based on the sourrounding cells
+  my ($self, $cells) = @_;
+
+  # +------+--------+-------+
+  # | LT     TOP      RU    |
+  # +      +        +       +
+  # | LEFT   INNER    Right |
+  # +      +        +       +
+  # | LB     BOTTOM   RB    |
+  # +------+--------+-------+
+
+  my @coord = (
+    [  0, -1, ' gt' ],
+    [ +1,  0, ' gr' ],
+    [  0, +1, ' gb' ],
+    [ -1,  0, ' gl' ],
+    );
+
+  my ($sx,$sy) = ($self->{x},$self->{y});
+
+  my $class = '';
+  my $gr = $self->{group};
+  foreach my $co (@coord)
+    {
+    my ($x,$y,$c) = @$co; $x += $sx; $y += $sy;
+    my $cell = $cells->{"$x,$y"};
+
+    # belongs to the same group?
+    my $go = 0; $go = $cell->group() if UNIVERSAL::can($cell, 'group');
+
+    $class .= $c unless defined $go && $gr == $go;
+    }
+
+  $class = ' ga' if $class eq ' gt gr gb gl';
+
+  $self->{cell_class} = $class;
+
+  $self;
+  }
+
+sub _set_label
+  {
+  my $self = shift;
+
+  $self->{has_label} = 1;
+
+  $self->{name} = $self->{group}->label();
+  }
+
+sub shape
+  {
+  'rect';
+  }
+
+sub attribute
+  {
+  my ($self, $name) = @_;
+
+#  print STDERR "called attribute($name)\n";
+#  return $self->{group}->attribute($name);
+
+  my $group = $self->{group};
+
+  return $group->{att}->{$name} if exists $group->{att}->{$name};
+
+  $group->{cache} = {} unless exists $group->{cache};
+  $group->{cache}->{att} = {} unless exists $group->{cache}->{att};
+
+  my $cache = $group->{cache}->{att};
+  return $cache->{$name} if exists $cache->{$name};
+
+  $cache->{$name} = $group->attribute($name);
+  }
+
+use constant isa_cell => 1;
+
+#############################################################################
+# conversion to ASCII or HTML
+
+sub as_ascii
+  {
+  my ($self, $x,$y) = @_;
+
+  my $fb = $self->_framebuffer($self->{w}, $self->{h});
+
+  my $border_style = $self->attribute('borderstyle');
+  my $EM = 14;
+  # use $self here and not $self->{group} to engage attribute cache:
+  my $border_width = Graph::Easy::_border_width_in_pixels($self,$EM);
+
+  # convert overly broad borders to the correct style
+  $border_style = 'bold' if $border_width > 2;
+  $border_style = 'broad' if $border_width > $EM * 0.2 && $border_width < $EM * 0.75;
+  $border_style = 'wide' if $border_width >= $EM * 0.75;
+
+  if ($border_style ne 'none')
+    {
+
+    #########################################################################
+    # draw our border into the framebuffer
+
+    my $c = $self->{cell_class};
+
+    my $b_top = $border_style;
+    my $b_left = $border_style;
+    my $b_right = $border_style;
+    my $b_bottom = $border_style;
+    if ($c !~ 'ga')
+      {
+      $b_top = 'none' unless $c =~ /gt/;
+      $b_left = 'none' unless $c =~ /gl/;
+      $b_right = 'none' unless $c =~ /gr/;
+      $b_bottom = 'none' unless $c =~ /gb/;
+      }
+
+    $self->_draw_border($fb, $b_right, $b_bottom, $b_left, $b_top, $x, $y);
+    }
+
+  if ($self->{has_label})
+    {
+    # include our label
+
+    my $align = $self->attribute('align');
+    # the default label cell as a top border, but no left/right border
+    my $ys = 0.5;
+    $ys = 0 if $border_style eq 'none';
+    my $h = $self->{h} - 1; $h ++ if $border_style eq 'none';
+
+    $self->_printfb_aligned ($fb, 0, $ys, $self->{w}, $h,
+	$self->_aligned_label($align), 'middle');
+    }
+
+  join ("\n", @$fb);
+  }
+
+sub class
+  {
+  my $self = shift;
+
+  $self->{class} . $self->{cell_class};
+  }
+
+#############################################################################
+
+# for rendering this cell as ASCII/Boxart, we need to correct our width based
+# on whether we have a border or not. But this is only known after parsing is
+# complete.
+
+sub _correct_size
+  {
+  my ($self,$format) = @_;
+
+  if (!defined $self->{w})
+    {
+    my $border = $self->attribute('borderstyle');
+    $self->{w} = 0;
+    $self->{h} = 0;
+    # label needs space
+    $self->{h} = 1 if $self->{has_label};
+    if ($border ne 'none')
+      {
+      # class "gt", "gb", "gr" or "gr" will be compressed away
+      # (e.g. only edge cells will be existent)
+      if ($self->{has_label} || ($self->{cell_class} =~ /g[rltb] /))
+	{
+	$self->{w} = 2;
+	$self->{h} = 2;
+	}
+      elsif ($self->{cell_class} =~ /^ g[rl]\z/)
+	{
+	$self->{w} = 2;
+	}
+      elsif ($self->{cell_class} =~ /^ g[bt]\z/)
+	{
+	$self->{h} = 2;
+	}
+      }
+    }
+  if ($self->{has_label})
+    {
+    my ($w,$h) = $self->dimensions();
+    $self->{h} += $h;
+    $self->{w} += $w;
+    }
+  }
+
+1;
+__END__
+
+=head1 NAME
+
+Graph::Easy::Group::Cell - A cell in a group
+
+=head1 SYNOPSIS
+
+        use Graph::Easy;
+
+	my $ssl = Graph::Easy::Edge->new( );
+
+	$ssl->set_attributes(
+		label => 'encrypted connection',
+		style => '-->',
+		color => 'red',
+	);
+
+	$graph = Graph::Easy->new();
+
+	$graph->add_edge('source', 'destination', $ssl);
+
+	print $graph->as_ascii();
+
+=head1 DESCRIPTION
+
+A C<Graph::Easy::Group::Cell> represents a cell of a group.
+
+Group cells can have a background and, if they are on the outside, a border.
+
+There should be no need to use this package directly.
+
+=head1 METHODS
+
+=head2 error()
+
+	$last_error = $group->error();
+
+	$group->error($error);			# set new messages
+	$group->error('');			# clear error
+
+Returns the last error message, or '' for no error.
+
+=head2 as_ascii()
+
+	my $ascii = $cell->as_ascii();
+
+Returns the cell as a little ascii representation.
+
+=head2 as_html()
+
+	my $html = $cell->as_html($tag,$id);
+
+Returns the cell as HTML code.
+
+=head2 label()
+
+	my $label = $cell->label();
+
+Returns the name (also known as 'label') of the cell.
+
+=head2 class()
+
+	my $class = $cell->class();
+
+Returns the classname(s) of this cell, like:
+
+	group_cities gr gb
+
+for a cell with a bottom (gb) and right (gr) border in the class C<cities>.
+
+=head1 EXPORT
+
+None.
+
+=head1 SEE ALSO
+
+L<Graph::Easy>.
+
+=head1 AUTHOR
+
+Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>.
+
+See the LICENSE file for more details.
+
+=cut

perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Layout/Chain.pm

@@ -0,0 +1,570 @@
+#############################################################################
+# One chain of nodes in a Graph::Easy - used internally for layouts.
+#
+# (c) by Tels 2004-2006. Part of Graph::Easy
+#############################################################################
+
+package Graph::Easy::Layout::Chain;
+
+use Graph::Easy::Base;
+$VERSION = '0.76';
+@ISA = qw/Graph::Easy::Base/;
+
+use strict;
+use warnings;
+
+use Graph::Easy::Util qw(ord_values);
+
+use constant {
+  _ACTION_NODE  => 0, # place node somewhere
+  _ACTION_TRACE => 1, # trace path from src to dest
+  _ACTION_CHAIN => 2, # place node in chain (with parent)
+  _ACTION_EDGES => 3, # trace all edges (shortes connect. first)
+  };
+
+#############################################################################
+
+sub _init
+  {
+  # Generic init routine, to be overriden in subclasses.
+  my ($self,$args) = @_;
+
+  foreach my $k (sort keys %$args)
+    {
+    if ($k !~ /^(start|graph)\z/)
+      {
+      require Carp;
+      Carp::confess ("Invalid argument '$k' passed to __PACKAGE__->new()");
+      }
+    $self->{$k} = $args->{$k};
+    }
+
+  $self->{end} = $self->{start};
+
+  # store chain at node (to lookup node => chain info)
+  $self->{start}->{_chain} = $self;
+  $self->{start}->{_next} = undef;
+
+  $self->{len} = 1;
+
+  $self;
+  }
+
+sub start
+  {
+  # return first node in the chain
+  my $self = shift;
+
+  $self->{start};
+  }
+
+sub end
+  {
+  # return last node in the chain
+  my $self = shift;
+
+  $self->{end};
+  }
+
+sub add_node
+  {
+  # add a node at the end of the chain
+  my ($self, $node) = @_;
+
+  # store at end
+  $self->{end}->{_next} = $node;
+  $self->{end} = $node;
+
+  # store chain at node (to lookup node => chain info)
+  $node->{_chain} = $self;
+  $node->{_next} = undef;
+
+  $self->{len} ++;
+
+  $self;
+  }
+
+sub length
+  {
+  # Return the length of the chain in nodes. Takes optional
+  # node from where to calculate length.
+  my ($self, $node) = @_;
+
+  return $self->{len} unless defined $node;
+
+  my $len = 0;
+  while (defined $node)
+    {
+    $len++; $node = $node->{_next};
+    }
+
+  $len;
+  }
+
+sub nodes
+  {
+  # return all the nodes in the chain as a list, in order.
+  my $self = shift;
+
+  my @nodes = ();
+  my $n = $self->{start};
+  while (defined $n)
+    {
+    push @nodes, $n;
+    $n = $n->{_next};
+    }
+
+  @nodes;
+  }
+
+sub layout
+  {
+  # Return an action stack containing the nec. actions to
+  # lay out the nodes in the chain, plus any connections between
+  # them.
+  my ($self, $edge) = @_;
+
+  # prevent doing it twice
+  return [] if $self->{_done}; $self->{_done} = 1;
+
+  my @TODO = ();
+
+  my $g = $self->{graph};
+
+  # first, layout all the nodes in the chain:
+
+  # start with first node
+  my $pre = $self->{start}; my $n = $pre->{_next};
+  if (exists $pre->{_todo})
+    {
+    # edges with a flow attribute must be handled differently
+    # XXX TODO: the test for attribute('flow') might be wrong (raw_attribute()?)
+    if ($edge && ($edge->{to} == $pre) && ($edge->attribute('flow') || $edge->has_ports()))
+      {
+      push @TODO, $g->_action( _ACTION_CHAIN, $pre, 0, $edge->{from}, $edge);
+      }
+    else
+      {
+      push @TODO, $g->_action( _ACTION_NODE, $pre, 0, $edge );
+      }
+    }
+
+  print STDERR "# Stack after first:\n" if $g->{debug};
+  $g->_dump_stack(@TODO) if $g->{debug};
+
+  while (defined $n)
+    {
+    if (exists $n->{_todo})
+      {
+      # CHAIN means if $n isn't placed yet, it will be done with
+      # $pre as parent:
+
+      # in case there are multiple edges to the target node, use the first
+      # one to determine the flow:
+      my @edges = $g->edge($pre,$n);
+
+      push @TODO, $g->_action( _ACTION_CHAIN, $n, 0, $pre, $edges[0] );
+      }
+    $pre = $n;
+    $n = $n->{_next};
+    }
+
+  print STDERR "# Stack after chaining:\n" if $g->{debug};
+  $g->_dump_stack(@TODO) if $g->{debug};
+
+  # link from each node to the next
+  $pre = $self->{start}; $n = $pre->{_next};
+  while (defined $n)
+    {
+    # first do edges going from P to N
+    #for my $e (sort { $a->{to}->{name} cmp $b->{to}->{name} } values %{$pre->{edges}})
+    for my $e (ord_values ( $pre->{edges}))
+      {
+      # skip selfloops and backward links, these will be done later
+      next if $e->{to} != $n;
+
+      next unless exists $e->{_todo};
+
+      # skip links from/to groups
+      next if $e->{to}->isa('Graph::Easy::Group') ||
+              $e->{from}->isa('Graph::Easy::Group');
+
+#      # skip edges with a flow
+#      next if exists $e->{att}->{start} || exist $e->{att}->{end};
+
+      push @TODO, [ _ACTION_TRACE, $e ];
+      delete $e->{_todo};
+      }
+
+    } continue { $pre = $n; $n = $n->{_next}; }
+
+  print STDERR "# Stack after chain-linking:\n" if $g->{debug};
+  $g->_dump_stack(@TODO) if $g->{debug};
+
+  # Do all other links inside the chain (backwards, going forward more than
+  # one node etc)
+
+  $n = $self->{start};
+  while (defined $n)
+    {
+    my @edges;
+
+    my @count;
+
+    print STDERR "# inter-chain link from $n->{name}\n" if $g->{debug};
+
+    # gather all edges starting at $n, but do the ones with a flow first
+#    for my $e (sort { $a->{to}->{name} cmp $b->{to}->{name} } values %{$n->{edges}})
+    for my $e (ord_values ( $n->{edges}))
+      {
+      # skip selfloops, these will be done later
+      next if $e->{to} == $n;
+
+      next if !ref($e->{to}->{_chain});
+      next if !ref($e->{from}->{_chain});
+
+      next if $e->has_ports();
+
+      # skip links from/to groups
+      next if $e->{to}->isa('Graph::Easy::Group') ||
+              $e->{from}->isa('Graph::Easy::Group');
+
+      print STDERR "# inter-chain link from $n->{name} to $e->{to}->{name}\n" if $g->{debug};
+
+      # leaving the chain?
+      next if $e->{to}->{_chain} != $self;
+
+#      print STDERR "#    trying for $n->{name}:\t $e->{from}->{name} to $e->{to}->{name}\n";
+      next unless exists $e->{_todo};
+
+      # calculate for this edge, how far it goes
+      my $count = 0;
+      my $curr = $n;
+      while (defined $curr && $curr != $e->{to})
+        {
+        $curr = $curr->{_next}; $count ++;
+        }
+      if (!defined $curr)
+        {
+        # edge goes backward
+
+        # start at $to
+        $curr = $e->{to};
+        $count = 0;
+        while (defined $curr && $curr != $e->{from})
+          {
+          $curr = $curr->{_next}; $count ++;
+          }
+        $count = 100000 if !defined $curr;	# should not happen
+        }
+      push @edges, [ $count, $e ];
+      push @count, [ $count, $e->{from}->{name}, $e->{to}->{name} ];
+      }
+
+#    use Data::Dumper; print STDERR "count\n", Dumper(@count);
+
+    # do edges, shortest first
+    for my $e (sort { $a->[0] <=> $b->[0] } @edges)
+      {
+      push @TODO, [ _ACTION_TRACE, $e->[1] ];
+      delete $e->[1]->{_todo};
+      }
+
+    $n = $n->{_next};
+    }
+
+  # also do all selfloops on $n
+  $n = $self->{start};
+  while (defined $n)
+    {
+#    for my $e (sort { $a->{to}->{name} cmp $b->{to}->{name} } values %{$n->{edges}})
+    for my $e (ord_values $n->{edges})
+      {
+      next unless exists $e->{_todo};
+
+#      print STDERR "# $e->{from}->{name} to $e->{to}->{name} on $n->{name}\n";
+#      print STDERR "# ne $e->{to} $n $e->{id}\n"
+#       if $e->{from} != $n || $e->{to} != $n;		# no selfloop?
+
+      next if $e->{from} != $n || $e->{to} != $n;	# no selfloop?
+
+      push @TODO, [ _ACTION_TRACE, $e ];
+      delete $e->{_todo};
+      }
+    $n = $n->{_next};
+    }
+
+  print STDERR "# Stack after self-loops:\n" if $g->{debug};
+  $g->_dump_stack(@TODO) if $g->{debug};
+
+  # XXX TODO
+  # now we should do any links that start or end at this chain, recursively
+
+  $n = $self->{start};
+  while (defined $n)
+    {
+
+    # all chains that start at this node
+    for my $e (sort { $a->{to}->{name} cmp $b->{to}->{name} } values %{$n->{edges}})
+      {
+      my $to = $e->{to};
+
+      # skip links to groups
+      next if $to->isa('Graph::Easy::Group');
+
+#      print STDERR "# chain-tracking to: $to->{name} $to->{_chain}\n";
+
+      next unless exists $to->{_chain} && ref($to->{_chain}) =~ /Chain/;
+      my $chain = $to->{_chain};
+      next if $chain->{_done};
+
+#      print STDERR "# chain-tracking to: $to->{name}\n";
+
+      # pass the edge along, in case it has a flow
+#      my @pass = ();
+#      push @pass, $e if $chain->{_first} && $e->{to} == $chain->{_first};
+      push @TODO, @{ $chain->layout($e) } unless $chain->{_done};
+
+      # link the edges to $to
+      next unless exists $e->{_todo};	# was already done above?
+
+      # next if $e->has_ports();
+
+      push @TODO, [ _ACTION_TRACE, $e ];
+      delete $e->{_todo};
+      }
+    $n = $n->{_next};
+    }
+
+  \@TODO;
+  }
+
+sub dump
+  {
+  # dump the chain to STDERR
+  my ($self, $indent) = @_;
+
+  $indent = '' unless defined $indent;
+
+  print STDERR "#$indent chain id $self->{id} (len $self->{len}):\n";
+  print STDERR "#$indent is empty\n" and return if $self->{len} == 0;
+
+  my $n = $self->{start};
+  while (defined $n)
+    {
+    print STDERR "#$indent  $n->{name} (chain id: $n->{_chain}->{id})\n";
+    $n = $n->{_next};
+    }
+  $self;
+  }
+
+sub merge
+  {
+  # take another chain, and merge it into ourselves. If $where is defined,
+  # absorb only the nodes from $where onwards (instead of all of them).
+  my ($self, $other, $where) = @_;
+
+  my $g = $self->{graph};
+
+  print STDERR "# panik: ", join(" \n",caller()),"\n" if !defined $other;
+
+  print STDERR
+   "# Merging chain $other->{id} (len $other->{len}) into $self->{id} (len $self->{len})\n"
+     if $g->{debug};
+
+  print STDERR
+   "# Merging from $where->{name} onwards\n"
+     if $g->{debug} && ref($where);
+
+  # cannot merge myself into myself (without allocating infinitely memory)
+  return if $self == $other;
+
+  # start at start as default
+  $where = undef unless ref($where) && exists $where->{_chain} && $where->{_chain} == $other;
+
+  $where = $other->{start} unless defined $where;
+
+  # make all nodes from chain #1 belong to it (to detect loops)
+  my $n = $self->{start};
+  while (defined $n)
+    {
+    $n->{_chain} = $self;
+    $n = $n->{_next};
+    }
+
+  print STDERR "# changed nodes\n" if $g->{debug};
+  $self->dump() if $g->{debug};
+
+  # terminate at $where
+  $self->{end}->{_next} = $where;
+  $self->{end} = $other->{end};
+
+  # start at joiner
+  $n = $where;
+  while (ref($n))
+    {
+    $n->{_chain} = $self;
+    my $pre = $n;
+    $n = $n->{_next};
+
+#    sleep(1);
+#    print "# at $n->{name} $n->{_chain}\n" if ref($n);
+    if (ref($n) && defined $n->{_chain} && $n->{_chain} == $self)	# already points into ourself?
+      {
+#      sleep(1);
+#      print "# pre $pre->{name} $pre->{_chain}\n";
+      $pre->{_next} = undef;	# terminate
+      $self->{end} = $pre;
+      last;
+      }
+    }
+
+  # could speed this up
+  $self->{len} = 0; $n = $self->{start};
+  while (defined $n)
+    {
+    $self->{len}++; $n = $n->{_next};
+    }
+
+#  print "done merging, dumping result:\n";
+#  $self->dump(); sleep(10);
+
+  if (defined $other->{start} && $where == $other->{start})
+    {
+    # we absorbed the other chain completely, so drop it
+    $other->{end} = undef;
+    $other->{start} = undef;
+    $other->{len} = 0;
+    # caller is responsible for cleaning it up
+    }
+
+  print STDERR "# after merging\n" if $g->{debug};
+  $self->dump() if $g->{debug};
+
+  $self;
+  }
+
+1;
+__END__
+
+=head1 NAME
+
+Graph::Easy::Layout::Chain - Chain of nodes for layouter
+
+=head1 SYNOPSIS
+
+	# used internally, do not use directly
+
+        use Graph::Easy;
+        use Graph::Easy::Layout::Chain;
+
+	my $graph = Graph::Easy->new( );
+	my ($node, $node2) = $graph->add_edge( 'A', 'B' );
+
+	my $chain = Graph::Easy::Layout::Chain->new(
+		start => $node,
+		graph => $graph, );
+
+	$chain->add_node( $node2 );
+
+=head1 DESCRIPTION
+
+A C<Graph::Easy::Layout::Chain> object represents a chain of nodes
+for the layouter.
+
+=head1 METHODS
+
+=head2 new()
+
+        my $chain = Graph::Easy::Layout::Chain->new( start => $node );
+
+Create a new chain and set its starting node to C<$node>.
+
+=head2 length()
+
+	my $len = $chain->length();
+
+Return the length of the chain, in nodes.
+
+	my $len = $chain->length( $node );
+
+Given an optional C<$node> as argument, returns the length
+from that node onwards. For the chain with the three nodes
+A, B and C would return 3, 2, and 1 for A, B and C, respectively.
+
+Returns 0 if the passed node is not part of this chain.
+
+=head2 nodes()
+
+	my @nodes = $chain->nodes();
+
+Return all the node objects in the chain as list, in order.
+
+=head2 add_node()
+
+	$chain->add_node( $node );
+
+Add C<$node> to the end of the chain.
+
+=head2 start()
+
+	my $node = $chain->start();
+
+Return first node in the chain.
+
+=head2 end()
+
+	my $node = $chain->end();
+
+Return last node in the chain.
+
+=head2 layout()
+
+	my $todo = $chain->layout();
+
+Return an action stack as array ref, containing the nec. actions to
+layout the chain (nodes, plus interlinks in the chain).
+
+Will recursively traverse all chains linked to this chain.
+
+=head2 merge()
+
+	my $chain->merge ( $other_chain );
+	my $chain->merge ( $other_chain, $where );
+
+Merge the other chain into ourselves, adding its nodes at our end.
+The other chain is emptied and must be deleted by the caller.
+
+If C<$where> is defined and a member of C<$other_chain>, absorb only the
+nodes from C<$where> onwards, instead of all of them.
+
+=head2 error()
+
+	$last_error = $node->error();
+
+	$node->error($error);			# set new messages
+	$node->error('');			# clear error
+
+Returns the last error message, or '' for no error.
+
+=head2 dump()
+
+	$chain->dump();
+
+Dump the chain to STDERR, to aid debugging.
+
+=head1 EXPORT
+
+None by default.
+
+=head1 SEE ALSO
+
+L<Graph::Easy>, L<Graph::Easy::Layout>.
+
+=head1 AUTHOR
+
+Copyright (C) 2004 - 2006 by Tels L<http://bloodgate.com>.
+
+See the LICENSE file for more details.
+
+=cut

perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Layout/Force.pm

@@ -0,0 +1,251 @@
+#############################################################################
+# Force-based layouter for Graph::Easy.
+#
+# (c) by Tels 2004-2007.
+#############################################################################
+
+package Graph::Easy::Layout::Force;
+
+$VERSION = '0.76';
+
+#############################################################################
+#############################################################################
+
+package Graph::Easy;
+
+use strict;
+use warnings;
+
+use Graph::Easy::Util qw(ord_values);
+
+sub _layout_force
+  {
+  # Calculate for each node the force on it, then move them accordingly.
+  # When things have settled, stop.
+  my ($self) = @_;
+
+  # For each node, calculate the force acting on it, separated into two
+  # components along the X and Y axis:
+
+  # XXX TODO: replace with all contained nodes + groups
+  my @nodes = $self->nodes();
+
+  return if @nodes == 0;
+
+  my $root = $self->root_node();
+
+  if (!defined $root)
+    {
+    # find a suitable root node
+    $root = $nodes[0];
+    }
+
+  # this node never moves
+  $root->{_pinned} = undef;
+  $root->{x} = 0;
+  $root->{y} = 0;
+
+  # get the "gravity" force
+  my $gx = 0; my $gy = 0;
+
+  my $flow = $self->flow();
+  if ($flow == 0)
+    {
+    $gx = 1;
+    }
+  elsif ($flow == 90)
+    {
+    $gy = -1;
+    }
+  elsif ($flow == 270)
+    {
+    $gy = 1;
+    }
+  else # ($flow == 180)
+    {
+    $gx = -1;
+    }
+
+  my @particles;
+  # set initial positions
+  for my $n (@nodes)
+    {
+    # the net force on this node is the gravity
+    $n->{_x_force} = $gx;
+    $n->{_y_force} = $gy;
+    if ($root == $n || defined $n->{origin})
+      {
+      # nodes that are relative to another are "pinned"
+      $n->{_pinned} = undef;
+      }
+    else
+      {
+      $n->{x} = rand(100);
+      $n->{y} = rand(100);
+      push @particles, $n;
+      }
+    }
+
+  my $energy = 1;
+  while ($energy > 0.1)
+    {
+    $energy = 0;
+    for my $n (@particles)
+      {
+      # reset forces on this node
+      $n->{_x_force} = 0;
+      $n->{_y_force} = 0;
+
+      # Add forces of all other nodes. We need to include pinned nodes here,
+      # too, since a moving node might get near a pinned one and get repelled.
+      for my $n2 (@nodes)
+        {
+        next if $n2 == $n;			# don't repel yourself
+
+	my $dx = ($n->{x} - $n2->{x});
+	my $dy = ($n->{y} - $n2->{y});
+
+	my $r = $dx * $dx + $dy * $dy;
+
+	$r = 0.01 if $r < 0.01;			# too small?
+	if ($r < 4)
+	  {
+	  # not too big
+	  $n->{_x_force} += 1 / $dx * $dx;
+	  $n->{_y_force} += 1 / $dy * $dy;
+
+	  my $dx2 = 1 / $dx * $dx;
+	  my $dy2 = 1 / $dy * $dy;
+
+	  print STDERR "# Force between $n->{name} and $n2->{name}: fx $dx2, fy $dy2\n";
+	  }
+        }
+
+      # for all edges connected at this node
+      for my $e (ord_values ( $n->{edges} ))
+	{
+	# exclude self-loops
+	next if $e->{from} == $n && $e->{to} == $n;
+
+	# get the other end-point of this edge
+	my $n2 = $e->{from}; $n2 = $e->{to} if $n2 == $n;
+
+	# XXX TODO
+	# we should "connect" the edges to the appropriate port so that
+	# they excert an off-center force
+
+	my $dx = -($n->{x} - $n2->{x}) / 2;
+	my $dy = -($n->{y} - $n2->{y}) / 2;
+
+	print STDERR "# Spring force between $n->{name} and $n2->{name}: fx $dx, fy $dy\n";
+	$n->{_x_force} += $dx;
+	$n->{_y_force} += $dy;
+	}
+
+      print STDERR "# $n->{name}: Summed force: fx $n->{_x_force}, fy $n->{_y_force}\n";
+
+      # for grid-like layouts, add a small force drawing this node to the gridpoint
+      # 0.7 => 1 - 0.7 => 0.3
+      # 1.2 => 1 - 1.2 => -0.2
+
+      my $dx = int($n->{x} + 0.5) - $n->{x};
+      $n->{_x_force} += $dx;
+      my $dy = int($n->{y} + 0.5) - $n->{y};
+      $n->{_y_force} += $dy;
+
+      print STDERR "# $n->{name}: Final force: fx $n->{_x_force}, fy $n->{_y_force}\n";
+
+      $energy += $n->{_x_force} * $n->{_x_force} + $n->{_x_force} * $n->{_y_force};
+
+      print STDERR "# Net energy: $energy\n";
+      }
+
+    # after having calculated all forces, move the nodes
+    for my $n (@particles)
+      {
+      my $dx = $n->{_x_force};
+      $dx = 5 if $dx > 5;		# limit it
+      $n->{x} += $dx;
+
+      my $dy = $n->{_y_force};
+      $dy = 5 if $dy > 5;		# limit it
+      $n->{y} += $dy;
+
+      print STDERR "# $n->{name}: Position $n->{x}, $n->{y}\n";
+      }
+
+    sleep(1); print STDERR "\n";
+    }
+
+  for my $n (@nodes)
+    {
+    delete $n->{_x_force};
+    delete $n->{_y_force};
+    }
+  $self;
+  }
+
+1;
+__END__
+
+=head1 NAME
+
+Graph::Easy::Layout::Force - Force-based layouter for Graph::Easy
+
+=head1 SYNOPSIS
+
+	use Graph::Easy;
+
+	my $graph = Graph::Easy->new();
+
+	$graph->add_edge ('Bonn', 'Berlin');
+	$graph->add_edge ('Bonn', 'Ulm');
+	$graph->add_edge ('Ulm', 'Berlin');
+
+	$graph->layout( type => 'force' );
+
+	print $graph->as_ascii( );
+
+	# prints:
+
+	#   +------------------------+
+	#   |                        v
+	# +------+     +-----+     +--------+
+	# | Bonn | --> | Ulm | --> | Berlin |
+	# +------+     +-----+     +--------+
+
+=head1 DESCRIPTION
+
+C<Graph::Easy::Layout::Force> contains routines that calculate a
+force-based layout for a graph.
+
+Nodes repell each other, while edges connecting them draw them together.
+
+The layouter calculates the forces on each node, then moves them around
+according to these forces until things have settled down.
+
+Used automatically by Graph::Easy.
+
+=head1 EXPORT
+
+Exports nothing.
+
+=head1 SEE ALSO
+
+L<Graph::Easy>.
+
+=head1 METHODS
+
+This module injects the following methods into Graph::Easy:
+
+=head2 _layout_force()
+
+Calculates the node position with a force-based method.
+
+=head1 AUTHOR
+
+Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>.
+
+See the LICENSE file for information.
+
+=cut

perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Layout/Grid.pm

@@ -0,0 +1,348 @@
+#############################################################################
+# Grid-management and layout preparation.
+#
+# (c) by Tels 2004-2006.
+#############################################################################
+
+package Graph::Easy::Layout::Grid;
+
+$VERSION = '0.76';
+
+#############################################################################
+#############################################################################
+
+package Graph::Easy;
+
+use strict;
+use warnings;
+
+use Graph::Easy::Util qw(ord_values);
+
+sub _balance_sizes
+  {
+  # Given a list of column/row sizes and a minimum size that their sum must
+  # be, will grow individual sizes until the constraint (sum) is met.
+  my ($self, $sizes, $need) = @_;
+
+  # XXX TODO: we can abort the loop and distribute the remaining nec. size
+  # once all elements in $sizes are equal.
+
+  return if $need < 1;
+
+  # if there is only one element, return it immediately
+  if (@$sizes == 1)
+    {
+    $sizes->[0] = $need if $sizes->[0] < $need;
+    return;
+    }
+
+  # endless loop until constraint is met
+  while (1)
+    {
+
+    # find the smallest size, and also compute their sum
+    my $sum = 0; my $i = 0;
+    my $sm = $need + 1;		# start with an arbitrary size
+    my $sm_i = 0;		# if none is != 0, then use the first
+    for my $s (@$sizes)
+      {
+      $sum += $s;
+      next if $s == 0;
+      if ($s < $sm)
+	{
+        $sm = $s; $sm_i = $i;
+	}
+      $i++;
+      }
+
+    # their sum is already equal or bigger than what we need?
+    last if $sum >= $need;
+
+    # increase the smallest size by one, then try again
+    $sizes->[$sm_i]++;
+    }
+
+#  use Data::Dumper; print STDERR "# " . Dumper($sizes),"\n";
+
+  undef;
+  }
+
+sub _prepare_layout
+  {
+  # this method is used by as_ascii() and as_svg() to find out the
+  # sizes and placement of the different cells (edges, nodes etc).
+  my ($self,$format) = @_;
+
+  # Find out for each row and column how big they are:
+  #   +--------+-----+------+
+  #   | Berlin | --> | Bonn |
+  #   +--------+-----+------+
+  # results in:
+  #        w,  h,  x,  y
+  # 0,0 => 10, 3,  0,  0
+  # 1,0 => 7,  3,  10, 0
+  # 2,0 => 8,  3,  16, 0
+
+  # Technically, we also need to "compress" away non-existent columns/rows.
+  # We achieve that by simply rendering them with size 0, so they become
+  # practically invisible.
+
+  my $cells = $self->{cells};
+  my $rows = {};
+  my $cols = {};
+
+  # the last column/row (highest X,Y pair)
+  my $mx = -1000000; my $my = -1000000;
+
+  # We need to do this twice, once for single-cell objects, and again for
+  # objects covering multiple cells. The single-cell objects can be solved
+  # first:
+
+  # find all x and y occurrences to sort them by row/columns
+  for my $cell (ord_values $cells)
+    {
+    my ($x,$y) = ($cell->{x}, $cell->{y});
+
+    {
+      no strict 'refs';
+
+      my $method = '_correct_size_' . $format;
+      $method = '_correct_size' unless $cell->can($method);
+      $cell->$method();
+    }
+
+    my $w = $cell->{w} || 0;
+    my $h = $cell->{h} || 0;
+
+    # Set the minimum cell size only for single-celled objects:
+    if ( (($cell->{cx}||1) + ($cell->{cy}||1)) == 2)
+      {
+      # record maximum size for that col/row
+      $rows->{$y} = $h if $h >= ($rows->{$y} || 0);
+      $cols->{$x} = $w if $w >= ($cols->{$x} || 0);
+      }
+
+    # Find highest X,Y pair. Always use x,y, and not x+cx,y+cy, because
+    # a multi-celled object "sticking" out will not count unless there
+    # is another object in the same row/column.
+    $mx = $x if $x > $mx;
+    $my = $y if $y > $my;
+    }
+
+  # insert a dummy row/column with size=0 as last
+  $rows->{$my+1} = 0;
+  $cols->{$mx+1} = 0;
+
+  # do the last step again, but for multi-celled objects
+  for my $cell (ord_values $cells)
+    {
+    my ($x,$y) = ($cell->{x}, $cell->{y});
+
+    my $w = $cell->{w} || 0;
+    my $h = $cell->{h} || 0;
+
+    # Set the minimum cell size only for multi-celled objects:
+    if ( (($cell->{cx} || 1) + ($cell->{cy}||1)) > 2)
+      {
+      $cell->{cx} ||= 1;
+      $cell->{cy} ||= 1;
+
+      # do this twice, for X and Y:
+
+#      print STDERR "\n# ", $cell->{name} || $cell->{id}, " cx=$cell->{cx} cy=$cell->{cy} $cell->{w},$cell->{h}:\n";
+
+      # create an array with the current sizes for the affacted rows/columns
+      my @sizes;
+
+#      print STDERR "# $cell->{cx} $cell->{cy} at cx:\n";
+
+      # XXX TODO: no need to do this for empty/zero cols
+      for (my $i = 0; $i < $cell->{cx}; $i++)
+        {
+        push @sizes, $cols->{$i+$x} || 0;
+	}
+      $self->_balance_sizes(\@sizes, $cell->{w});
+      # store the result back
+      for (my $i = 0; $i < $cell->{cx}; $i++)
+        {
+#        print STDERR "# store back $sizes[$i] to col ", $i+$x,"\n";
+        $cols->{$i+$x} = $sizes[$i];
+	}
+
+      @sizes = ();
+
+#      print STDERR "# $cell->{cx} $cell->{cy} at cy:\n";
+
+      # XXX TODO: no need to do this for empty/zero cols
+      for (my $i = 0; $i < $cell->{cy}; $i++)
+        {
+        push @sizes, $rows->{$i+$y} || 0;
+	}
+      $self->_balance_sizes(\@sizes, $cell->{h});
+      # store the result back
+      for (my $i = 0; $i < $cell->{cy}; $i++)
+        {
+#        print STDERR "# store back $sizes[$i] to row ", $i+$y,"\n";
+        $rows->{$i+$y} = $sizes[$i];
+	}
+      }
+    }
+
+  print STDERR "# Calculating absolute positions for rows/columns\n" if $self->{debug};
+
+  # Now run through all rows/columns and get their absolute pos by taking all
+  # previous ones into account.
+  my $pos = 0;
+  for my $y (sort { $a <=> $b } keys %$rows)
+    {
+    my $s = $rows->{$y};
+    $rows->{$y} = $pos;			# first is 0, second is $rows[1] etc
+    $pos += $s;
+    }
+  $pos = 0;
+  for my $x (sort { $a <=> $b } keys %$cols)
+    {
+    my $s = $cols->{$x};
+    $cols->{$x} = $pos;
+    $pos += $s;
+    }
+
+  # find out max. dimensions for framebuffer
+  print STDERR "# Finding max. dimensions for framebuffer\n" if $self->{debug};
+  my $max_y = 0; my $max_x = 0;
+
+  for my $v (ord_values $cells)
+    {
+    # Skip multi-celled nodes for later.
+    next if ($v->{cx}||1) + ($v->{cy}||1) != 2;
+
+    # X and Y are col/row, so translate them to real pos
+    my $x = $cols->{ $v->{x} };
+    my $y = $rows->{ $v->{y} };
+
+    # Also set correct the width/height of each cell to be the maximum
+    # width/height of that row/column and store the previous size in 'minw'
+    # and 'minh', respectively.
+
+    $v->{minw} = $v->{w};
+    $v->{minh} = $v->{h};
+
+    # find next col/row
+    my $nx = $v->{x} + 1;
+    my $next_col = $cols->{ $nx };
+    my $ny = $v->{y} + 1;
+    my $next_row = $rows->{ $ny };
+
+    $next_col = $cols->{ ++$nx } while (!defined $next_col);
+    $next_row = $rows->{ ++$ny } while (!defined $next_row);
+
+    $v->{w} = $next_col - $x;
+    $v->{h} = $next_row - $y;
+
+    my $m = $y + $v->{h} - 1;
+    $max_y = $m if $m > $max_y;
+    $m = $x + $v->{w} - 1;
+    $max_x = $m if $m > $max_x;
+    }
+
+  # repeat the previous step, now for multi-celled objects
+  foreach my $v (ord_values ( $self->{cells} ))
+    {
+    next unless defined $v->{x} && (($v->{cx}||1) + ($v->{cy}||1) > 2);
+
+    # X and Y are col/row, so translate them to real pos
+    my $x = $cols->{ $v->{x} };
+    my $y = $rows->{ $v->{y} };
+
+    $v->{minw} = $v->{w};
+    $v->{minh} = $v->{h};
+
+    # find next col/row
+    my $nx = $v->{x} + ($v->{cx} || 1);
+    my $next_col = $cols->{ $nx };
+    my $ny = $v->{y} + ($v->{cy} || 1);
+    my $next_row = $rows->{ $ny };
+
+    $next_col = $cols->{ ++$nx } while (!defined $next_col);
+    $next_row = $rows->{ ++$ny } while (!defined $next_row);
+
+    $v->{w} = $next_col - $x;
+    $v->{h} = $next_row - $y;
+
+    my $m = $y + $v->{h} - 1;
+    $max_y = $m if $m > $max_y;
+    $m = $x + $v->{w} - 1;
+    $max_x = $m if $m > $max_x;
+    }
+
+  # return what we found out:
+  ($rows,$cols,$max_x,$max_y);
+  }
+
+1;
+__END__
+
+=head1 NAME
+
+Graph::Easy::Layout::Grid - Grid management and size calculation
+
+=head1 SYNOPSIS
+
+	use Graph::Easy;
+
+	my $graph = Graph::Easy->new();
+
+	my $bonn = Graph::Easy::Node->new(
+		name => 'Bonn',
+	);
+	my $berlin = Graph::Easy::Node->new(
+		name => 'Berlin',
+	);
+
+	$graph->add_edge ($bonn, $berlin);
+
+	$graph->layout();
+
+	print $graph->as_ascii( );
+
+	# prints:
+
+	# +------+     +--------+
+	# | Bonn | --> | Berlin |
+	# +------+     +--------+
+
+=head1 DESCRIPTION
+
+C<Graph::Easy::Layout::Grid> contains routines that calculate cell sizes
+on the grid, which is necessary for ASCII, boxart and SVG output.
+
+Used automatically by Graph::Easy.
+
+=head1 EXPORT
+
+Exports nothing.
+
+=head1 SEE ALSO
+
+L<Graph::Easy>.
+
+=head1 METHODS
+
+This module injects the following methods into Graph::Easy:
+
+=head2 _prepare_layout()
+
+  	my ($rows,$cols,$max_x,$max_y, \@V) = $graph->_prepare_layout();
+
+Returns two hashes (C<$rows> and C<$cols>), containing the columns and rows
+of the layout with their nec. sizes (in chars) plus the maximum
+framebuffer size nec. for this layout. Also returns reference of
+a list of all cells to be rendered.
+
+=head1 AUTHOR
+
+Copyright (C) 2004 - 2006 by Tels L<http://bloodgate.com>.
+
+See the LICENSE file for information.
+
+=cut

perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Layout/Path.pm

@@ -0,0 +1,916 @@
+#############################################################################
+# Path and cell management for Graph::Easy.
+#
+#############################################################################
+
+package Graph::Easy::Layout::Path;
+
+$VERSION = '0.76';
+
+#############################################################################
+#############################################################################
+
+package Graph::Easy::Node;
+
+use strict;
+use warnings;
+
+use Graph::Easy::Edge::Cell qw/
+ EDGE_END_E EDGE_END_N EDGE_END_S EDGE_END_W
+/;
+
+sub _shuffle_dir
+  {
+  # take a list with four entries and shuffle them around according to $dir
+  my ($self, $e, $dir) = @_;
+
+  # $dir: 0 => north, 90 => east, 180 => south, 270 => west
+
+  $dir = 90 unless defined $dir;		# default is east
+
+  return [ @$e ] if $dir == 90;			# default is no shuffling
+
+  my @shuffle = (0,1,2,3);			# the default
+  @shuffle = (1,2,0,3) if $dir == 180;		# south
+  @shuffle = (2,3,1,0) if $dir == 270;		# west
+  @shuffle = (3,0,2,1) if $dir == 0;		# north
+
+  [
+    $e->[ $shuffle[0] ],
+    $e->[ $shuffle[1] ],
+    $e->[ $shuffle[2] ],
+    $e->[ $shuffle[3] ],
+  ];
+  }
+
+sub _shift
+  {
+  # get a flow shifted by X° to $dir
+  my ($self, $turn) = @_;
+
+  my $dir = $self->flow();
+
+  $dir += $turn;
+  $dir += 360 if $dir < 0;
+  $dir -= 360 if $dir > 360;
+  $dir;
+  }
+
+sub _near_places
+  {
+  # Take a node and return a list of possible placements around it and
+  # prune out already occupied cells. $d is the distance from the node
+  # border and defaults to two (for placements). Set it to one for
+  # adjacent cells.
+
+  # If defined, $type contains four flags for each direction. If undef,
+  # two entries (x,y) will be returned for each pos, instead of (x,y,type).
+
+  # If $loose is true, no checking whether the returned fields are free
+  # is done.
+
+  my ($n, $cells, $d, $type, $loose, $dir) = @_;
+
+  my $cx = $n->{cx} || 1;
+  my $cy = $n->{cy} || 1;
+
+  $d = 2 unless defined $d;		# default is distance = 2
+
+  my $flags = $type;
+
+  if (ref($flags) ne 'ARRAY')
+    {
+    $flags = [
+      EDGE_END_W,
+      EDGE_END_N,
+      EDGE_END_E,
+      EDGE_END_S,
+     ];
+    }
+  $dir = $n->flow() unless defined $dir;
+
+  my $index = $n->_shuffle_dir( [ 0,3,6,9], $dir);
+
+  my @places = ();
+
+  # single-celled node
+  if ($cx + $cy == 2)
+    {
+    my @tries  = (
+  	$n->{x} + $d, $n->{y}, $flags->[0],	# right
+	$n->{x}, $n->{y} + $d, $flags->[1],	# down
+	$n->{x} - $d, $n->{y}, $flags->[2],	# left
+	$n->{x}, $n->{y} - $d, $flags->[3],	# up
+      );
+
+    for my $i (0..3)
+      {
+      my $idx = $index->[$i];
+      my ($x,$y,$t) = ($tries[$idx], $tries[$idx+1], $tries[$idx+2]);
+
+#      print STDERR "# Considering place $x, $y \n";
+
+      # This quick check does not take node clusters or multi-celled nodes
+      # into account. These are handled in $node->_do_place() later.
+      next if !$loose && exists $cells->{"$x,$y"};
+      push @places, $x, $y;
+      push @places, $t if defined $type;
+      }
+    return @places;
+    }
+
+  # Handle a multi-celled node. For a 3x2 node:
+  #      A   B   C
+  #   J [00][10][20] D
+  #   I [10][11][21] E
+  #      H   G   F
+  # we have 10 (3 * 2 + 2 * 2) places to consider
+
+  my $nx = $n->{x};
+  my $ny = $n->{y};
+  my ($px,$py);
+
+  my $idx = 0;
+  my @results = ( [], [], [], [] );
+
+  $cy--; $cx--;
+  my $t = $flags->[$idx++];
+  # right
+  $px = $nx + $cx + $d;
+  for my $y (0 .. $cy)
+    {
+    $py = $y + $ny;
+    next if exists $cells->{"$px,$py"} && !$loose;
+    push @{$results[0]}, $px, $py;
+    push @{$results[0]}, $t if defined $type;
+    }
+
+  # below
+  $py = $ny + $cy + $d;
+  $t = $flags->[$idx++];
+  for my $x (0 .. $cx)
+    {
+    $px = $x + $nx;
+    next if exists $cells->{"$px,$py"} && !$loose;
+    push @{$results[1]}, $px, $py;
+    push @{$results[1]}, $t if defined $type;
+    }
+
+  # left
+  $px = $nx - $d;
+  $t = $flags->[$idx++];
+  for my $y (0 .. $cy)
+    {
+    $py = $y + $ny;
+    next if exists $cells->{"$px,$py"} && !$loose;
+    push @{$results[2]}, $px, $py;
+    push @{$results[2]}, $t if defined $type;
+    }
+
+  # top
+  $py = $ny - $d;
+  $t = $flags->[$idx];
+  for my $x (0 .. $cx)
+    {
+    $px = $x + $nx;
+    next if exists $cells->{"$px,$py"} && !$loose;
+    push @{$results[3]}, $px, $py;
+    push @{$results[3]}, $t if defined $type;
+    }
+
+  # accumulate the results in the requested, shuffled order
+  for my $i (0..3)
+    {
+    my $idx = $index->[$i] / 3;
+    push @places, @{$results[$idx]};
+    }
+
+  @places;
+  }
+
+sub _allowed_places
+  {
+  # given a list of potential positions, and a list of allowed positions,
+  # return the valid ones (e.g. that are in both lists)
+  my ($self, $places, $allowed, $step) = @_;
+
+  print STDERR
+   "# calculating allowed places for $self->{name} from " . @$places .
+   " positions and " . scalar @$allowed . " allowed ones:\n"
+    if $self->{graph}->{debug};
+
+  $step ||= 2;				# default: "x,y"
+
+  my @good;
+  my $i = 0;
+  while ($i < @$places)
+    {
+    my ($x,$y) = ($places->[$i], $places->[$i+1]);
+    my $allow = 0;
+    my $j = 0;
+    while ($j < @$allowed)
+      {
+      my ($m,$n) = ($allowed->[$j], $allowed->[$j+1]);
+      $allow++ and last if ($m == $x && $n == $y);
+      } continue { $j += 2; }
+    next unless $allow;
+    push @good, $places->[$i + $_ -1] for (1..$step);
+    } continue { $i += $step; }
+
+  print STDERR "#  left with " . ((scalar @good) / $step) . " position(s)\n" if $self->{graph}->{debug};
+  @good;
+  }
+
+sub _allow
+  {
+  # return a list of places, depending on the start/end attribute:
+  # "south" - any place south
+  # "south,0" - first place south
+  # "south,-1" - last place south
+  # XXX TODO:
+  # "south,0..2" - first three places south
+  # "south,0,1,-1" - first, second and last place south
+
+  my ($self, $dir, @pos) = @_;
+
+  # for relative direction, get the absolute flow from the node
+  if ($dir =~ /^(front|forward|back|left|right)\z/)
+    {
+    # get the flow at the node
+    $dir = $self->flow();
+    }
+
+  my $place = {
+    'south' => [  0,0, 0,1, 'cx', 1,0 ],
+    'north' => [ 0,-1, 0,0, 'cx', 1,0 ],
+    'east' =>  [  0,0, 1,0, 'cy', 0,1 ],
+    'west' =>  [ -1,0, 0,0, 'cy', 0,1 ] ,
+    180 => [  0,0, 0,1, 'cx', 1,0 ],
+    0 => [ 0,-1, 0,0, 'cx', 1,0 ],
+    90 =>  [  0,0, 1,0, 'cy', 0,1 ],
+    270 =>  [ -1,0, 0,0, 'cy', 0,1 ] ,
+    };
+
+  my $p = $place->{$dir};
+
+  return [] unless defined $p;
+
+  # start pos
+  my $x = $p->[0] + $self->{x} + $p->[2] * $self->{cx};
+  my $y = $p->[1] + $self->{y} + $p->[3] * $self->{cy};
+
+  my @allowed;
+  push @pos, '' if @pos == 0;
+
+  my $c = $p->[4];
+  if (@pos == 1 && $pos[0] eq '')
+    {
+    # allow all of them
+    for (1 .. $self->{$c})
+      {
+      push @allowed, $x, $y;
+      $x += $p->[5];
+      $y += $p->[6];
+      }
+    }
+  else
+    {
+    # allow only the given position
+    my $ps = $pos[0];
+    # limit to 0..$self->{cx}-1
+    $ps = $self->{$c} + $ps if $ps < 0;
+    $ps = 0 if $ps < 0;
+    $ps = $self->{$c} - 1 if $ps >= $self->{$c};
+    $x += $p->[5] * $ps;
+    $y += $p->[6] * $ps;
+    push @allowed, $x, $y;
+    }
+
+  \@allowed;
+  }
+
+package Graph::Easy;
+use strict;
+use Graph::Easy::Node::Cell;
+
+use Graph::Easy::Edge::Cell qw/
+  EDGE_HOR EDGE_VER EDGE_CROSS
+  EDGE_TYPE_MASK
+  EDGE_HOLE
+ /;
+
+sub _clear_tries
+  {
+  # Take a list of potential positions for a node, and then remove the
+  # ones that are immediately near any other node.
+  # Returns a list of "good" positions. Afterwards $node->{x} is undef.
+  my ($self, $node, $cells, $tries) = @_;
+
+  my $src = 0; my @new;
+
+  print STDERR "# clearing ", scalar @$tries / 2, " tries for $node->{name}\n" if $self->{debug};
+
+  my $node_grandpa = $node->find_grandparent();
+
+  while ($src < scalar @$tries)
+    {
+    # check the current position
+
+    # temporary place node here
+    my $x = $tries->[$src];
+    my $y = $tries->[$src+1];
+
+#    print STDERR "# checking $x,$y\n" if $self->{debug};
+
+    $node->{x} = $x;
+    $node->{y} = $y;
+
+    my @near = $node->_near_places($cells, 1, undef, 1);
+
+    # push also the four corner cells to avoid placing nodes corner-to-corner
+    push @near, $x-1, $y-1,					# upperleft corner
+                $x-1, $y+($node->{cy}||1),			# lowerleft corner
+                $x+($node->{cx}||1), $y+($node->{cy}||1),	# lowerright corner
+                $x+($node->{cx}||1), $y-1;			# upperright corner
+
+    # check all near places to be free from nodes (except our children)
+    my $j = 0; my $g = 0;
+    while ($j < @near)
+      {
+      my $xy = $near[$j]. ',' . $near[$j+1];
+
+#      print STDERR "# checking near-place: $xy: " . ref($cells->{$xy}) . "\n" if $self->{debug};
+
+      my $cell = $cells->{$xy};
+
+      # skip, unless we are a children of node, or the cell is our children
+      next unless ref($cell) && $cell->isa('Graph::Easy::Node');
+
+      my $grandpa = $cell->find_grandparent();
+
+      #       this cell is our children
+      #                            this cell is our grandpa
+      #                                                      has the same grandpa as node
+      next if $grandpa == $node || $cell == $node_grandpa || $grandpa == $node_grandpa;
+
+      $g++; last;
+
+      } continue { $j += 2; }
+
+    if ($g == 0)
+      {
+      push @new, $tries->[$src], $tries->[$src+1];
+      }
+    $src += 2;
+    }
+
+  $node->{x} = undef;
+
+  @new;
+  }
+
+my $flow_shift = {
+  270 => [ 0, -1 ],
+   90 => [ 0,  1 ],
+    0 => [ 1,  0 ],
+  180 => [ -1, 0 ],
+  };
+
+sub _placed_shared
+  {
+  # check whether one of the nodes from the list of shared was already placed
+  my ($self) = shift;
+
+  my $placed;
+  for my $n (@_)
+    {
+    $placed = [$n->{x}, $n->{y}] and last if defined $n->{x};
+    }
+  $placed;
+  }
+
+use Graph::Easy::Util qw(first_kv);
+
+sub _find_node_place
+  {
+  # Try to place a node (or node cluster). Return score (usually 0).
+  my ($self, $node, $try, $parent, $edge) = @_;
+
+  $try ||= 0;
+
+  print STDERR "# Finding place for $node->{name}, try #$try\n" if $self->{debug};
+  print STDERR "# Parent node is '$parent->{name}'\n" if $self->{debug} && ref $parent;
+
+  print STDERR "# called from ". join (" ", caller) . "\n" if $self->{debug};
+
+  # If the node has a user-set rank, see if we already placed another node in that
+  # row/column
+  if ($node->{rank} >= 0)
+    {
+    my $r = abs($node->{rank});
+#    print STDERR "# User-set rank for $node->{name} (rank $r)\n";
+    my $c = $self->{_rank_coord};
+#    use Data::Dumper; print STDERR "# rank_pos: \n", Dumper($self->{_rank_pos});
+    if (exists $self->{_rank_pos}->{ $r })
+      {
+      my $co = { x => 0, y => 0 };
+      $co->{$c} = $self->{_rank_pos}->{ $r };
+      while (1 < 3)
+        {
+#	print STDERR "# trying to force placement of '$node->{name}' at $co->{x} $co->{y}\n";
+        return 0 if $node->_do_place($co->{x},$co->{y},$self);
+        $co->{$c} += 2;
+        }
+      }
+    }
+
+  my $cells = $self->{cells};
+
+#  local $self->{debug} = 1;
+
+  my $min_dist = 2;
+  # minlen = 0 => min_dist = 2,
+  # minlen = 1 => min_dist = 2,
+  # minlen = 2 => min_dist = 3, etc
+  $min_dist = $edge->attribute('minlen') + 1 if ref($edge);
+
+  # if the node has outgoing edges (which might be shared)
+  if (!ref($edge))
+    {
+    (undef,$edge) = first_kv($node->{edges}) if keys %{$node->{edges}} > 0;
+    }
+
+  my $dir = undef; $dir = $edge->flow() if ref($edge);
+
+  my @tries;
+#  if (ref($parent) && defined $parent->{x})
+  if (keys %{$node->{edges}} > 0)
+    {
+    my $src_node = $parent; $src_node = $edge->{from} if ref($edge) && !ref($parent);
+    print STDERR "#  from $src_node->{name} to $node->{name}: edge $edge dir $dir\n" if $self->{debug};
+
+    # if there are more than one edge to this node, and they share a start point,
+    # move the node at least 3 cells away to create space for the joints
+
+    my ($s_p, @ss_p);
+    ($s_p, @ss_p) = $edge->port('start') if ref($edge);
+
+    my ($from,$to);
+    if (ref($edge))
+      {
+      $from = $edge->{from}; $to = $edge->{to};
+      }
+
+    my @shared_nodes;
+    @shared_nodes = $from->nodes_sharing_start($s_p,@ss_p) if defined $s_p && @ss_p > 0;
+
+    print STDERR "# Edge from '$src_node->{name}' shares an edge start with ", scalar @shared_nodes, " other nodes\n"
+	if $self->{debug};
+
+    if (@shared_nodes > 1)
+      {
+      $min_dist = 3 if $min_dist < 3;				# make space
+      $min_dist++ if $edge->label() ne '';			# make more space for the label
+
+      # if we are the first shared node to be placed
+      my $placed = $self->_placed_shared(@shared_nodes);
+
+      if (defined $placed)
+        {
+        # we are not the first, so skip the placement below
+	# instead place on the same column/row as already placed node(s)
+        my ($bx, $by) = @$placed;
+
+	my $flow = $node->flow();
+
+	print STDERR "# One of the shared nodes was already placed at ($bx,$by) with flow $flow\n"
+	  if $self->{debug};
+
+	my $ofs = 2;			# start with a distance of 2
+	my ($mx, $my) = @{ ($flow_shift->{$flow} || [ 0, 1 ]) };
+
+	while (1)
+	  {
+	  my $x = $bx + $mx * $ofs; my $y = $by + $my * $ofs;
+
+	  print STDERR "# Trying to place $node->{name} at ($x,$y)\n"
+	    if $self->{debug};
+
+	  next if $self->_clear_tries($node, $cells, [ $x,$y ]) == 0;
+	  last if $node->_do_place($x,$y,$self);
+	  }
+	continue {
+	    $ofs += 2;
+	  }
+        return 0;			# found place already
+	} # end we-are-the-first-to-be-placed
+      }
+
+    # shared end point?
+    ($s_p, @ss_p) = $edge->port('end') if ref($edge);
+
+    @shared_nodes = $to->nodes_sharing_end($s_p,@ss_p) if defined $s_p && @ss_p > 0;
+
+    print STDERR "# Edge from '$src_node->{name}' shares an edge end with ", scalar @shared_nodes, " other nodes\n"
+	if $self->{debug};
+
+    if (@shared_nodes > 1)
+      {
+      $min_dist = 3 if $min_dist < 3;
+      $min_dist++ if $edge->label() ne '';			# make more space for the label
+
+      # if the node to be placed is not in the list to be placed, it is the end-point
+
+      # see if we are the first shared node to be placed
+      my $placed = $self->_placed_shared(@shared_nodes);
+
+#      print STDERR "# "; for (@shared_nodes) { print $_->{name}, " "; } print "\n";
+
+      if ((grep( $_ == $node, @shared_nodes)) && defined $placed)
+	{
+        # we are not the first, so skip the placement below
+	# instead place on the same column/row as already placed node(s)
+        my ($bx, $by) = @$placed;
+
+	my $flow = $node->flow();
+
+	print STDERR "# One of the shared nodes was already placed at ($bx,$by) with flow $flow\n"
+	  if $self->{debug};
+
+	my $ofs = 2;			# start with a distance of 2
+	my ($mx, $my) = @{ ($flow_shift->{$flow} || [ 0, 1 ]) };
+
+	while (1)
+	  {
+	  my $x = $bx + $mx * $ofs; my $y = $by + $my * $ofs;
+
+	  print STDERR "# Trying to place $node->{name} at ($x,$y)\n"
+	    if $self->{debug};
+
+	  next if $self->_clear_tries($node, $cells, [ $x,$y ]) == 0;
+	  last if $node->_do_place($x,$y,$self);
+	  }
+	continue {
+	    $ofs += 2;
+	  }
+        return 0;			# found place already
+	} # end we-are-the-first-to-be-placed
+      }
+    }
+
+  if (ref($parent) && defined $parent->{x})
+    {
+    @tries = $parent->_near_places($cells, $min_dist, undef, 0, $dir);
+
+    print STDERR
+	"# Trying chained placement of $node->{name} with min distance $min_dist from parent $parent->{name}\n"
+	if $self->{debug};
+
+    # weed out positions that are unsuitable
+    @tries = $self->_clear_tries($node, $cells, \@tries);
+
+    splice (@tries,0,$try) if $try > 0;	# remove the first N tries
+    print STDERR "# Left with " . scalar @tries . " tries for node $node->{name}\n" if $self->{debug};
+
+    while (@tries > 0)
+      {
+      my $x = shift @tries;
+      my $y = shift @tries;
+
+      print STDERR "# Trying to place $node->{name} at $x,$y\n" if $self->{debug};
+      return 0 if $node->_do_place($x,$y,$self);
+      } # for all trial positions
+    }
+
+  print STDERR "# Trying to place $node->{name} at 0,0\n" if $try == 0 && $self->{debug};
+  # Try to place node at upper left corner (the very first node to be
+  # placed will usually end up there).
+  return 0 if $try == 0 && $node->_do_place(0,0,$self);
+
+  # try to place node near the predecessor(s)
+  my @pre_all = $node->predecessors();
+
+  print STDERR "# Predecessors of $node->{name} " . scalar @pre_all . "\n" if $self->{debug};
+
+  # find all already placed predecessors
+  my @pre;
+  for my $p (@pre_all)
+    {
+    push @pre, $p if defined $p->{x};
+    print STDERR "# Placed predecessors of $node->{name}: $p->{name} at $p->{x},$p->{y}\n" if $self->{debug} && defined $p->{x};
+    }
+
+  # sort predecessors on their rank (to try first the higher ranking ones on placement)
+  @pre = sort { $b->{rank} <=> $a->{rank} } @pre;
+
+  print STDERR "# Number of placed predecessors of $node->{name}: " . scalar @pre . "\n" if $self->{debug};
+
+  if (@pre <= 2 && @pre > 0)
+    {
+
+    if (@pre == 1)
+      {
+      # only one placed predecessor, so place $node near it
+      print STDERR "# placing $node->{name} near predecessor\n" if $self->{debug};
+      @tries = ( $pre[0]->_near_places($cells, $min_dist), $pre[0]->_near_places($cells,$min_dist+2) );
+      }
+    else
+      {
+      # two placed predecessors, so place at crossing point of both of them
+      # compute difference between the two nodes
+
+      my $dx = ($pre[0]->{x} - $pre[1]->{x});
+      my $dy = ($pre[0]->{y} - $pre[1]->{y});
+
+      # are both nodes NOT on a straight line?
+      if ($dx != 0 && $dy != 0)
+        {
+        # ok, so try to place at the crossing point
+	@tries = (
+	  $pre[0]->{x}, $pre[1]->{y},
+	  $pre[0]->{y}, $pre[1]->{x},
+	);
+        }
+      else
+        {
+        # two nodes on a line, try to place node in the middle
+        if ($dx == 0)
+          {
+	  @tries = ( $pre[1]->{x}, $pre[1]->{y} + int($dy / 2) );
+          }
+        else
+          {
+	  @tries = ( $pre[1]->{x} + int($dx / 2), $pre[1]->{y} );
+          }
+        }
+      # XXX TODO BUG: shouldn't we also try this if we have more than 2
+      # placed predecessors?
+
+      # In addition, we can also try to place the node around the
+      # different nodes:
+      foreach my $n (@pre)
+        {
+        push @tries, $n->_near_places($cells, $min_dist);
+        }
+      }
+    }
+
+  my @suc_all = $node->successors();
+
+  # find all already placed successors
+  my @suc;
+  for my $s (@suc_all)
+    {
+    push @suc, $s if defined $s->{x};
+    }
+  print STDERR "# Number of placed successors of $node->{name}: " . scalar @suc . "\n" if $self->{debug};
+  foreach my $s (@suc)
+    {
+    # for each successors (especially if there is only one), try to place near
+    push @tries, $s->_near_places($cells, $min_dist);
+    push @tries, $s->_near_places($cells, $min_dist + 2);
+    }
+
+  # weed out positions that are unsuitable
+  @tries = $self->_clear_tries($node, $cells, \@tries);
+
+  print STDERR "# Left with " . scalar @tries . " for node $node->{name}\n" if $self->{debug};
+
+  splice (@tries,0,$try) if $try > 0;	# remove the first N tries
+
+  while (@tries > 0)
+    {
+    my $x = shift @tries;
+    my $y = shift @tries;
+
+    print STDERR "# Trying to place $node->{name} at $x,$y\n" if $self->{debug};
+    return 0 if $node->_do_place($x,$y,$self);
+
+    } # for all trial positions
+
+  ##############################################################################
+  # all simple possibilities exhausted, try a generic approach
+
+  print STDERR "# No more simple possibilities for node $node->{name}\n" if $self->{debug};
+
+  # XXX TODO:
+  # find out which sides of the node predecessor node(s) still have free
+  # ports/slots. With increasing distances, try to place the node around these.
+
+  # If no predecessors/incoming edges, try to place in column 0, otherwise
+  # considered the node's rank, too
+
+  my $col = 0; $col = $node->{rank} * 2 if @pre > 0;
+
+  $col = $pre[0]->{x} if @pre > 0;
+
+  # find the first free row
+  my $y = 0;
+  $y +=2 while (exists $cells->{"$col,$y"});
+  $y += 1 if exists $cells->{"$col," . ($y-1)};		# leave one cell spacing
+
+  # now try to place node (or node cluster)
+  while (1)
+    {
+    next if $self->_clear_tries($node, $cells, [ $col,$y ]) == 0;
+    last if $node->_do_place($col,$y,$self);
+    }
+    continue {
+    $y += 2;
+    }
+
+  $node->{x} = $col;
+
+  0;							# success, score 0
+  }
+
+sub _trace_path
+  {
+  # find a free way from $src to $dst (both need to be placed beforehand)
+  my ($self, $src, $dst, $edge) = @_;
+
+  print STDERR "# Finding path from '$src->{name}' to '$dst->{name}'\n" if $self->{debug};
+  print STDERR "# src: $src->{x}, $src->{y} dst: $dst->{x}, $dst->{y}\n" if $self->{debug};
+
+  my $coords = $self->_find_path ($src, $dst, $edge);
+
+  # found no path?
+  if (!defined $coords)
+    {
+    print STDERR "# Unable to find path from $src->{name} ($src->{x},$src->{y}) to $dst->{name} ($dst->{x},$dst->{y})\n" if $self->{debug};
+    return undef;
+    }
+
+  # path is empty, happens for sharing edges with only a joint
+  return 1 if scalar @$coords == 0;
+
+  # Create all cells from the returned list and score path (lower score: better)
+  my $i = 0;
+  my $score = 0;
+  while ($i < scalar @$coords)
+    {
+    my $type = $coords->[$i+2];
+    $self->_create_cell($edge,$coords->[$i],$coords->[$i+1],$type);
+    $score ++;					# each element: one point
+    $type &= EDGE_TYPE_MASK;			# mask flags
+    # edge bend or cross: one point extra
+    $score ++ if $type != EDGE_HOR && $type != EDGE_VER;
+    $score += 3 if $type == EDGE_CROSS;		# crossings are doubleplusungood
+    $i += 3;
+    }
+
+  $score;
+  }
+
+sub _create_cell
+  {
+  my ($self,$edge,$x,$y,$type) = @_;
+
+  my $cells = $self->{cells}; my $xy = "$x,$y";
+
+  if (ref($cells->{$xy}) && $cells->{$xy}->isa('Graph::Easy::Edge'))
+    {
+    $cells->{$xy}->_make_cross($edge,$type & EDGE_FLAG_MASK);
+    # insert a EDGE_HOLE into the cells of the edge (but not into the list of
+    # to-be-rendered cells). This cell will be removed by the optimizer later on.
+    Graph::Easy::Edge::Cell->new( type => EDGE_HOLE, edge => $edge, x => $x, y => $y );
+    return;
+    }
+
+  my $path = Graph::Easy::Edge::Cell->new( type => $type, edge => $edge, x => $x, y => $y );
+  $cells->{$xy} = $path;	# store in cells
+  }
+
+sub _path_is_clear
+  {
+  # For all points (x,y pairs) in the path, check that the cell is still free
+  # $path points to a list of [ x,y,type, x,y,type, ...]
+  my ($self,$path) = @_;
+
+  my $cells = $self->{cells};
+  my $i = 0;
+  while ($i < scalar @$path)
+    {
+    my $x = $path->[$i];
+    my $y = $path->[$i+1];
+    # my $t = $path->[$i+2];
+    $i += 3;
+
+    return 0 if exists $cells->{"$x,$y"};	# obstacle hit
+    }
+  1;						# path is clear
+  }
+
+1;
+__END__
+
+=head1 NAME
+
+Graph::Easy::Layout::Path - Path management for Manhattan-style grids
+
+=head1 SYNOPSIS
+
+	use Graph::Easy;
+
+	my $graph = Graph::Easy->new();
+
+	my $bonn = Graph::Easy::Node->new(
+		name => 'Bonn',
+	);
+	my $berlin = Graph::Easy::Node->new(
+		name => 'Berlin',
+	);
+
+	$graph->add_edge ($bonn, $berlin);
+
+	$graph->layout();
+
+	print $graph->as_ascii( );
+
+	# prints:
+
+	# +------+     +--------+
+	# | Bonn | --> | Berlin |
+	# +------+     +--------+
+
+=head1 DESCRIPTION
+
+C<Graph::Easy::Layout::Scout> contains just the actual path-managing code for
+L<Graph::Easy|Graph::Easy>, e.g. to create/destroy/maintain paths, node
+placement etc.
+
+=head1 EXPORT
+
+Exports nothing.
+
+=head1 SEE ALSO
+
+L<Graph::Easy>.
+
+=head1 METHODS into Graph::Easy
+
+This module injects the following methods into C<Graph::Easy>:
+
+=head2 _path_is_clear()
+
+	$graph->_path_is_clear($path);
+
+For all points (x,y pairs) in the path, check that the cell is still free.
+C<$path> points to a list x,y,type pairs as in C<< [ [x,y,type], [x,y,type], ...] >>.
+
+=head2 _create_cell()
+
+	my $cell = $graph->($edge,$x,$y,$type);
+
+Create a cell at C<$x,$y> coordinates with type C<$type> for the specified
+edge.
+
+=head2 _path_is_clear()
+
+	$graph->_path_is_clear();
+
+For all points (x,y pairs) in the path, check that the cell is still free.
+C<$path> points to a list of C<[ x,y,type, x,y,type, ...]>.
+
+Returns true when the path is clear, false otherwise.
+
+=head2 _trace_path()
+
+	my $path = my $graph->_trace_path($src,$dst,$edge);
+
+Find a free way from source node/group to destination node/group for the
+specified edge. Both source and destination need to be placed beforehand.
+
+=head1 METHODS in Graph::Easy::Node
+
+This module injects the following methods into C<Graph::Easy::Node>:
+
+=head2 _near_places()
+
+	my $node->_near_places();
+
+Take a node and return a list of possible placements around it and
+prune out already occupied cells. $d is the distance from the node
+border and defaults to two (for placements). Set it to one for
+adjacent cells.
+
+=head2 _shuffle_dir()
+
+	my $dirs = $node->_shuffle_dir( [ 0,1,2,3 ], $dir);
+
+Take a ref to an array with four entries and shuffle them around according to
+C<$dir>.
+
+=head2 _shift()
+
+	my $dir = $node->_shift($degrees);
+
+Return a the C<flow()> direction shifted by X degrees to C<$dir>.
+
+=head1 AUTHOR
+
+Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>.
+
+See the LICENSE file for information.
+
+=cut

perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Layout/Repair.pm

@@ -0,0 +1,649 @@
+#############################################################################
+# Layout directed graphs on a flat plane. Part of Graph::Easy.
+#
+# Code to repair spliced layouts (after group cells have been inserted).
+#
+#############################################################################
+
+package Graph::Easy::Layout::Repair;
+
+$VERSION = '0.76';
+
+#############################################################################
+#############################################################################
+# for layouts with groups:
+
+package Graph::Easy;
+
+use strict;
+use warnings;
+
+use Graph::Easy::Util qw(ord_values);
+
+sub _edges_into_groups
+  {
+  my $self = shift;
+
+  # Put all edges between two nodes with the same group in the group as well
+  for my $edge (ord_values $self->{edges})
+    {
+    my $gf = $edge->{from}->group();
+    my $gt = $edge->{to}->group();
+
+    $gf->_add_edge($edge) if defined $gf && defined $gt && $gf == $gt;
+    }
+
+  $self;
+  }
+
+sub _repair_nodes
+  {
+  # Splicing the rows/columns to add filler cells will have torn holes into
+  # multi-edges nodes, so we insert additional filler cells.
+  my ($self) = @_;
+  my $cells = $self->{cells};
+
+  # Make multi-celled nodes occupy the proper double space due to splicing
+  # in group cell has doubled the layout in each direction:
+  for my $n ($self->nodes())
+    {
+    # 1 => 1, 2 => 3, 3 => 5, 4 => 7 etc
+    $n->{cx} = $n->{cx} * 2 - 1;
+    $n->{cy} = $n->{cy} * 2 - 1;
+    }
+
+  # We might get away with not inserting filler cells if we just mark the
+  # cells as used (e.g. use only one global filler cell) since filler cells
+  # aren't actually rendered, anyway.
+
+  for my $cell (ord_values $cells)
+    {
+    next unless $cell->isa('Graph::Easy::Node::Cell');
+
+    # we have "[ empty  ] [ filler ]" (unless cell is on the same column as node)
+    if ($cell->{x} > $cell->{node}->{x})
+      {
+      my $x = $cell->{x} - 1; my $y = $cell->{y};
+
+#      print STDERR "# inserting filler at $x,$y for $cell->{node}->{name}\n";
+      $cells->{"$x,$y"} =
+        Graph::Easy::Node::Cell->new(node => $cell->{node}, x => $x, y => $y );
+      }
+
+    # we have " [ empty ]  "
+    #         " [ filler ] " (unless cell is on the same row as node)
+    if ($cell->{y} > $cell->{node}->{y})
+      {
+      my $x = $cell->{x}; my $y = $cell->{y} - 1;
+
+#      print STDERR "# inserting filler at $x,$y for $cell->{node}->{name}\n";
+      $cells->{"$x,$y"} =
+        Graph::Easy::Node::Cell->new(node => $cell->{node}, x => $x, y => $y );
+      }
+    }
+  }
+
+sub _repair_cell
+  {
+  my ($self, $type, $edge, $x, $y, $after, $before) = @_;
+
+  # already repaired?
+  return if exists $self->{cells}->{"$x,$y"};
+
+#  print STDERR "# Insert edge cell at $x,$y (type $type) for edge $edge->{from}->{name} --> $edge->{to}->{name}\n";
+
+  $self->{cells}->{"$x,$y"} =
+    Graph::Easy::Edge::Cell->new(
+      type => $type,
+      edge => $edge, x => $x, y => $y, before => $before, after => $after );
+
+  }
+
+sub _splice_edges
+  {
+  # Splicing the rows/columns to add filler cells might have torn holes into
+  # edges, so we splice these together again.
+  my ($self) = @_;
+
+  my $cells = $self->{cells};
+
+  print STDERR "# Reparing spliced layout\n" if $self->{debug};
+
+  # Edge end/start points inside groups are not handled here, but in
+  # _repair_group_edge()
+
+  # go over the old layout, because the new cells were inserted into odd
+  # rows/columns and we do not care for these:
+  for my $cell (sort { $a->{x} <=> $b->{x} || $a->{y} <=> $b->{y} } values %$cells)
+    {
+    next unless $cell->isa('Graph::Easy::Edge::Cell');
+
+    my $edge = $cell->{edge};
+
+    #########################################################################
+    # check for "[ JOINT ] [ empty  ] [ edge ]"
+
+    my $x = $cell->{x} + 2; my $y = $cell->{y};
+
+    my $type = $cell->{type} & EDGE_TYPE_MASK;
+
+    # left is a joint and right exists
+    if ( ($type == EDGE_S_E_W || $type == EDGE_N_E_W || $type == EDGE_E_N_S)
+         && exists $cells->{"$x,$y"})
+      {
+      my $right = $cells->{"$x,$y"};
+
+#      print STDERR "# at $x,$y\n";
+
+      # |-> [ empty ] [ node ]
+      if ($right->isa('Graph::Easy::Edge::Cell'))
+	{
+        # when the left one is a joint, the right one must be an edge
+        $self->error("Found non-edge piece ($right->{type} $right) right to a joint ($type)")
+          unless $right->isa('Graph::Easy::Edge::Cell');
+
+#        print STDERR "splicing in HOR piece to the right of joint at $x, $y ($edge $right $right->{edge})\n";
+
+        # insert the new piece before the first part of the edge after the joint
+        $self->_repair_cell(EDGE_HOR(), $right->{edge},$cell->{x}+1,$y,0)
+          if $edge != $right->{edge};
+        }
+      }
+
+    #########################################################################
+    # check for "[ edge ] [ empty  ] [ joint ]"
+
+    $x = $cell->{x} - 2; $y = $cell->{y};
+
+    # right is a joint and left exists
+    if ( ($type == EDGE_S_E_W || $type == EDGE_N_E_W || $type == EDGE_W_N_S)
+         && exists $cells->{"$x,$y"})
+     {
+      my $left = $cells->{"$x,$y"};
+
+      # [ node ] [ empty ] [ <-| ]
+      if (!$left->isa('Graph::Easy::Node'))
+	{
+        # when the left one is a joint, the right one must be an edge
+        $self->error('Found non-edge piece right to a joint')
+          unless $left->isa('Graph::Easy::Edge::Cell');
+
+        # insert the new piece before the joint
+        $self->_repair_cell(EDGE_HOR(), $edge, $cell->{x}+1,$y,0) # $left,$cell)
+          if $edge != $left->{edge};
+	}
+      }
+
+    #########################################################################
+    # check for " [ joint ]
+    #		  [ empty ]
+    #             [ edge ]"
+
+    $x = $cell->{x}; $y = $cell->{y} + 2;
+
+    # top is a joint and down exists
+    if ( ($type == EDGE_S_E_W || $type == EDGE_E_N_S || $type == EDGE_W_N_S)
+         && exists $cells->{"$x,$y"})
+     {
+      my $bottom = $cells->{"$x,$y"};
+
+      # when top is a joint, the bottom one must be an edge
+      $self->error('Found non-edge piece below a joint')
+        unless $bottom->isa('Graph::Easy::Edge::Cell');
+
+#      print STDERR "splicing in VER piece below joint at $x, $y\n";
+
+	# XXX TODO
+      # insert the new piece after the joint
+      $self->_repair_cell(EDGE_VER(), $bottom->{edge},$x,$cell->{y}+1,0)
+        if $edge != $bottom->{edge};
+      }
+
+    #########################################################################
+    # check for "[ --- ] [ empty  ] [ ---> ]"
+
+    $x = $cell->{x} + 2; $y = $cell->{y};
+
+    if (exists $cells->{"$x,$y"})
+      {
+      my $right = $cells->{"$x,$y"};
+
+      $self->_repair_cell(EDGE_HOR(), $edge, $cell->{x}+1,$y,$cell,$right)
+        if $right->isa('Graph::Easy::Edge::Cell') &&
+           defined $right->{edge} && defined $right->{type} &&
+	# check that both cells belong to the same edge
+	(  $edge == $right->{edge}  ||
+	# or the right part is a cross
+	   $right->{type} == EDGE_CROSS ||
+	# or the left part is a cross
+	   $cell->{type} == EDGE_CROSS );
+      }
+
+    #########################################################################
+    # check for [ | ]
+    #		[ empty ]
+    #		[ | ]
+    $x = $cell->{x}; $y = $cell->{y}+2;
+
+    if (exists $cells->{"$x,$y"})
+      {
+      my $below = $cells->{"$x,$y"};
+
+      $self->_repair_cell(EDGE_VER(),$edge,$x,$cell->{y}+1,$cell,$below)
+	if $below->isa('Graph::Easy::Edge::Cell') &&
+        # check that both cells belong to the same edge
+	(  $edge == $below->{edge}  ||
+	# or the lower part is a cross
+	   $below->{type} == EDGE_CROSS ||
+	# or the upper part is a cross
+	   $cell->{type} == EDGE_CROSS );
+      }
+
+    } # end for all cells
+
+  $self;
+  }
+
+sub _new_edge_cell
+  {
+  # create a new edge cell to be spliced into the layout for repairs
+  my ($self, $cells, $group, $edge, $x, $y, $after, $type) = @_;
+
+  $type += EDGE_SHORT_CELL() if defined $group;
+
+  my $e_cell = Graph::Easy::Edge::Cell->new(
+	  type => $type, edge => $edge, x => $x, y => $y, after => $after);
+  $group->_del_cell($e_cell) if defined $group;
+  $cells->{"$x,$y"} = $e_cell;
+  }
+
+sub _check_edge_cell
+  {
+  # check a start/end edge cell and if nec. repair it
+  my ($self, $cell, $x, $y, $flag, $type, $match, $check, $where) = @_;
+
+  my $edge = $cell->{edge};
+  if (grep { exists $_->{cell_class} && $_->{cell_class} =~ $match } ord_values ($check))
+    {
+    $cell->{type} &= ~ $flag;		# delete the flag
+
+    $self->_new_edge_cell(
+	$self->{cells}, $edge->{group}, $edge, $x, $y, $where, $type + $flag);
+    }
+  }
+
+sub _repair_group_edge
+  {
+  # repair an edges inside a group
+  my ($self, $cell, $rows, $cols, $group) = @_;
+
+  my $cells = $self->{cells};
+  my ($x,$y,$doit);
+
+  my $type = $cell->{type};
+
+  #########################################################################
+  # check for " [ empty ] [ |---> ]"
+  $x = $cell->{x} - 1; $y = $cell->{y};
+
+  $self->_check_edge_cell($cell, $x, $y, EDGE_START_W, EDGE_HOR, qr/g[rl]/, $cols->{$x}, 0)
+    if (($type & EDGE_START_MASK) == EDGE_START_W);
+
+  #########################################################################
+  # check for " [ <--- ] [ empty ]"
+  $x = $cell->{x} + 1;
+
+  $self->_check_edge_cell($cell, $x, $y, EDGE_START_E, EDGE_HOR, qr/g[rl]/, $cols->{$x}, 0)
+    if (($type & EDGE_START_MASK) == EDGE_START_E);
+
+  #########################################################################
+  # check for " [ --> ] [ empty ]"
+  $x = $cell->{x} + 1;
+
+  $self->_check_edge_cell($cell, $x, $y, EDGE_END_E, EDGE_HOR, qr/g[rl]/, $cols->{$x}, -1)
+    if (($type & EDGE_END_MASK) == EDGE_END_E);
+
+#  $self->_check_edge_cell($cell, $x, $y, EDGE_END_E, EDGE_E_N_S, qr/g[rl]/, $cols->{$x}, -1)
+#    if (($type & EDGE_END_MASK) == EDGE_END_E);
+
+  #########################################################################
+  # check for " [ empty ] [ <-- ]"
+  $x = $cell->{x} - 1;
+
+  $self->_check_edge_cell($cell, $x, $y, EDGE_END_W, EDGE_HOR, qr/g[rl]/, $cols->{$x}, -1)
+    if (($type & EDGE_END_MASK) == EDGE_END_W);
+
+  #########################################################################
+  #########################################################################
+  # vertical cases
+
+  #########################################################################
+  # check for [empty]
+  #           [ | ]
+  $x = $cell->{x}; $y = $cell->{y} - 1;
+
+  $self->_check_edge_cell($cell, $x, $y, EDGE_START_N, EDGE_VER, qr/g[tb]/, $rows->{$y}, 0)
+    if (($type & EDGE_START_MASK) == EDGE_START_N);
+
+  #########################################################################
+  # check for [ |]
+  #           [ empty ]
+  $y = $cell->{y} + 1;
+
+  $self->_check_edge_cell($cell, $x, $y, EDGE_START_S, EDGE_VER, qr/g[tb]/, $rows->{$y}, 0)
+    if (($type & EDGE_START_MASK) == EDGE_START_S);
+
+  #########################################################################
+  # check for [ v ]
+  #           [empty]
+  $y = $cell->{y} + 1;
+
+  $self->_check_edge_cell($cell, $x, $y, EDGE_END_S, EDGE_VER, qr/g[tb]/, $rows->{$y}, -1)
+    if (($type & EDGE_END_MASK) == EDGE_END_S);
+
+  #########################################################################
+  # check for [ empty ]
+  #           [ ^     ]
+  $y = $cell->{y} - 1;
+
+  $self->_check_edge_cell($cell, $x, $y, EDGE_END_N, EDGE_VER, qr/g[tb]/, $rows->{$y}, -1)
+    if (($type & EDGE_END_MASK) == EDGE_END_N);
+  }
+
+sub _repair_edge
+  {
+  # repair an edge outside a group
+  my ($self, $cell, $rows, $cols) = @_;
+
+  my $cells = $self->{cells};
+
+  #########################################################################
+  # check for [ |\n|\nv ]
+  #	        [empty]	... [non-empty]
+  #	        [node]
+
+  my $x = $cell->{x}; my $y = $cell->{y} + 1;
+
+  my $below = $cells->{"$x,$y"}; 		# must be empty
+
+  if  (!ref($below) && (($cell->{type} & EDGE_END_MASK) == EDGE_END_S))
+    {
+    if (grep { exists $_->{cell_class} && $_->{cell_class} =~ /g[tb]/ } ord_values $rows->{$y})
+      {
+      # delete the start flag
+      $cell->{type} &= ~ EDGE_END_S;
+
+      $self->_new_edge_cell($cells, undef, $cell->{edge}, $x, $y, -1,
+          EDGE_VER() + EDGE_END_S() );
+      }
+    }
+  # XXX TODO: do the other ends (END_N, END_W, END_E), too
+
+  }
+
+sub _repair_edges
+  {
+  # fix edge end/start cells to be closer to the node cell they point at
+  my ($self, $rows, $cols) = @_;
+
+  my $cells = $self->{cells};
+
+  # go over all existing cells
+  for my $cell (sort { $a->{x} <=> $b->{x} || $a->{y} <=> $b->{y} } values %$cells)
+    {
+    next unless $cell->isa('Graph::Easy::Edge::Cell');
+
+    # skip odd positions
+    next unless ($cell->{x} & 1) == 0 && ($cell->{y} & 1) == 0;
+
+    my $group = $cell->group();
+
+    $self->_repair_edge($cell,$rows,$cols) unless $group;
+    $self->_repair_group_edge($cell,$rows,$cols,$group) if $group;
+
+    } # end for all cells
+  }
+
+sub _fill_group_cells
+  {
+  # after doing a layout(), we need to add the group to each cell based on
+  # what group the nearest node is in.
+  my ($self, $cells_layout) = @_;
+
+  print STDERR "\n# Padding with fill cells, have ",
+    scalar $self->groups(), " groups.\n" if $self->{debug};
+
+  # take a shortcut if we do not have groups
+  return $self if $self->groups == 0;
+
+  $self->{padding_cells} = 1;		# set to true
+
+  # We need to insert "filler" cells around each node/edge/cell:
+
+  # To "insert" the filler cells, we simple multiply each X and Y by 2, this
+  # is O(N) where N is the number of actually existing cells. Otherwise we
+  # would have to create the full table-layout, and then insert rows/columns.
+  my $cells = {};
+  for my $key (sort keys %$cells_layout)
+    {
+    my ($x,$y) = split /,/, $key;
+    my $cell = $cells_layout->{$key};
+
+    $x *= 2;
+    $y *= 2;
+    $cell->{x} = $x;
+    $cell->{y} = $y;
+
+    $cells->{"$x,$y"} = $cell;
+    }
+
+  $self->{cells} = $cells;		# override with new cell layout
+
+  $self->_splice_edges();		# repair edges
+  $self->_repair_nodes();		# repair multi-celled nodes
+
+  my $c = 'Graph::Easy::Group::Cell';
+  for my $cell (ord_values $self->{cells})
+    {
+    # DO NOT MODIFY $cell IN THE LOOP BODY!
+
+    my ($x,$y) = ($cell->{x},$cell->{y});
+
+    # find the primary node for node cells, for group check
+    my $group = $cell->group();
+
+    # not part of group, so no group-cells nec.
+    next unless $group;
+
+    # now insert up to 8 filler cells around this cell
+    my $ofs = [ -1, 0,
+		0, -1,
+		+1, 0,
+		+1, 0,
+		0, +1,
+		0, +1,
+		-1, 0,
+		-1, 0,  ];
+    while (@$ofs > 0)
+      {
+      $x += shift @$ofs;
+      $y += shift @$ofs;
+
+      $cells->{"$x,$y"} = $c->new ( graph => $self, group => $group, x => $x, y => $y )
+        unless exists $cells->{"$x,$y"};
+      }
+    }
+
+  # Nodes positioned two cols/rows apart (f.i. y == 0 and y == 2) will be
+  # three cells apart (y == 0 and y == 4) after the splicing, the step above
+  # will not be able to close that hole - it will create fillers at y == 1 and
+  # y == 3. So we close these holes now with an extra step.
+  for my $cell (ord_values ( $self->{cells} ))
+    {
+    # only for filler cells
+    next unless $cell->isa('Graph::Easy::Group::Cell');
+
+    my ($sx,$sy) = ($cell->{x},$cell->{y});
+    my $group = $cell->{group};
+
+    my $x = $sx; my $y2 = $sy + 2; my $y = $sy + 1;
+    # look for:
+    # [ group ]
+    # [ empty ]
+    # [ group ]
+    if (exists $cells->{"$x,$y2"} && !exists $cells->{"$x,$y"})
+      {
+      my $down = $cells->{"$x,$y2"};
+      if ($down->isa('Graph::Easy::Group::Cell') && $down->{group} == $group)
+        {
+	$cells->{"$x,$y"} = $c->new ( graph => $self, group => $group, x => $x, y => $y );
+        }
+      }
+    $x = $sx+1; my $x2 = $sx + 2; $y = $sy;
+    # look for:
+    # [ group ]  [ empty ]  [ group ]
+    if (exists $cells->{"$x2,$y"} && !exists $cells->{"$x,$y"})
+      {
+      my $right = $cells->{"$x2,$y"};
+      if ($right->isa('Graph::Easy::Group::Cell') && $right->{group} == $group)
+        {
+	$cells->{"$x,$y"} = $c->new ( graph => $self, group => $group, x => $x, y => $y );
+        }
+      }
+    }
+
+  # XXX TODO
+  # we should "grow" the group area to close holes
+
+  for my $group (ord_values ( $self->{groups} ))
+    {
+    $group->_set_cell_types($cells);
+    }
+
+  # create a mapping for each row/column so that we can repair edge starts/ends
+  my $rows = {};
+  my $cols = {};
+  for my $cell (ord_values ($cells))
+    {
+    $rows->{$cell->{y}}->{$cell->{x}} = $cell;
+    $cols->{$cell->{x}}->{$cell->{y}} = $cell;
+    }
+  $self->_repair_edges($rows,$cols);	# insert short edge cells on group
+					# border rows/columns
+
+  # for all groups, set the cell carrying the label (top-left-most cell)
+  for my $group (ord_values ( $self->{groups} ))
+    {
+    $group->_find_label_cell();
+    }
+
+# DEBUG:
+# for my $cell (ord_values $cells)
+#   {
+#   $cell->_correct_size();
+#   }
+#
+# my $y = 0;
+# for my $cell (sort { $a->{y} <=> $b->{y} || $a->{x} <=> $b->{x} } values %$cells)
+#   {
+#  print STDERR "\n" if $y != $cell->{y};
+#  print STDERR "$cell->{x},$cell->{y}, $cell->{w},$cell->{h}, ", $cell->{group}->{name} || 'none', "\t";
+#   $y = $cell->{y};
+#  }
+# print STDERR "\n";
+
+  $self;
+  }
+
+1;
+__END__
+
+=head1 NAME
+
+Graph::Easy::Layout::Repair - Repair spliced layout with group cells
+
+=head1 SYNOPSIS
+
+	use Graph::Easy;
+
+	my $graph = Graph::Easy->new();
+
+	my $bonn = Graph::Easy::Node->new(
+		name => 'Bonn',
+	);
+	my $berlin = Graph::Easy::Node->new(
+		name => 'Berlin',
+	);
+
+	$graph->add_edge ($bonn, $berlin);
+
+	$graph->layout();
+
+	print $graph->as_ascii( );
+
+	# prints:
+
+	# +------+     +--------+
+	# | Bonn | --> | Berlin |
+	# +------+     +--------+
+
+=head1 DESCRIPTION
+
+C<Graph::Easy::Layout::Repair> contains code that can splice in
+group cells into a layout, as well as repair the layout after that step.
+
+It is part of L<Graph::Easy|Graph::Easy> and used automatically.
+
+=head1 METHODS
+
+C<Graph::Easy::Layout> injects the following methods into the C<Graph::Easy>
+namespace:
+
+=head2 _edges_into_groups()
+
+Put the edges into the appropriate group and class.
+
+=head2 _assign_ranks()
+
+	$graph->_assign_ranks();
+
+=head2 _repair_nodes()
+
+Splicing the rows/columns to add filler cells will have torn holes into
+multi-edges nodes, so we insert additional filler cells to repair this.
+
+=head2 _splice_edges()
+
+Splicing the rows/columns to add filler cells might have torn holes into
+multi-celled edges, so we splice these together again.
+
+=head2 _repair_edges()
+
+Splicing the rows/columns to add filler cells might have put "holes"
+between an edge start/end and the node cell it points to. This
+routine fixes this problem by extending the edge by one cell if
+necessary.
+
+=head2 _fill_group_cells()
+
+After doing a C<layout()>, we need to add the group to each cell based on
+what group the nearest node is in.
+
+This routine will also find the label cell for each group, and repair
+edge/node damage done by the splicing.
+
+=head1 EXPORT
+
+Exports nothing.
+
+=head1 SEE ALSO
+
+L<Graph::Easy>.
+
+=head1 AUTHOR
+
+Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>
+
+See the LICENSE file for information.
+
+=cut

perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Node/Anon.pm

@@ -0,0 +1,116 @@
+#############################################################################
+# (c) by Tels 2004. Part of Graph::Easy. An anonymous (invisible) node.
+#
+#############################################################################
+
+package Graph::Easy::Node::Anon;
+
+use Graph::Easy::Node;
+
+@ISA = qw/Graph::Easy::Node/;
+$VERSION = '0.76';
+
+use strict;
+use warnings;
+
+sub _init
+  {
+  my $self = shift;
+
+  $self->SUPER::_init(@_);
+
+  $self->{name} = '#' . $self->{id};
+  $self->{class} = 'node.anon';
+
+  $self->{att}->{label} = ' ';
+
+  $self;
+  }
+
+sub _correct_size
+  {
+  my $self = shift;
+
+  $self->{w} = 3;
+  $self->{h} = 3;
+
+  $self;
+  }
+
+sub attributes_as_txt
+  {
+  my $self = shift;
+
+  $self->SUPER::attributes_as_txt( {
+     node => {
+       label => undef,
+       shape => undef,
+       class => undef,
+       } } );
+  }
+
+sub as_pure_txt
+  {
+  '[ ]';
+  }
+
+sub _as_part_txt
+  {
+  '[ ]';
+  }
+
+sub as_txt
+  {
+  my $self = shift;
+
+  '[ ]' . $self->attributes_as_txt();
+  }
+
+sub text_styles_as_css
+  {
+  '';
+  }
+
+sub is_anon
+  {
+  # is an anon node
+  1;
+  }
+
+1;
+__END__
+
+=head1 NAME
+
+Graph::Easy::Node::Anon - An anonymous, invisible node in Graph::Easy
+
+=head1 SYNOPSIS
+
+	use Graph::Easy::Node::Anon;
+
+	my $anon = Graph::Easy::Node::Anon->new();
+
+=head1 DESCRIPTION
+
+A C<Graph::Easy::Node::Anon> represents an anonymous, invisible node.
+These can be used to let edges start and end "nowhere".
+
+The syntax in the Graph::Easy textual description language looks like this:
+
+	[ ] -> [ Bonn ] -> [ ]
+
+=head1 EXPORT
+
+None by default.
+
+=head1 SEE ALSO
+
+L<Graph::Easy::Node>.
+
+=head1 AUTHOR
+
+Copyright (C) 2004 - 2006 by Tels L<http://bloodgate.com>.
+
+See the LICENSE file for more details.
+
+=cut

perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Node/Cell.pm

@@ -0,0 +1,140 @@
+#############################################################################
+# (c) by Tels 2004 - 2005. An empty filler cell. Part of Graph::Easy.
+#
+#############################################################################
+
+package Graph::Easy::Node::Cell;
+
+use Graph::Easy::Node;
+
+use strict;
+use warnings;
+
+use vars qw(@ISA $VERSION);
+
+@ISA = qw/Graph::Easy::Node/;
+$VERSION = '0.76';
+
+#############################################################################
+
+sub _init
+  {
+  # generic init, override in subclasses
+  my ($self,$args) = @_;
+
+  $self->{class} = '';
+  $self->{name} = '';
+
+  $self->{'x'} = 0;
+  $self->{'y'} = 0;
+
+  # default: belongs to no node
+  $self->{node} = undef;
+
+  foreach my $k (sort keys %$args)
+    {
+    if ($k !~ /^(node|graph|x|y)\z/)
+      {
+      require Carp;
+      Carp::confess ("Invalid argument '$k' passed to Graph::Easy::Node::Cell->new()");
+      }
+    $self->{$k} = $args->{$k};
+    }
+
+  $self;
+  }
+
+sub _correct_size
+  {
+  my $self = shift;
+
+  $self->{w} = 0;
+  $self->{h} = 0;
+
+  $self;
+  }
+
+sub node
+  {
+  # return the node this cell belongs to
+  my $self = shift;
+
+  $self->{node};
+  }
+
+sub as_ascii
+  {
+  '';
+  }
+
+sub as_html
+  {
+  '';
+  }
+
+sub group
+  {
+  my $self = shift;
+
+  $self->{node}->group();
+  }
+
+1;
+__END__
+
+=head1 NAME
+
+Graph::Easy::Node::Cell - An empty filler cell
+
+=head1 SYNOPSIS
+
+        use Graph::Easy;
+        use Graph::Easy::Edge;
+
+	my $graph = Graph::Easy->new();
+
+	my $node = $graph->add_node('A');
+
+	my $path = Graph::Easy::Node::Cell->new(
+	  graph => $graph, node => $node,
+	);
+
+	...
+
+	print $graph->as_ascii();
+
+=head1 DESCRIPTION
+
+A C<Graph::Easy::Node::Cell> is used to reserve a cell in the grid for nodes
+that occupy more than one cell.
+
+You should not need to use this class directly.
+
+=head1 METHODS
+
+=head2 error()
+
+	$last_error = $cell->error();
+
+	$cvt->error($error);			# set new messages
+	$cvt->error('');			# clear error
+
+Returns the last error message, or '' for no error.
+
+=head2 node()
+
+	my $node = $cell->node();
+
+Returns the node this filler cell belongs to.
+
+=head1 SEE ALSO
+
+L<Graph::Easy>.
+
+=head1 AUTHOR
+
+Copyright (C) 2004 - 2005 by Tels L<http://bloodgate.com>.
+
+See the LICENSE file for more details.
+
+=cut

perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Node/Empty.pm

@@ -0,0 +1,69 @@
+#############################################################################
+# An empty, borderless cell. Part of Graph::Easy.
+#
+#############################################################################
+
+package Graph::Easy::Node::Empty;
+
+use Graph::Easy::Node;
+
+@ISA = qw/Graph::Easy::Node/;
+$VERSION = '0.76';
+
+use strict;
+use warnings;
+
+#############################################################################
+
+sub _init
+  {
+  # generic init, override in subclasses
+  my ($self,$args) = @_;
+
+  $self->SUPER::_init($args);
+
+  $self->{class} = 'node.empty';
+
+  $self;
+  }
+
+sub _correct_size
+  {
+  my $self = shift;
+
+  $self->{w} = 3;
+  $self->{h} = 3;
+
+  $self;
+  }
+
+1;
+__END__
+
+=head1 NAME
+
+Graph::Easy::Node::Empty - An empty, borderless cell in a node cluster
+
+=head1 SYNOPSIS
+
+	my $cell = Graph::Easy::Node::Empty->new();
+
+=head1 DESCRIPTION
+
+A C<Graph::Easy::Node::Empty> represents a borderless, empty cell in
+a node cluster. It is mainly used to have an object to render collapsed
+borders in ASCII output.
+
+You should not need to use this class directly.
+
+=head1 SEE ALSO
+
+L<Graph::Easy::Node>.
+
+=head1 AUTHOR
+
+Copyright (C) 2004 - 2007 by Tels L<http://bloodgate.com>.
+
+See the LICENSE file for more details.
+
+=cut

perl/lib/Graph-Easy-0.76/blib/lib/Graph/Easy/Util.pm

@@ -0,0 +1,51 @@
+package Graph::Easy::Util;
+
+use strict;
+use warnings;
+
+use base 'Exporter';
+
+our @EXPORT_OK = (qw(first_kv ord_values));
+
+use List::Util qw(minstr);
+
+=head1 FUNCTIONS
+
+=head2 first_kv($hash_ref)
+
+The first key value pair from a hash reference - lexicographically.
+
+=cut
+
+sub first_kv
+{
+    my $href = shift;
+
+    my $n = minstr( keys(%$href) );
+    my $v = $href->{$n};
+
+    return ($n, $v);
+}
+
+=head2 ord_values($hash_ref)
+
+The values of the hash ordered by a lexicographical keyname.
+
+=cut
+
+sub ord_values
+{
+    my $href = shift;
+
+    if ((!defined $href) || (! %$href))
+    {
+        return (wantarray ? () : 0);
+    }
+    else
+    {
+        return (wantarray ? @{$href}{sort keys( %$href )} : scalar(keys(%$href)));
+    }
+}
+
+1;
+

perl/lib/Graph-Easy-0.76/blib/script/graph-easy

@@ -0,0 +1,712 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Graph::Easy 0.63;
+use Graph::Easy::Parser;
+
+my $help_requested = 0;
+
+# echo "[A]" | graph-easy  		# should work
+# graph-easy				# need help
+$help_requested = 1 if @ARGV == 0 && -t STDIN;
+
+# list of supported output formats for external renderers like dot:
+my @external = qw/png bmp gif jpg pdf ps ps2 tif tga pcl hpgl/;
+my $external = join('|',@external);
+my $qr_ext = qr/^($external)\z/;
+
+my $OUT = \*STDERR;
+my $opt = get_options();
+
+# error?
+$help_requested = 1 if !ref($opt);
+
+# no error and --help was specified
+$help_requested = 2 if ref($opt) && $opt->{help} ne '';
+
+my $copyright = "Graph::Easy v$Graph::Easy::VERSION  (c) by Tels 2004-2008.  "
+	       ."Released under the GPL 2.0 or later.\n\n";
+
+if (ref($opt) && $opt->{version} != 0)
+  {
+  print $copyright;
+  print "Running under Perl v$]";
+  eval { require Graph::Easy::As_svg; };
+  if (defined $Graph::Easy::As_svg::VERSION)
+    {
+    print " and using Graph::Easy::As_svg v$Graph::Easy::As_svg::VERSION";
+    }
+  print ".\n\n";
+  exit 2;
+  }
+
+if ($help_requested > 0)
+  {
+  print STDERR $copyright;
+  require Pod::Usage;
+  if ($help_requested > 1 && $Pod::Usage::VERSION < 1.35)
+    {
+    # The way old Pod::Usage executes "perldoc" might fail:
+    system('perldoc', $0);
+    exit 2;
+    }
+  Pod::Usage::pod2usage( { -exitval => 2, -verbose => $help_requested } );
+  }
+
+my $verbose = $opt->{verbose};
+
+print $OUT $copyright if $verbose;
+
+#############################################################################
+# Create the parser object
+
+my $parser_class = 'Graph::Easy::Parser';
+if ($opt->{from} eq 'graphviz')
+  {
+  require Graph::Easy::Parser::Graphviz;
+  $parser_class = 'Graph::Easy::Parser::Graphviz';
+  }
+elsif ($opt->{from} =~ /^(vcg|gdl)\z/)
+  {
+  require Graph::Easy::Parser::VCG;
+  $parser_class = 'Graph::Easy::Parser::VCG';
+  }
+
+print $OUT "Creating $parser_class object.\n" if $verbose;
+
+my $parser = $parser_class->new( debug => $opt->{debug} );
+
+#############################################################################
+# parse the input file
+
+print $OUT "Parsing input in $opt->{from} from $opt->{inputname}.\n" if $verbose;
+
+my $graph = $parser->from_file($opt->{input});
+
+my $error = '';
+$error = $parser->error() if !$graph || $parser->error();
+$error = $graph->error() if $graph && $graph->error();
+
+die ($error) if $error;
+
+#############################################################################
+# If wanted, generate the statistics:
+
+if ($opt->{stats})
+  {
+  print STDERR "\nInput is a ",
+	$graph->is_simple() ? 'simple' : 'multi-edged',
+	", ",
+	$graph->is_undirected() ? 'undirected' : 'directed',
+        " graph with:\n";
+
+  my $nodes = $graph->nodes();
+  my $edges = $graph->edges();
+  my $groups = $graph->groups();
+
+  print STDERR "    $nodes node" . ($nodes != 1 ? 's' : '') .
+		 ", $edges edge"   . ($edges != 1 ? 's' : '') .
+		 " and $groups group"   . ($groups != 1 ? 's' : '') . "\n\n";
+
+  for my $g ($graph->groups())
+    {
+    my $nodes = $g->nodes();
+    my $edges = $g->edges();
+    my $groups = $g->groups();
+
+    print STDERR "  Group '$g->{name}':\n";
+    print STDERR "    $nodes node" . ($nodes != 1 ? 's' : '') .
+		 ", $edges edge"   . ($edges != 1 ? 's' : '') .
+		 " and $groups group"   . ($groups != 1 ? 's' : '') . "\n\n";
+    }
+  }
+
+#############################################################################
+# Generate the wanted output format and write it to the output:
+
+if (! $opt->{parse})
+  {
+  my $method = 'as_' . $opt->{as} . '_file';
+  if ($verbose)
+    {
+    if ($opt->{outputname} =~ /\.$external\z/)
+      {
+      print $OUT "Piping output to '$opt->{renderer} -T$opt->{ext} -o \"$opt->{outputname}\"'.\n";
+      }
+    else
+      {
+      print $OUT "Writing output as $opt->{as} to $opt->{outputname}.\n";
+      }
+    }
+
+  $graph->timeout(abs($opt->{timeout} || 240));
+  my $FILE = $opt->{output};
+  print $FILE $graph->$method();
+
+  print $OUT "Everything done. Have fun!\n\n" if $verbose;
+  }
+
+#############################################################################
+# Everything done
+
+#############################################################################
+#############################################################################
+
+sub get_options
+  {
+  # set the defaults
+  my $opt = {
+    input => undef,
+    output => undef,
+    as => '',
+    from => 'txt',
+    help => '',
+    as_ascii => '',
+    as_boxart => '',
+    as_html => '',
+    as_svg => '',
+    as_graphviz => '',
+    as_txt => '',
+    as_vcg => '',
+    as_gdl => '',
+    as_graphml => '',
+    debug => 0,
+    from_txt => '',
+    from_vcg => '',
+    from_gdl => '',
+    from_graphviz => '',
+    verbose => 0,
+    version => 0,
+    parse => 0,
+    stats => 0,
+    timeout => 240,
+    renderer => 'dot',
+  };
+  # insert the ones from @external
+  for my $e (@external) { $opt->{$e} = ''; }
+
+  # map the output format to the method to generate the output:
+  my $formats = {
+    html => 'html',
+    txt => 'ascii',
+    svg => 'svg',
+    dot => 'graphviz',
+    vcg => 'vcg',
+    gdl => 'gdl',
+    graphml => 'graphml',
+  };
+  # insert the ones from @external
+  for my $e (@external) { $formats->{$e} = 'graphviz'; }
+
+  # do we have some options?
+  if (@ARGV > 0)
+    {
+    require Getopt::Long;
+
+    my @o = (
+	"input=s" => \$opt->{input},
+	"output=s" => \$opt->{output},
+	"as=s" => \$opt->{as},
+	"from=s" => \$opt->{from},
+	"help|?" => \$opt->{help},
+	"version" => \$opt->{version},
+	"verbose" => \$opt->{verbose},
+	"debug=i" => \$opt->{debug},
+	"parse" => \$opt->{parse},
+	"as_ascii|ascii" => \$opt->{as_ascii},
+	"as_html|html" => \$opt->{as_html},
+	"as_svg|svg" => \$opt->{as_svg},
+	"as_txt|txt" => \$opt->{as_txt},
+	"as_vcg|vcg" => \$opt->{as_vcg},
+	"as_gdl|gdl" => \$opt->{as_gdl},
+	"as_graphml|graphml" => \$opt->{as_graphml},
+	"as_graphviz|graphviz|as_dot|dot" => \$opt->{as_graphviz},
+	"as_boxart|boxart" => \$opt->{as_boxart},
+	"timeout=i" => \$opt->{timeout},
+	"renderer=s" => \$opt->{renderer},
+	"stats" => \$opt->{stats},
+	"from_txt" => \$opt->{from_txt},
+	"from_vcg" => \$opt->{from_vcg},
+	"from_gdl" => \$opt->{from_gdl},
+	"from_graphviz" => \$opt->{from_graphviz},
+	);
+    # insert the ones from @external
+    for my $e (@external) { push @o, "as_$e|$e" => \$opt->{"as_$e"}; }
+
+    return unless Getopt::Long::GetOptions (@o);
+    }
+
+  # allow "as=dot" for easier usage:
+  $opt->{as} = 'graphviz' if $opt->{as} eq 'dot';
+
+  # make the renderer argument sane to avoid --renderer=';rm -fR *':
+  $opt->{renderer} =~ s/[^a-zA-Z0-9_\\\/\:\.-]//g;
+
+  # if there are arguments left, they are input and possible output
+  $opt->{input} = shift @ARGV if @ARGV;
+  $opt->{output} = shift @ARGV if @ARGV;
+
+  if (!defined $opt->{input})
+    {
+    $opt->{input} = \*STDIN;
+    $opt->{inputname} = 'STDIN';
+    }
+  else
+   {
+   $opt->{inputname} = $opt->{input};
+   }
+
+  # This code gets confused if the user specified multiple options. Not much
+  # can be done about that except whack the user with something heavy:
+  for my $format (qw/ascii boxart html svg txt graphviz vcg gdl graphml/, @external )
+    {
+    warn ("Warning: Output format '$format' overrides specified '$opt->{as}'")
+      if $opt->{"as_$format"} && $opt->{as};
+    $opt->{as} = $format if $opt->{"as_$format"};
+    delete $opt->{"as_$format"};
+    }
+
+  if ($opt->{as} =~ $qr_ext)
+    {
+    $opt->{output} = $opt->{input} unless defined $opt->{output};
+    # set some default output name, so the replace works correctly
+    $opt->{output} = 'graph.txt' if ref($opt->{input});
+    # two-step process to fix bug #37534 - overwrites input with no extension
+    # example.txt => example
+    $opt->{output} =~ s/\.(txt|dot|vcg|gdl|graphml|$external)\z//;
+    # example => example.png
+    $opt->{output} .= ".$opt->{as}";
+    }
+  if (!defined $opt->{output})
+    {
+    $opt->{outputname} = 'STDOUT';
+    $opt->{output} = \*STDOUT;
+    # default to ASCII if nothing is known
+    $opt->{as} = 'ascii' if $opt->{as} eq '';
+    }
+  else
+    {
+    my $file = $opt->{output};
+    $opt->{outputname} = $opt->{output};
+    if ($opt->{as} eq '')
+      {
+      $opt->{as} = 'ascii';		# default
+      $opt->{as} = $formats->{$1} if $file =~ /\.(html|svg|txt|dot|vcg|gdl|graphml|$external)\z/;
+      }
+    $opt->{output} = undef;
+    if ($opt->{as} !~ $qr_ext)
+      {
+      # do not clobber the output file if we cannot read the input
+      return unless ref $opt->{input} || -R $opt->{input};
+
+      open $opt->{output}, ">", $file or die ("Cannot write to $file: $!");
+      }
+    else
+      {
+      # open a pipe to dot/neato etc.
+      my $file_save = $file;
+      $file_save =~ s/["'\|;]//g;	# remove potentially unsafe characters
+      open $opt->{output}, "|$opt->{renderer} -T$opt->{as} -o \"$file_save\"" or die ("Cannot open pipe to dot: $!");
+      binmode $opt->{output}, ':utf8';
+      }
+    }
+
+  if ($opt->{as} !~ $qr_ext)
+    {
+    binmode ($opt->{output}, ':utf8') or die ("Cannot do binmode(output,':utf8')");
+    }
+  else
+    {
+    $opt->{ext} = $opt->{as};
+    $opt->{as} = 'graphviz';
+    }
+
+  # convert "from_vcg" to "from=vcg"
+  for my $format (qw/txt graphviz dot vcg gdl/)
+    {
+    $opt->{from} = $format if $opt->{"from_$format"};
+    delete $opt->{"from_$format"};
+    }
+  $opt->{from} = 'graphviz' if $opt->{from} eq 'dot';
+
+  die ("Unknown input format '$opt->{from}'")
+	unless $opt->{from} =~ /^(vcg|gdl|graphviz|txt)\z/;
+  $opt;
+  }
+
+__END__
+
+=pod
+
+=head1 NAME
+
+graph-easy - render/convert graphs in/from various formats
+
+=head1 SYNOPSIS
+
+Convert between graph formats and layout/render graphs:
+
+	graph-easy [options] [inputfile [outputfile]]
+
+	echo "[ Bonn ] - car -> [ Berlin ]" | graph-easy
+	graph-easy --input=graph.dot --as_ascii
+	graph-easy --html --output=mygraph.html graph.txt
+	graph-easy graph.txt graph.svg
+	graph-easy graph.txt --as_dot | dot -Tpng -o graph.png
+	graph-easy graph.txt --png
+	graph-easy graph.vcg --dot
+	graph-easy graph.dot --gdl
+	graph-easy graph.dot --graphml
+
+=head1 ARGUMENTS
+
+Here are the most important options, more are listed in the full
+documentation:
+
+=over 10
+
+=item --help
+
+Print the full documentation, not just this short overview.
+
+=item --input
+
+Specify the input file name. Example:
+
+    graph-easy --input=input.txt
+
+The format will be auto-detected, override it with L<--from>.
+
+=item --output
+
+Specify the output file name. Example:
+
+    graph-easy --output=output.txt input.txt
+
+=item --as
+
+Specify the output format. Example:
+
+    graph-easy --as=ascii input.txt
+
+Valid formats are:
+
+    ascii	ASCII art rendering
+    boxart	Unicode Boxart rendering
+    html	HTML
+    svg		Scalable Vector Graphics
+    graphviz    the DOT language
+    dot		alias for "graphviz"
+    txt		Graph::Easy text
+    vcg		VCG (Visualizing Compiler Graphs - a subset of GDL) text
+    gdl		GDL (Graph Description Language) text
+    graphml	GraphML
+
+In addition, the following formats are understood and piped through the program
+specified with the --renderer option (default: dot):
+
+    bmp		Windows bitmap
+    gif		GIF
+    hpgl	HP-GL/2 vector graphic
+    jpg		JPEG
+    pcl		PCL printer language
+    pdf		PDF
+    png		PNG
+    ps		Postscript
+    ps2		Postscript with PDF notations (see graphviz documentation)
+    tga		Targa bitmap
+    tif		TIFF bitmap
+
+The default format will be determined by the output filename extension,
+and is C<ascii>, if the output filename was not set.
+
+You can also use B<ONE> argument of the form C<--as_ascii> or C<--ascii>.
+
+=item --from
+
+Specify the input format. Valid formats are:
+
+    graphviz	the DOT language
+    txt		Graph::Easy text
+    vcg		VCG text
+    gdl		GDL (Graph Description Language) text
+
+If not specified, the input format is auto-detected.
+
+You can also use B<ONE> argument of the form C<--from_dot>, etc.
+
+=item --renderer
+
+The external program (default: "dot") used to render the output
+formats like C<png>, C<jpg> etc. Some choices are "neato", "twopi", "fdp" or "circo".
+
+=item --parse
+
+Input will only be parsed, without any output generation.
+Useful in combination with C<--debug=1> or C<--stats>. Example:
+
+    graph-easy input.txt --parse --debug=1
+
+=item --stats
+
+Write various statistics about the input graph to STDERR. Best used in
+combination with C<--parse>:
+
+    graph-easy input.txt --parse --stats
+
+=item --timeout
+
+Set the timeout B<in seconds> for the Graph::Easy layouter that generates
+ASCII, HTML, SVG or boxart output. If the layout does not
+finish in this time, it will be aborted. Example:
+
+    graph-easy input.txt --timeout=500
+
+Conversion to DOT, VCG/GDL, GraphML or plain text ignores the timeout.
+
+The default is 240 seconds (4 minutes).
+
+=item --verbose
+
+Write info regarding the conversion process to STDERR.
+
+=back
+
+=head1 DESCRIPTION
+
+C<graph-easy> reads a description of a graph (a connected network of
+nodes and edges, not a pie chart :-) and then converts this to the desired
+output format.
+
+By default, the input will be read from STDIN, and the output will go to
+STDOUT. The input is expected to be encoded in UTF-8, the output will
+also be UTF-8.
+
+It understands the following formats as input:
+
+    Graph::Easy	 http://bloodgate.com/perl/graph/manual/
+    DOT		 http://www.graphviz.org/
+    VCG		 http://rw4.cs.uni-sb.de/~sander/html/gsvcg1.html
+    GDL		 http://www.aisee.com/
+
+The formats are automatically detected, regardless of the input file name,
+but you can also explicitly declare your input to be in one specific
+format.
+
+The output can be a dump of the graph in one of the following formats:
+
+    Graph::Easy	 http://bloodgate.com/perl/graph/manual/
+    DOT		 http://www.graphviz.org/
+    VCG		 http://rw4.cs.uni-sb.de/~sander/html/gsvcg1.html
+    GDL		 http://www.aisee.com/
+    GraphML	 http://graphml.graphdrawing.org/
+
+In addition, C<Graph::Easy> can also create layouts of graphs in
+one of the following output formats:
+
+    HTML   SVG	 ASCII	 BOXART
+
+Note that for SVG output, you need to install the module
+L<Graph::Easy::As_svg> first.
+
+As a shortcut, you can also specify the output format as 'png', this will
+cause C<graph-easy> to pipe the input in graphviz format to the C<dot> program
+to create a PNG file in one step. The following two examples are equivalent:
+
+    graph-easy graph.txt --dot | dot -Tpng -o graph.png
+    graph-easy graph.txt --png
+
+X<svg>
+X<html>
+X<ascii>
+X<boxart>
+X<png>
+X<dot>
+X<graphviz>
+X<vcg>
+X<gdl>
+X<graph description language>
+X<unicode>
+
+=head1 OTHER ARGUMENTS
+
+C<graph-easy> supports a few more arguments in addition to the ones from above:
+
+=over 10
+
+=item --version
+
+Write version info and exit.
+
+=item --debug=N
+
+Set the debug level (1..3). Warning, this will generate huge
+amounts of hard to understand output on STDERR. Example:
+
+	graph-easy input.txt --output=test.html --debug=1
+
+=item --png, --dot, --vcg, --gdl, --txt, --ascii, --boxart, --html, --svg
+
+Given exactly one of these options, produces the desired output format.
+
+=back
+
+=head1 EXAMPLES
+
+=head2 ASCII output
+
+	echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy
+
+	+--------+  car   +-----+
+	|  Bonn  | -----> | Ulm |
+	+--------+        +-----+
+	  |
+	  | car
+	  v
+	+--------+
+	| Berlin |
+	+--------+
+
+=head2 Graphviz example output
+
+	echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy --dot
+	digraph GRAPH_0 {
+
+	  edge [ arrowhead=open ];
+	  graph [ rankdir=LR ];
+	  node [
+	    fontsize=11,
+	    fillcolor=white,
+	    style=filled,
+	    shape=box ];
+
+	  Bonn -> Ulm [ label=car ]
+	  Bonn -> Berlin [ label=car ]
+
+	}
+
+=head2 VCG example output
+
+	echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy --vcg
+	graph: {
+	  title: "Untitled graph"
+
+	  node: { title: "Berlin" }
+	  node: { title: "Bonn" }
+	  node: { title: "Ulm" }
+
+	  edge:  { label: "car" sourcename: "Bonn" targetname: "Ulm" }
+	  edge:  { label: "car" sourcename: "Bonn" targetname: "Berlin" }
+
+	}
+
+=head2 GDL example output
+
+GDL (Graph Description Language) is a superset of VCG, and thus the output will
+look almost the same as VCG:
+
+	echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy --gdl
+	graph: {
+	  title: "Untitled graph"
+
+	  node: { title: "Berlin" }
+	  node: { title: "Bonn" }
+	  node: { title: "Ulm" }
+
+	  edge:  { label: "car" source: "Bonn" target: "Ulm" }
+	  edge:  { label: "car" source: "Bonn" target: "Berlin" }
+
+	}
+
+=head2 GraphML example output
+
+GraphML is XML:
+
+	echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy --graphml
+	<?xml version="1.0" encoding="UTF-8"?>
+	<graphml xmlns="http://graphml.graphdrawing.org/xmlns"
+	    xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+	    xsi:schemaLocation="http://graphml.graphdrawing.org/xmlns
+	     http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd">
+
+	  <!-- Created by Graph::Easy v0.58 at Mon Aug 20 00:01:25 2007 -->
+
+	  <key id="d0" for="edge" attr.name="label" attr.type="string"/>
+
+	  <graph id="G" edgedefault="directed">
+	    <node id="Berlin">
+        </node>
+	    <node id="Bonn">
+        </node>
+	    <node id="Ulm">
+        </node>
+	    <edge source="Bonn" target="Berlin">
+	      <data key="d0">car</data>
+        </edge>
+	    <edge source="Bonn" target="Ulm">
+	      <data key="d0">car</data>
+        </edge>
+	  </graph>
+	<graphml>
+
+=head1 CAVEATS
+
+Please note that it is impossible to convert 100% from one format to another
+format since every graph language out there has features that are unique to
+only this language.
+
+In addition, the conversion process always converts the input first into an
+L<Graph::Easy> graph, and then to the desired output format.
+
+This means that only features and attributes that are actually valid in
+Graph::Easy are supported yet. Work in making Graph::Easy an universal
+format supporting as much as possible is still in progress.
+
+Attributes that are not yet supported natively by Graph::Easy are converted
+to custom attributes with a prefixed C<x-format->, f.i. C<x-dot->. Upon output
+to the same format, these are converted back, but conversion to a different
+format will lose these attributes.
+
+For a list of what problems still remain, please see the TODO
+file in the C<Graph::Easy> distribution on CPAN:
+
+L<http://search.cpan.org/~tels/Graph-Easy/>
+
+If you notice anything wrong, or miss attributes, please file a bug report on
+
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Graph-Easy>
+
+so we can fix it and include the missing things into Graph::Easy!
+
+X<bugreport>
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the terms of the GPL.
+
+See the LICENSE file of Graph::Easy for a copy of the GPL.
+
+This product includes color specifications and designs developed by Cynthia
+Brewer (L<http://colorbrewer.org/>). See the LICENSE file for the full license
+text that applies to these color schemes.
+X<gpl>
+X<apache-style>
+X<cynthia>
+X<brewer>
+X<colorscheme>
+X<license>
+
+=head1 AUTHOR
+
+Copyright (C) 2004 - 2008 by Tels L<http://bloodgate.com>
+
+=head1 SEE ALSO
+
+More information can be found in the online manual of Graph::Easy:
+
+L<http://bloodgate.com/perl/graph/manual/>
+
+See also: L<Graph::Easy>, L<Graph::Easy::Manual>
+
+=cut

perl/lib/Graph-Easy-0.76/blib/script/graph-easy.bat

@@ -0,0 +1,728 @@
+@rem = '--*-Perl-*--
+@echo off
+if "%OS%" == "Windows_NT" goto WinNT
+perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
+goto endofperl
+:WinNT
+perl -x -S %0 %*
+if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
+if %errorlevel% == 9009 echo You do not have Perl in your PATH.
+if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
+goto endofperl
+@rem ';
+#!/usr/bin/perl -w
+#line 15
+
+use strict;
+use Graph::Easy 0.63;
+use Graph::Easy::Parser;
+
+my $help_requested = 0;
+
+# echo "[A]" | graph-easy  		# should work
+# graph-easy				# need help
+$help_requested = 1 if @ARGV == 0 && -t STDIN;
+
+# list of supported output formats for external renderers like dot:
+my @external = qw/png bmp gif jpg pdf ps ps2 tif tga pcl hpgl/;
+my $external = join('|',@external);
+my $qr_ext = qr/^($external)\z/;
+
+my $OUT = \*STDERR;
+my $opt = get_options();
+
+# error?
+$help_requested = 1 if !ref($opt);
+
+# no error and --help was specified
+$help_requested = 2 if ref($opt) && $opt->{help} ne '';
+
+my $copyright = "Graph::Easy v$Graph::Easy::VERSION  (c) by Tels 2004-2008.  "
+	       ."Released under the GPL 2.0 or later.\n\n";
+
+if (ref($opt) && $opt->{version} != 0)
+  {
+  print $copyright;
+  print "Running under Perl v$]";
+  eval { require Graph::Easy::As_svg; };
+  if (defined $Graph::Easy::As_svg::VERSION)
+    {
+    print " and using Graph::Easy::As_svg v$Graph::Easy::As_svg::VERSION";
+    }
+  print ".\n\n";
+  exit 2;
+  }
+
+if ($help_requested > 0)
+  {
+  print STDERR $copyright;
+  require Pod::Usage;
+  if ($help_requested > 1 && $Pod::Usage::VERSION < 1.35)
+    {
+    # The way old Pod::Usage executes "perldoc" might fail:
+    system('perldoc', $0);
+    exit 2;
+    }
+  Pod::Usage::pod2usage( { -exitval => 2, -verbose => $help_requested } );
+  }
+
+my $verbose = $opt->{verbose};
+
+print $OUT $copyright if $verbose;
+
+#############################################################################
+# Create the parser object
+
+my $parser_class = 'Graph::Easy::Parser';
+if ($opt->{from} eq 'graphviz')
+  {
+  require Graph::Easy::Parser::Graphviz;
+  $parser_class = 'Graph::Easy::Parser::Graphviz';
+  }
+elsif ($opt->{from} =~ /^(vcg|gdl)\z/)
+  {
+  require Graph::Easy::Parser::VCG;
+  $parser_class = 'Graph::Easy::Parser::VCG';
+  }
+
+print $OUT "Creating $parser_class object.\n" if $verbose;
+
+my $parser = $parser_class->new( debug => $opt->{debug} );
+
+#############################################################################
+# parse the input file
+
+print $OUT "Parsing input in $opt->{from} from $opt->{inputname}.\n" if $verbose;
+
+my $graph = $parser->from_file($opt->{input});
+
+my $error = '';
+$error = $parser->error() if !$graph || $parser->error();
+$error = $graph->error() if $graph && $graph->error();
+
+die ($error) if $error;
+
+#############################################################################
+# If wanted, generate the statistics:
+
+if ($opt->{stats})
+  {
+  print STDERR "\nInput is a ",
+	$graph->is_simple() ? 'simple' : 'multi-edged',
+	", ",
+	$graph->is_undirected() ? 'undirected' : 'directed',
+        " graph with:\n";
+
+  my $nodes = $graph->nodes();
+  my $edges = $graph->edges();
+  my $groups = $graph->groups();
+
+  print STDERR "    $nodes node" . ($nodes != 1 ? 's' : '') .
+		 ", $edges edge"   . ($edges != 1 ? 's' : '') .
+		 " and $groups group"   . ($groups != 1 ? 's' : '') . "\n\n";
+
+  for my $g ($graph->groups())
+    {
+    my $nodes = $g->nodes();
+    my $edges = $g->edges();
+    my $groups = $g->groups();
+
+    print STDERR "  Group '$g->{name}':\n";
+    print STDERR "    $nodes node" . ($nodes != 1 ? 's' : '') .
+		 ", $edges edge"   . ($edges != 1 ? 's' : '') .
+		 " and $groups group"   . ($groups != 1 ? 's' : '') . "\n\n";
+    }
+  }
+
+#############################################################################
+# Generate the wanted output format and write it to the output:
+
+if (! $opt->{parse})
+  {
+  my $method = 'as_' . $opt->{as} . '_file';
+  if ($verbose)
+    {
+    if ($opt->{outputname} =~ /\.$external\z/)
+      {
+      print $OUT "Piping output to '$opt->{renderer} -T$opt->{ext} -o \"$opt->{outputname}\"'.\n";
+      }
+    else
+      {
+      print $OUT "Writing output as $opt->{as} to $opt->{outputname}.\n";
+      }
+    }
+
+  $graph->timeout(abs($opt->{timeout} || 240));
+  my $FILE = $opt->{output};
+  print $FILE $graph->$method();
+
+  print $OUT "Everything done. Have fun!\n\n" if $verbose;
+  }
+
+#############################################################################
+# Everything done
+
+#############################################################################
+#############################################################################
+
+sub get_options
+  {
+  # set the defaults
+  my $opt = {
+    input => undef,
+    output => undef,
+    as => '',
+    from => 'txt',
+    help => '',
+    as_ascii => '',
+    as_boxart => '',
+    as_html => '',
+    as_svg => '',
+    as_graphviz => '',
+    as_txt => '',
+    as_vcg => '',
+    as_gdl => '',
+    as_graphml => '',
+    debug => 0,
+    from_txt => '',
+    from_vcg => '',
+    from_gdl => '',
+    from_graphviz => '',
+    verbose => 0,
+    version => 0,
+    parse => 0,
+    stats => 0,
+    timeout => 240,
+    renderer => 'dot',
+  };
+  # insert the ones from @external
+  for my $e (@external) { $opt->{$e} = ''; }
+
+  # map the output format to the method to generate the output:
+  my $formats = {
+    html => 'html',
+    txt => 'ascii',
+    svg => 'svg',
+    dot => 'graphviz',
+    vcg => 'vcg',
+    gdl => 'gdl',
+    graphml => 'graphml',
+  };
+  # insert the ones from @external
+  for my $e (@external) { $formats->{$e} = 'graphviz'; }
+
+  # do we have some options?
+  if (@ARGV > 0)
+    {
+    require Getopt::Long;
+
+    my @o = (
+	"input=s" => \$opt->{input},
+	"output=s" => \$opt->{output},
+	"as=s" => \$opt->{as},
+	"from=s" => \$opt->{from},
+	"help|?" => \$opt->{help},
+	"version" => \$opt->{version},
+	"verbose" => \$opt->{verbose},
+	"debug=i" => \$opt->{debug},
+	"parse" => \$opt->{parse},
+	"as_ascii|ascii" => \$opt->{as_ascii},
+	"as_html|html" => \$opt->{as_html},
+	"as_svg|svg" => \$opt->{as_svg},
+	"as_txt|txt" => \$opt->{as_txt},
+	"as_vcg|vcg" => \$opt->{as_vcg},
+	"as_gdl|gdl" => \$opt->{as_gdl},
+	"as_graphml|graphml" => \$opt->{as_graphml},
+	"as_graphviz|graphviz|as_dot|dot" => \$opt->{as_graphviz},
+	"as_boxart|boxart" => \$opt->{as_boxart},
+	"timeout=i" => \$opt->{timeout},
+	"renderer=s" => \$opt->{renderer},
+	"stats" => \$opt->{stats},
+	"from_txt" => \$opt->{from_txt},
+	"from_vcg" => \$opt->{from_vcg},
+	"from_gdl" => \$opt->{from_gdl},
+	"from_graphviz" => \$opt->{from_graphviz},
+	);
+    # insert the ones from @external
+    for my $e (@external) { push @o, "as_$e|$e" => \$opt->{"as_$e"}; }
+
+    return unless Getopt::Long::GetOptions (@o);
+    }
+
+  # allow "as=dot" for easier usage:
+  $opt->{as} = 'graphviz' if $opt->{as} eq 'dot';
+
+  # make the renderer argument sane to avoid --renderer=';rm -fR *':
+  $opt->{renderer} =~ s/[^a-zA-Z0-9_\\\/\:\.-]//g;
+
+  # if there are arguments left, they are input and possible output
+  $opt->{input} = shift @ARGV if @ARGV;
+  $opt->{output} = shift @ARGV if @ARGV;
+
+  if (!defined $opt->{input})
+    {
+    $opt->{input} = \*STDIN;
+    $opt->{inputname} = 'STDIN';
+    }
+  else
+   {
+   $opt->{inputname} = $opt->{input};
+   }
+
+  # This code gets confused if the user specified multiple options. Not much
+  # can be done about that except whack the user with something heavy:
+  for my $format (qw/ascii boxart html svg txt graphviz vcg gdl graphml/, @external )
+    {
+    warn ("Warning: Output format '$format' overrides specified '$opt->{as}'")
+      if $opt->{"as_$format"} && $opt->{as};
+    $opt->{as} = $format if $opt->{"as_$format"};
+    delete $opt->{"as_$format"};
+    }
+
+  if ($opt->{as} =~ $qr_ext)
+    {
+    $opt->{output} = $opt->{input} unless defined $opt->{output};
+    # set some default output name, so the replace works correctly
+    $opt->{output} = 'graph.txt' if ref($opt->{input});
+    # two-step process to fix bug #37534 - overwrites input with no extension
+    # example.txt => example
+    $opt->{output} =~ s/\.(txt|dot|vcg|gdl|graphml|$external)\z//;
+    # example => example.png
+    $opt->{output} .= ".$opt->{as}";
+    }
+  if (!defined $opt->{output})
+    {
+    $opt->{outputname} = 'STDOUT';
+    $opt->{output} = \*STDOUT;
+    # default to ASCII if nothing is known
+    $opt->{as} = 'ascii' if $opt->{as} eq '';
+    }
+  else
+    {
+    my $file = $opt->{output};
+    $opt->{outputname} = $opt->{output};
+    if ($opt->{as} eq '')
+      {
+      $opt->{as} = 'ascii';		# default
+      $opt->{as} = $formats->{$1} if $file =~ /\.(html|svg|txt|dot|vcg|gdl|graphml|$external)\z/;
+      }
+    $opt->{output} = undef;
+    if ($opt->{as} !~ $qr_ext)
+      {
+      # do not clobber the output file if we cannot read the input
+      return unless ref $opt->{input} || -R $opt->{input};
+
+      open $opt->{output}, ">", $file or die ("Cannot write to $file: $!");
+      }
+    else
+      {
+      # open a pipe to dot/neato etc.
+      my $file_save = $file;
+      $file_save =~ s/["'\|;]//g;	# remove potentially unsafe characters
+      open $opt->{output}, "|$opt->{renderer} -T$opt->{as} -o \"$file_save\"" or die ("Cannot open pipe to dot: $!");
+      binmode $opt->{output}, ':utf8';
+      }
+    }
+
+  if ($opt->{as} !~ $qr_ext)
+    {
+    binmode ($opt->{output}, ':utf8') or die ("Cannot do binmode(output,':utf8')");
+    }
+  else
+    {
+    $opt->{ext} = $opt->{as};
+    $opt->{as} = 'graphviz';
+    }
+
+  # convert "from_vcg" to "from=vcg"
+  for my $format (qw/txt graphviz dot vcg gdl/)
+    {
+    $opt->{from} = $format if $opt->{"from_$format"};
+    delete $opt->{"from_$format"};
+    }
+  $opt->{from} = 'graphviz' if $opt->{from} eq 'dot';
+
+  die ("Unknown input format '$opt->{from}'")
+	unless $opt->{from} =~ /^(vcg|gdl|graphviz|txt)\z/;
+  $opt;
+  }
+
+__END__
+
+=pod
+
+=head1 NAME
+
+graph-easy - render/convert graphs in/from various formats
+
+=head1 SYNOPSIS
+
+Convert between graph formats and layout/render graphs:
+
+	graph-easy [options] [inputfile [outputfile]]
+
+	echo "[ Bonn ] - car -> [ Berlin ]" | graph-easy
+	graph-easy --input=graph.dot --as_ascii
+	graph-easy --html --output=mygraph.html graph.txt
+	graph-easy graph.txt graph.svg
+	graph-easy graph.txt --as_dot | dot -Tpng -o graph.png
+	graph-easy graph.txt --png
+	graph-easy graph.vcg --dot
+	graph-easy graph.dot --gdl
+	graph-easy graph.dot --graphml
+
+=head1 ARGUMENTS
+
+Here are the most important options, more are listed in the full
+documentation:
+
+=over 10
+
+=item --help
+
+Print the full documentation, not just this short overview.
+
+=item --input
+
+Specify the input file name. Example:
+
+    graph-easy --input=input.txt
+
+The format will be auto-detected, override it with L<--from>.
+
+=item --output
+
+Specify the output file name. Example:
+
+    graph-easy --output=output.txt input.txt
+
+=item --as
+
+Specify the output format. Example:
+
+    graph-easy --as=ascii input.txt
+
+Valid formats are:
+
+    ascii	ASCII art rendering
+    boxart	Unicode Boxart rendering
+    html	HTML
+    svg		Scalable Vector Graphics
+    graphviz    the DOT language
+    dot		alias for "graphviz"
+    txt		Graph::Easy text
+    vcg		VCG (Visualizing Compiler Graphs - a subset of GDL) text
+    gdl		GDL (Graph Description Language) text
+    graphml	GraphML
+
+In addition, the following formats are understood and piped through the program
+specified with the --renderer option (default: dot):
+
+    bmp		Windows bitmap
+    gif		GIF
+    hpgl	HP-GL/2 vector graphic
+    jpg		JPEG
+    pcl		PCL printer language
+    pdf		PDF
+    png		PNG
+    ps		Postscript
+    ps2		Postscript with PDF notations (see graphviz documentation)
+    tga		Targa bitmap
+    tif		TIFF bitmap
+
+The default format will be determined by the output filename extension,
+and is C<ascii>, if the output filename was not set.
+
+You can also use B<ONE> argument of the form C<--as_ascii> or C<--ascii>.
+
+=item --from
+
+Specify the input format. Valid formats are:
+
+    graphviz	the DOT language
+    txt		Graph::Easy text
+    vcg		VCG text
+    gdl		GDL (Graph Description Language) text
+
+If not specified, the input format is auto-detected.
+
+You can also use B<ONE> argument of the form C<--from_dot>, etc.
+
+=item --renderer
+
+The external program (default: "dot") used to render the output
+formats like C<png>, C<jpg> etc. Some choices are "neato", "twopi", "fdp" or "circo".
+
+=item --parse
+
+Input will only be parsed, without any output generation.
+Useful in combination with C<--debug=1> or C<--stats>. Example:
+
+    graph-easy input.txt --parse --debug=1
+
+=item --stats
+
+Write various statistics about the input graph to STDERR. Best used in
+combination with C<--parse>:
+
+    graph-easy input.txt --parse --stats
+
+=item --timeout
+
+Set the timeout B<in seconds> for the Graph::Easy layouter that generates
+ASCII, HTML, SVG or boxart output. If the layout does not
+finish in this time, it will be aborted. Example:
+
+    graph-easy input.txt --timeout=500
+
+Conversion to DOT, VCG/GDL, GraphML or plain text ignores the timeout.
+
+The default is 240 seconds (4 minutes).
+
+=item --verbose
+
+Write info regarding the conversion process to STDERR.
+
+=back
+
+=head1 DESCRIPTION
+
+C<graph-easy> reads a description of a graph (a connected network of
+nodes and edges, not a pie chart :-) and then converts this to the desired
+output format.
+
+By default, the input will be read from STDIN, and the output will go to
+STDOUT. The input is expected to be encoded in UTF-8, the output will
+also be UTF-8.
+
+It understands the following formats as input:
+
+    Graph::Easy	 http://bloodgate.com/perl/graph/manual/
+    DOT		 http://www.graphviz.org/
+    VCG		 http://rw4.cs.uni-sb.de/~sander/html/gsvcg1.html
+    GDL		 http://www.aisee.com/
+
+The formats are automatically detected, regardless of the input file name,
+but you can also explicitly declare your input to be in one specific
+format.
+
+The output can be a dump of the graph in one of the following formats:
+
+    Graph::Easy	 http://bloodgate.com/perl/graph/manual/
+    DOT		 http://www.graphviz.org/
+    VCG		 http://rw4.cs.uni-sb.de/~sander/html/gsvcg1.html
+    GDL		 http://www.aisee.com/
+    GraphML	 http://graphml.graphdrawing.org/
+
+In addition, C<Graph::Easy> can also create layouts of graphs in
+one of the following output formats:
+
+    HTML   SVG	 ASCII	 BOXART
+
+Note that for SVG output, you need to install the module
+L<Graph::Easy::As_svg> first.
+
+As a shortcut, you can also specify the output format as 'png', this will
+cause C<graph-easy> to pipe the input in graphviz format to the C<dot> program
+to create a PNG file in one step. The following two examples are equivalent:
+
+    graph-easy graph.txt --dot | dot -Tpng -o graph.png
+    graph-easy graph.txt --png
+
+X<svg>
+X<html>
+X<ascii>
+X<boxart>
+X<png>
+X<dot>
+X<graphviz>
+X<vcg>
+X<gdl>
+X<graph description language>
+X<unicode>
+
+=head1 OTHER ARGUMENTS
+
+C<graph-easy> supports a few more arguments in addition to the ones from above:
+
+=over 10
+
+=item --version
+
+Write version info and exit.
+
+=item --debug=N
+
+Set the debug level (1..3). Warning, this will generate huge
+amounts of hard to understand output on STDERR. Example:
+
+	graph-easy input.txt --output=test.html --debug=1
+
+=item --png, --dot, --vcg, --gdl, --txt, --ascii, --boxart, --html, --svg
+
+Given exactly one of these options, produces the desired output format.
+
+=back
+
+=head1 EXAMPLES
+
+=head2 ASCII output
+
+	echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy
+
+	+--------+  car   +-----+
+	|  Bonn  | -----> | Ulm |
+	+--------+        +-----+
+	  |
+	  | car
+	  v
+	+--------+
+	| Berlin |
+	+--------+
+
+=head2 Graphviz example output
+
+	echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy --dot
+	digraph GRAPH_0 {
+
+	  edge [ arrowhead=open ];
+	  graph [ rankdir=LR ];
+	  node [
+	    fontsize=11,
+	    fillcolor=white,
+	    style=filled,
+	    shape=box ];
+
+	  Bonn -> Ulm [ label=car ]
+	  Bonn -> Berlin [ label=car ]
+
+	}
+
+=head2 VCG example output
+
+	echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy --vcg
+	graph: {
+	  title: "Untitled graph"
+
+	  node: { title: "Berlin" }
+	  node: { title: "Bonn" }
+	  node: { title: "Ulm" }
+
+	  edge:  { label: "car" sourcename: "Bonn" targetname: "Ulm" }
+	  edge:  { label: "car" sourcename: "Bonn" targetname: "Berlin" }
+
+	}
+
+=head2 GDL example output
+
+GDL (Graph Description Language) is a superset of VCG, and thus the output will
+look almost the same as VCG:
+
+	echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy --gdl
+	graph: {
+	  title: "Untitled graph"
+
+	  node: { title: "Berlin" }
+	  node: { title: "Bonn" }
+	  node: { title: "Ulm" }
+
+	  edge:  { label: "car" source: "Bonn" target: "Ulm" }
+	  edge:  { label: "car" source: "Bonn" target: "Berlin" }
+
+	}
+
+=head2 GraphML example output
+
+GraphML is XML:
+
+	echo "[ Bonn ] -- car --> [ Berlin ], [ Ulm ]" | graph-easy --graphml
+	<?xml version="1.0" encoding="UTF-8"?>
+	<graphml xmlns="http://graphml.graphdrawing.org/xmlns"
+	    xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+	    xsi:schemaLocation="http://graphml.graphdrawing.org/xmlns
+	     http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd">
+
+	  <!-- Created by Graph::Easy v0.58 at Mon Aug 20 00:01:25 2007 -->
+
+	  <key id="d0" for="edge" attr.name="label" attr.type="string"/>
+
+	  <graph id="G" edgedefault="directed">
+	    <node id="Berlin">
+        </node>
+	    <node id="Bonn">
+        </node>
+	    <node id="Ulm">
+        </node>
+	    <edge source="Bonn" target="Berlin">
+	      <data key="d0">car</data>
+        </edge>
+	    <edge source="Bonn" target="Ulm">
+	      <data key="d0">car</data>
+        </edge>
+	  </graph>
+	<graphml>
+
+=head1 CAVEATS
+
+Please note that it is impossible to convert 100% from one format to another
+format since every graph language out there has features that are unique to
+only this language.
+
+In addition, the conversion process always converts the input first into an
+L<Graph::Easy> graph, and then to the desired output format.
+
+This means that only features and attributes that are actually valid in
+Graph::Easy are supported yet. Work in making Graph::Easy an universal
+format supporting as much as possible is still in progress.
+
+Attributes that are not yet supported natively by Graph::Easy are converted
+to custom attributes with a prefixed C<x-format->, f.i. C<x-dot->. Upon output
+to the same format, these are converted back, but conversion to a different
+format will lose these attributes.
+
+For a list of what problems still remain, please see the TODO
+file in the C<Graph::Easy> distribution on CPAN:
+
+L<http://search.cpan.org/~tels/Graph-Easy/>
+
+If you notice anything wrong, or miss attributes, please file a bug report on
+
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Graph-Easy>
+
+so we can fix it and include the missing things into Graph::Easy!
+
+X<bugreport>
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the terms of the GPL.
+
+See the LICENSE file of Graph::Easy for a copy of the GPL.
+
+This product includes color specifications and designs developed by Cynthia
+Brewer (L<http://colorbrewer.org/>). See the LICENSE file for the full license
+text that applies to these color schemes.
+X<gpl>
+X<apache-style>
+X<cynthia>
+X<brewer>
+X<colorscheme>
+X<license>
+
+=head1 AUTHOR
+
+Copyright (C) 2004 - 2008 by Tels L<http://bloodgate.com>
+
+=head1 SEE ALSO
+
+More information can be found in the online manual of Graph::Easy:
+
+L<http://bloodgate.com/perl/graph/manual/>
+
+See also: L<Graph::Easy>, L<Graph::Easy::Manual>
+
+=cut
+
+__END__
+:endofperl