1############################################################################
2# Manage, and layout graphs on a flat plane.
3#
4#############################################################################
5
6package Graph::Easy;
7
8use 5.008002;
9use Graph::Easy::Base;
10use Graph::Easy::Attributes;
11use Graph::Easy::Edge;
12use Graph::Easy::Group;
13use Graph::Easy::Group::Anon;
14use Graph::Easy::Layout;
15use Graph::Easy::Node;
16use Graph::Easy::Node::Anon;
17use Graph::Easy::Node::Empty;
18use Scalar::Util qw/weaken/;
19
20$VERSION = '0.76';
21@ISA = qw/Graph::Easy::Base/;
22
23use strict;
24use warnings;
25my $att_aliases;
26
27use Graph::Easy::Util qw(ord_values);
28
29BEGIN
30  {
31  # a few aliases for backwards compatibility
32  *get_attribute = \&attribute;
33  *as_html_page = \&as_html_file;
34  *as_graphviz_file = \&as_graphviz;
35  *as_ascii_file = \&as_ascii;
36  *as_boxart_file = \&as_boxart;
37  *as_txt_file = \&as_txt;
38  *as_vcg_file = \&as_vcg;
39  *as_gdl_file = \&as_gdl;
40  *as_graphml_file = \&as_graphml;
41
42  # a few aliases for code re-use
43  *_aligned_label = \&Graph::Easy::Node::_aligned_label;
44  *quoted_comment = \&Graph::Easy::Node::quoted_comment;
45  *_un_escape = \&Graph::Easy::Node::_un_escape;
46  *_convert_pod = \&Graph::Easy::Node::_convert_pod;
47  *_label_as_html = \&Graph::Easy::Node::_label_as_html;
48  *_wrapped_label = \&Graph::Easy::Node::_wrapped_label;
49  *get_color_attribute = \&color_attribute;
50  *get_custom_attributes = \&Graph::Easy::Node::get_custom_attributes;
51  *custom_attributes = \&Graph::Easy::Node::get_custom_attributes;
52  $att_aliases = Graph::Easy::_att_aliases();
53
54  # backwards compatibility
55  *is_simple_graph = \&is_simple;
56
57  # compatibility to Graph
58  *vertices = \&nodes;
59  }
60
61#############################################################################
62
63sub new
64  {
65  # override new() as to not set the {id}
66  my $class = shift;
67
68  # called like "new->('[A]->[B]')":
69  if (@_ == 1 && !ref($_[0]))
70    {
71    require Graph::Easy::Parser;
72    my $parser = Graph::Easy::Parser->new();
73    my $self = eval { $parser->from_text($_[0]); };
74    if (!defined $self)
75      {
76      $self = Graph::Easy->new( fatal_errors => 0 );
77      $self->error( 'Error: ' . $parser->error() ||
78        'Unknown error while parsing initial text' );
79      $self->catch_errors( 0 );
80      }
81    return $self;
82    }
83
84  my $self = bless {}, $class;
85
86  my $args = $_[0];
87  $args = { @_ } if ref($args) ne 'HASH';
88
89  $self->_init($args);
90  }
91
92sub DESTROY
93  {
94  my $self = shift;
95
96  # Be careful to not delete ->{graph}, these will be cleaned out by
97  # Perl automatically in O(1) time, manual delete is O(N) instead.
98
99  delete $self->{chains};
100  # clean out pointers in child-objects so that they can safely be reused
101  for my $n (ord_values ( $self->{nodes} ))
102    {
103    if (ref($n))
104      {
105      delete $n->{edges};
106      delete $n->{group};
107      }
108    }
109  for my $e (ord_values ( $self->{edges} ))
110    {
111    if (ref($e))
112      {
113      delete $e->{cells};
114      delete $e->{to};
115      delete $e->{from};
116      }
117    }
118  for my $g (ord_values ( $self->{groups} ))
119    {
120    if (ref($g))
121      {
122      delete $g->{nodes};
123      delete $g->{edges};
124      }
125    }
126  }
127
128# Attribute overlay for HTML output:
129
130my $html_att = {
131  node => {
132    borderstyle => 'solid',
133    borderwidth => '1px',
134    bordercolor => '#000000',
135    align => 'center',
136    padding => '0.2em',
137    'padding-left' => '0.3em',
138    'padding-right' => '0.3em',
139    margin => '0.1em',
140    fill => 'white',
141    },
142  'node.anon' => {
143    'borderstyle' => 'none',
144    # ' inherit' to protect the value from being replaced by the one from "node"
145    'background' => ' inherit',
146    },
147  graph => {
148    margin => '0.5em',
149    padding => '0.5em',
150    'empty-cells' => 'show',
151    },
152  edge => {
153    border => 'none',
154    padding => '0.2em',
155    margin => '0.1em',
156    'font' => 'monospaced, courier-new, courier, sans-serif',
157    'vertical-align' => 'bottom',
158    },
159  group => {
160    'borderstyle' => 'dashed',
161    'borderwidth' => '1',
162    'fontsize' => '0.8em',
163    fill => '#a0d0ff',
164    padding => '0.2em',
165# XXX TODO:
166# in HTML, align left is default, so we could omit this:
167    align => 'left',
168    },
169  'group.anon' => {
170    'borderstyle' => 'none',
171    background => 'white',
172    },
173  };
174
175
176sub _init
177  {
178  my ($self,$args) = @_;
179
180  $self->{debug} = 0;
181  $self->{timeout} = 5;			# in seconds
182  $self->{strict} = 1;			# check attributes strict?
183
184  $self->{class} = 'graph';
185  $self->{id} = '';
186  $self->{groups} = {};
187
188  # node objects, indexed by their unique name
189  $self->{nodes} = {};
190  # edge objects, indexed by unique ID
191  $self->{edges} = {};
192
193  $self->{output_format} = 'html';
194
195  $self->{_astar_bias} = 0.001;
196
197  # default classes to use in add_foo() methods
198  $self->{use_class} = {
199    edge => 'Graph::Easy::Edge',
200    group => 'Graph::Easy::Group',
201    node => 'Graph::Easy::Node',
202  };
203
204  # Graph::Easy will die, Graph::Easy::Parser::Graphviz will warn
205  $self->{_warn_on_unknown_attributes} = 0;
206  $self->{fatal_errors} = 1;
207
208  # The attributes of the graph itself, _and_ the class/subclass attributes.
209  # These can share a hash, because:
210  # *  {att}->{graph} contains both the graph attributes and the class, since
211  #    these are synonymous, it is not possible to have more than one graph.
212  # *  'node', 'group', 'edge' are not valid attributes for a graph, so
213  #    setting "graph { node: 1; }" is not possible and can thus not overwrite
214  #    the entries from att->{node}.
215  # *  likewise for "node.subclass", attribute names never have a "." in them
216  $self->{att} = {};
217
218  foreach my $k (sort keys %$args)
219    {
220    if ($k !~ /^(timeout|debug|strict|fatal_errors|undirected)\z/)
221      {
222      $self->error ("Unknown option '$k'");
223      }
224    if ($k eq 'undirected' && $args->{$k})
225      {
226      $self->set_attribute('type', 'undirected'); next;
227      }
228    $self->{$k} = $args->{$k};
229    }
230
231  binmode(STDERR,'utf8') or die ("Cannot do binmode(STDERR,'utf8'")
232    if $self->{debug};
233
234  $self->{score} = undef;
235
236  $self->randomize();
237
238  $self;
239  }
240
241#############################################################################
242# accessors
243
244sub timeout
245  {
246  my $self = shift;
247
248  $self->{timeout} = $_[0] if @_;
249  $self->{timeout};
250  }
251
252sub debug
253  {
254  my $self = shift;
255
256  $self->{debug} = $_[0] if @_;
257  $self->{debug};
258  }
259
260sub strict
261  {
262  my $self = shift;
263
264  $self->{strict} = $_[0] if @_;
265  $self->{strict};
266  }
267
268sub type
269  {
270  # return the type of the graph, "undirected" or "directed"
271  my $self = shift;
272
273  $self->{att}->{type} || 'directed';
274  }
275
276sub is_simple
277  {
278  # return true if the graph does not have multiedges
279  my $self = shift;
280
281  my %count;
282  for my $e (ord_values ( $self->{edges} ))
283    {
284    my $id = "$e->{to}->{id},$e->{from}->{id}";
285    return 0 if exists $count{$id};
286    $count{$id} = undef;
287    }
288
289  1;					# found none
290  }
291
292sub is_directed
293  {
294  # return true if the graph is directed
295  my $self = shift;
296
297  $self->attribute('type') eq 'directed' ? 1 : 0;
298  }
299
300sub is_undirected
301  {
302  # return true if the graph is undirected
303  my $self = shift;
304
305  $self->attribute('type') eq 'undirected' ? 1 : 0;
306  }
307
308sub id
309  {
310  my $self = shift;
311
312  $self->{id} = shift if defined $_[0];
313  $self->{id};
314  }
315
316sub score
317  {
318  my $self = shift;
319
320  $self->{score};
321  }
322
323sub randomize
324  {
325  my $self = shift;
326
327  srand();
328  $self->{seed} = rand(2 ** 31);
329
330  $self->{seed};
331  }
332
333sub root_node
334  {
335  # Return the root node
336  my $self = shift;
337
338  my $root = $self->{att}->{root};
339  $root = $self->{nodes}->{$root} if defined $root;
340
341  $root;
342  }
343
344sub source_nodes
345  {
346  # return nodes with only outgoing edges
347  my $self = shift;
348
349  my @roots;
350  for my $node (ord_values ( $self->{nodes} ))
351    {
352    push @roots, $node
353      if (keys %{$node->{edges}} != 0) && !$node->has_predecessors();
354    }
355  @roots;
356  }
357
358sub predecessorless_nodes
359  {
360  # return nodes with no incoming (but maybe outgoing) edges
361  my $self = shift;
362
363  my @roots;
364  for my $node (ord_values ( $self->{nodes} ))
365    {
366    push @roots, $node
367      if (keys %{$node->{edges}} == 0) || !$node->has_predecessors();
368    }
369  @roots;
370  }
371
372sub label
373  {
374  my $self = shift;
375
376  my $label = $self->{att}->{graph}->{label}; $label = '' unless defined $label;
377  $label = $self->_un_escape($label) if !$_[0] && $label =~ /\\[EGHNT]/;
378  $label;
379  }
380
381sub link
382  {
383  # return the link, build from linkbase and link (or autolink)
384  my $self = shift;
385
386  my $link = $self->attribute('link');
387  my $autolink = ''; $autolink = $self->attribute('autolink') if $link eq '';
388  if ($link eq '' && $autolink ne '')
389    {
390    $link = $self->{name} if $autolink eq 'name';
391    # defined to avoid overriding "name" with the non-existent label attribute
392    $link = $self->{att}->{label} if $autolink eq 'label' && defined $self->{att}->{label};
393    $link = $self->{name} if $autolink eq 'label' && !defined $self->{att}->{label};
394    }
395  $link = '' unless defined $link;
396
397  # prepend base only if link is relative
398  if ($link ne '' && $link !~ /^([\w]{3,4}:\/\/|\/)/)
399    {
400    $link = $self->attribute('linkbase') . $link;
401    }
402
403  $link = $self->_un_escape($link) if !$_[0] && $link =~ /\\[EGHNT]/;
404
405  $link;
406  }
407
408sub parent
409  {
410  # return parent object, for graphs that is undef
411  undef;
412  }
413
414sub seed
415  {
416  my $self = shift;
417
418  $self->{seed} = $_[0] if @_ > 0;
419
420  $self->{seed};
421  }
422
423sub nodes
424  {
425  # return all nodes as objects, in scalar context their count
426  my ($self) = @_;
427
428  my $n = $self->{nodes};
429
430  return scalar keys %$n unless wantarray;	# shortcut
431
432  return ord_values ( $n );
433  }
434
435sub anon_nodes
436  {
437  # return all anon nodes as objects
438  my ($self) = @_;
439
440  my $n = $self->{nodes};
441
442  if (!wantarray)
443    {
444    my $count = 0;
445    for my $node (ord_values ($n))
446      {
447      $count++ if $node->is_anon();
448      }
449    return $count;
450    }
451
452  my @anon = ();
453  for my $node (ord_values ( $n))
454    {
455    push @anon, $node if $node->is_anon();
456    }
457  @anon;
458  }
459
460sub edges
461  {
462  # Return all the edges this graph contains as objects
463  my ($self) = @_;
464
465  my $e = $self->{edges};
466
467  return scalar keys %$e unless wantarray;	# shortcut
468
469  ord_values ($e);
470  }
471
472sub edges_within
473  {
474  # return all the edges as objects
475  my ($self) = @_;
476
477  my $e = $self->{edges};
478
479  return scalar keys %$e unless wantarray;	# shortcut
480
481  ord_values ($e);
482  }
483
484sub sorted_nodes
485  {
486  # return all nodes as objects, sorted by $f1 or $f1 and $f2
487  my ($self, $f1, $f2) = @_;
488
489  return scalar keys %{$self->{nodes}} unless wantarray;	# shortcut
490
491  $f1 = 'id' unless defined $f1;
492  # sorting on a non-unique field alone will result in unpredictable
493  # sorting order due to hashing
494  $f2 = 'name' if !defined $f2 && $f1 !~ /^(name|id)$/;
495
496  my $sort;
497  $sort = sub { $a->{$f1} <=> $b->{$f1} } if $f1;
498  $sort = sub { abs($a->{$f1}) <=> abs($b->{$f1}) } if $f1 && $f1 eq 'rank';
499  $sort = sub { $a->{$f1} cmp $b->{$f1} } if $f1 && $f1 =~ /^(name|title|label)$/;
500  $sort = sub { $a->{$f1} <=> $b->{$f1} || $a->{$f2} <=> $b->{$f2} } if $f2;
501  $sort = sub { abs($a->{$f1}) <=> abs($b->{$f1}) || $a->{$f2} <=> $b->{$f2} } if $f2 && $f1 eq 'rank';
502  $sort = sub { $a->{$f1} <=> $b->{$f1} || abs($a->{$f2}) <=> abs($b->{$f2}) } if $f2 && $f2 eq 'rank';
503  $sort = sub { $a->{$f1} <=> $b->{$f1} || $a->{$f2} cmp $b->{$f2} } if $f2 &&
504           $f2 =~ /^(name|title|label)$/;
505  $sort = sub { abs($a->{$f1}) <=> abs($b->{$f1}) || $a->{$f2} cmp $b->{$f2} } if
506           $f1 && $f1 eq 'rank' &&
507           $f2 && $f2 =~ /^(name|title|label)$/;
508  # 'name', 'id'
509  $sort = sub { $a->{$f1} cmp $b->{$f1} || $a->{$f2} <=> $b->{$f2} } if $f2 &&
510           $f2 eq 'id' && $f1 ne 'rank';
511
512  # the 'return' here should not be removed
513  return sort $sort values %{$self->{nodes}};
514  }
515
516sub add_edge_once
517  {
518  # add an edge, unless it already exists. In that case it returns undef
519  my ($self, $x, $y, $edge) = @_;
520
521  # got an edge object? Don't add it twice!
522  return undef if ref($edge);
523
524  # turn plaintext scalars into objects
525  my $x1 = $self->{nodes}->{$x} unless ref $x;
526  my $y1 = $self->{nodes}->{$y} unless ref $y;
527
528  # nodes do exist => maybe the edge also exists
529  if (ref($x1) && ref($y1))
530    {
531    my @ids = $x1->edges_to($y1);
532
533    return undef if @ids;	# found already one edge?
534    }
535
536  $self->add_edge($x,$y,$edge);
537  }
538
539sub edge
540  {
541  # return an edge between two nodes as object
542  my ($self, $x, $y) = @_;
543
544  # turn plaintext scalars into objects
545  $x = $self->{nodes}->{$x} unless ref $x;
546  $y = $self->{nodes}->{$y} unless ref $y;
547
548  # node does not exist => edge does not exist
549  return undef unless ref($x) && ref($y);
550
551  my @ids = $x->edges_to($y);
552
553  wantarray ? @ids : $ids[0];
554  }
555
556sub flip_edges
557  {
558  # turn all edges going from $x to $y around
559  my ($self, $x, $y) = @_;
560
561  # turn plaintext scalars into objects
562  $x = $self->{nodes}->{$x} unless ref $x;
563  $y = $self->{nodes}->{$y} unless ref $y;
564
565  # node does not exist => edge does not exist
566  # if $x == $y, return early (no need to turn selfloops)
567
568  return $self unless ref($x) && ref($y) && ($x != $y);
569
570  for my $e (ord_values ( $x->{edges} ))
571    {
572    $e->flip() if $e->{from} == $x && $e->{to} == $y;
573    }
574
575  $self;
576  }
577
578sub node
579  {
580  # return node by name
581  my ($self,$name) = @_;
582  $name = '' unless defined $name;
583
584  $self->{nodes}->{$name};
585  }
586
587sub rename_node
588  {
589  # change the name of a node
590  my ($self, $node, $new_name) = @_;
591
592  $node = $self->{nodes}->{$node} unless ref($node);
593
594  if (!ref($node))
595    {
596    $node = $self->add_node($new_name);
597    }
598  else
599    {
600    if (!ref($node->{graph}))
601      {
602      # add node to ourself
603      $node->{name} = $new_name;
604      $self->add_node($node);
605      }
606    else
607      {
608      if ($node->{graph} != $self)
609        {
610	$node->{graph}->del_node($node);
611	$node->{name} = $new_name;
612	$self->add_node($node);
613	}
614      else
615	{
616	delete $self->{nodes}->{$node->{name}};
617	$node->{name} = $new_name;
618	$self->{nodes}->{$node->{name}} = $node;
619	}
620      }
621    }
622  if ($node->is_anon())
623    {
624    # turn anon nodes into a normal node (since it got a new name):
625    bless $node, $self->{use_class}->{node} || 'Graph::Easy::Node';
626    delete $node->{att}->{label} if $node->{att}->{label} eq ' ';
627    $node->{class} = 'group';
628    }
629  $node;
630  }
631
632sub rename_group
633  {
634  # change the name of a group
635  my ($self, $group, $new_name) = @_;
636
637  if (!ref($group))
638    {
639    $group = $self->add_group($new_name);
640    }
641  else
642    {
643    if (!ref($group->{graph}))
644      {
645      # add node to ourself
646      $group->{name} = $new_name;
647      $self->add_group($group);
648      }
649    else
650      {
651      if ($group->{graph} != $self)
652        {
653	$group->{graph}->del_group($group);
654	$group->{name} = $new_name;
655	$self->add_group($group);
656	}
657      else
658	{
659	delete $self->{groups}->{$group->{name}};
660	$group->{name} = $new_name;
661	$self->{groups}->{$group->{name}} = $group;
662	}
663      }
664    }
665  if ($group->is_anon())
666    {
667    # turn anon groups into a normal group (since it got a new name):
668    bless $group, $self->{use_class}->{group} || 'Graph::Easy::Group';
669    delete $group->{att}->{label} if $group->{att}->{label} eq '';
670    $group->{class} = 'group';
671    }
672  $group;
673  }
674
675#############################################################################
676# attribute handling
677
678sub _check_class
679  {
680  # Check the given class ("graph", "node.foo" etc.) or class selector
681  # (".foo") for being valid, and return a list of base classes this applies
682  # to. Handles also a list of class selectors like ".foo, .bar, node.foo".
683  my ($self, $selector) = @_;
684
685  my @parts = split /\s*,\s*/, $selector;
686
687  my @classes = ();
688  for my $class (@parts)
689    {
690    # allowed classes, subclasses (except "graph."), selectors (excpet ".")
691    return unless $class =~ /^(\.\w|node|group|edge|graph\z)/;
692    # "node." is invalid, too
693    return if $class =~ /\.\z/;
694
695    # run a loop over all classes: "node.foo" => ("node"), ".foo" => ("node","edge","group")
696    $class =~ /^(\w*)/;
697    my $base_class = $1;
698    if ($base_class eq '')
699      {
700      push @classes, ('edge'.$class, 'group'.$class, 'node'.$class);
701      }
702    else
703      {
704      push @classes, $class;
705      }
706    } # end for all parts
707
708  @classes;
709  }
710
711sub set_attribute
712  {
713  my ($self, $class_selector, $name, $val) = @_;
714
715  # allow calling in the style of $graph->set_attribute($name,$val);
716  if (@_ == 3)
717    {
718    $val = $name;
719    $name = $class_selector;
720    $class_selector = 'graph';
721    }
722
723  # font-size => fontsize
724  $name = $att_aliases->{$name} if exists $att_aliases->{$name};
725
726  $name = 'undef' unless defined $name;
727  $val = 'undef' unless defined $val;
728
729  my @classes = $self->_check_class($class_selector);
730
731  return $self->error ("Illegal class '$class_selector' when trying to set attribute '$name' to '$val'")
732    if @classes == 0;
733
734  for my $class (@classes)
735    {
736    $val = $self->unquote_attribute($class,$name,$val);
737
738    if ($self->{strict})
739      {
740      my ($rc, $newname, $v) = $self->validate_attribute($name,$val,$class);
741      return if defined $rc;		# error?
742
743      $val = $v;
744      }
745
746    $self->{score} = undef;	# invalidate layout to force a new layout
747    delete $self->{cache};	# setting a class or flow must invalidate the cache
748
749    # handle special attribute 'gid' like in "graph { gid: 123; }"
750    if ($class eq 'graph')
751      {
752      if ($name =~ /^g?id\z/)
753        {
754        $self->{id} = $val;
755        }
756      # handle special attribute 'output' like in "graph { output: ascii; }"
757      if ($name eq 'output')
758        {
759        $self->{output_format} = $val;
760        }
761      }
762
763    my $att = $self->{att};
764    # create hash if it doesn't exist yet
765    $att->{$class} = {} unless ref $att->{$class};
766
767    if ($name eq 'border')
768      {
769      my $c = $att->{$class};
770
771      ($c->{borderstyle}, $c->{borderwidth}, $c->{bordercolor}) =
772	 $self->split_border_attributes( $val );
773
774      return $val;
775      }
776
777    $att->{$class}->{$name} = $val;
778
779    } # end for all selected classes
780
781  $val;
782  }
783
784sub set_attributes
785  {
786  my ($self, $class_selector, $att) = @_;
787
788  # if called as $graph->set_attributes( { color => blue } ), assume
789  # class eq 'graph'
790
791  if (defined $class_selector && !defined $att)
792    {
793    $att = $class_selector; $class_selector = 'graph';
794    }
795
796  my @classes = $self->_check_class($class_selector);
797
798  return $self->error ("Illegal class '$class_selector' when trying to set attributes")
799    if @classes == 0;
800
801  foreach my $a (sort keys %$att)
802    {
803    for my $class (@classes)
804      {
805      $self->set_attribute($class, $a, $att->{$a});
806      }
807    }
808  $self;
809  }
810
811sub del_attribute
812  {
813  # delete the attribute with the name in the selected class(es)
814  my ($self, $class_selector, $name) = @_;
815
816  if (@_ == 2)
817    {
818    $name = $class_selector; $class_selector = 'graph';
819    }
820
821  # font-size => fontsize
822  $name = $att_aliases->{$name} if exists $att_aliases->{$name};
823
824  my @classes = $self->_check_class($class_selector);
825
826  return $self->error ("Illegal class '$class_selector' when trying to delete attribute '$name'")
827    if @classes == 0;
828
829  for my $class (@classes)
830    {
831    my $a = $self->{att}->{$class};
832
833    delete $a->{$name};
834    if ($name eq 'size')
835      {
836      delete $a->{rows};
837      delete $a->{columns};
838      }
839    if ($name eq 'border')
840      {
841      delete $a->{borderstyle};
842      delete $a->{borderwidth};
843      delete $a->{bordercolor};
844      }
845    }
846  $self;
847  }
848
849#############################################################################
850
851# for determining the absolute graph flow
852my $p_flow =
853  {
854  'east' => 90,
855  'west' => 270,
856  'north' => 0,
857  'south' => 180,
858  'up' => 0,
859  'down' => 180,
860  'back' => 270,
861  'left' => 270,
862  'right' => 90,
863  'front' => 90,
864  'forward' => 90,
865  };
866
867sub flow
868  {
869  # return out flow as number
870  my ($self)  = @_;
871
872  my $flow = $self->{att}->{graph}->{flow};
873
874  return 90 unless defined $flow;
875
876  my $f = $p_flow->{$flow}; $f = $flow unless defined $f;
877  $f;
878  }
879
880#############################################################################
881#############################################################################
882# Output (as_ascii, as_html) routines; as_txt() is in As_txt.pm, as_graphml
883# is in As_graphml.pm
884
885sub output_format
886  {
887  # set the output format
888  my $self = shift;
889
890  $self->{output_format} = shift if $_[0];
891  $self->{output_format};
892  }
893
894sub output
895  {
896  # general output routine, to output the graph as the format that was
897  # specified in the graph source itself
898  my $self = shift;
899
900  no strict 'refs';
901
902  my $method = 'as_' . $self->{output_format};
903
904  $self->_croak("Cannot find a method to generate '$self->{output_format}'")
905    unless $self->can($method);
906
907  $self->$method();
908  }
909
910sub _class_styles
911  {
912  # Create the style sheet with the class lists. This is used by both
913  # css() and as_svg(). $skip is a qr// object that returns true for
914  # attribute names to be skipped (e.g. excluded), and $map is a
915  # HASH that contains mapping for attribute names for the output.
916  # "$base" is the basename for classes (either "table.graph$id" if
917  # not defined, or whatever you pass in, like "" for svg).
918  # $indent is a left-indenting spacer like "  ".
919  # $overlay contains a HASH with attribute-value pairs to set as defaults.
920
921  my ($self, $skip, $map, $base, $indent, $overlay) = @_;
922
923  my $a = $self->{att};
924
925  $indent = '' unless defined $indent;
926  my $indent2 = $indent x 2; $indent2 = '  ' if $indent2 eq '';
927
928  my $class_list = { edge => {}, node => {}, group => {} };
929  if (defined $overlay)
930    {
931    $a = {};
932
933    # make a copy from $self->{att} to $a:
934
935    for my $class (sort keys %{$self->{att}})
936      {
937      my $ac = $self->{att}->{$class};
938      $a->{$class} = {};
939      my $acc = $a->{$class};
940      for my $k (sort keys %$ac)
941        {
942        $acc->{$k} = $ac->{$k};
943        }
944      }
945
946    # add the extra keys
947    for my $class (sort keys %$overlay)
948      {
949      my $oc = $overlay->{$class};
950      # create the hash if it doesn't exist yet
951      $a->{$class} = {} unless ref $a->{$class};
952      my $acc = $a->{$class};
953      for my $k (sort keys %$oc)
954        {
955        $acc->{$k} = $oc->{$k} unless exists $acc->{$k};
956        }
957      $class_list->{$class} = {};
958      }
959    }
960
961  my $id = $self->{id};
962
963  my @primaries = sort keys %$class_list;
964  foreach my $primary (@primaries)
965    {
966    my $cl = $class_list->{$primary};			# shortcut
967    foreach my $class (sort keys %$a)
968      {
969      if ($class =~ /^$primary\.(.*)/)
970        {
971        $cl->{$1} = undef;				# note w/o doubles
972        }
973      }
974    }
975
976  $base = "table.graph$id " unless defined $base;
977
978  my $groups = $self->groups();				# do we have groups?
979
980  my $css = '';
981  foreach my $class (sort keys %$a)
982    {
983    next if (not %{$a->{$class}});			# skip empty ones
984
985    my $c = $class; $c =~ s/\./_/g;			# node.city => node_city
986
987    next if $class eq 'group' and $groups == 0;
988
989    my $css_txt = '';
990    my $cls = '';
991    if ($class eq 'graph' && $base eq '')
992      {
993      $css_txt .= "${indent}.$class \{\n";			# for SVG
994      }
995    elsif ($class eq 'graph')
996      {
997      $css_txt .= "$indent$base\{\n";
998      }
999    else
1000      {
1001      if ($c !~ /\./)					# one of our primary ones
1002        {
1003        # generate also class list 			# like: "cities,node_rivers"
1004        $cls = join (",$base.${c}_", sort keys %{ $class_list->{$c} });
1005        $cls = ",$base.${c}_$cls" if $cls ne '';		# like: ",node_cities,node_rivers"
1006        }
1007      $css_txt .= "$indent$base.$c$cls {\n";
1008      }
1009    my $done = 0;
1010    foreach my $att (sort keys %{$a->{$class}})
1011      {
1012      # should be skipped?
1013      next if $att =~ $skip || $att eq 'border';
1014
1015      # do not specify attributes for the entire graph (only for the label)
1016      # $base ne '' skips this rule for SVG output
1017      next if $class eq 'graph' && $base ne '' && $att =~ /^(color|font|fontsize|align|fill)\z/;
1018
1019      $done++;						# how many did we really?
1020      my $val = $a->{$class}->{$att};
1021
1022      next if !defined $val;
1023
1024      # for groups, set to none, it will be later overriden for the different
1025      # cells (like "ga") with a border only on the appropriate side:
1026      $val = 'none' if $att eq 'borderstyle' && $class eq 'group';
1027      # fix border-widths to be in pixel
1028      $val .= 'px' if $att eq 'borderwidth' && $val !~ /(px|em|%)\z/;
1029
1030      # for color attributes, convert to hex
1031      my $entry = $self->_attribute_entry($class, $att);
1032
1033      if (defined $entry)
1034	{
1035	my $type = $entry->[ ATTR_TYPE_SLOT ] || ATTR_STRING;
1036	if ($type == ATTR_COLOR)
1037	  {
1038	  # create as RGB color
1039	  $val = $self->get_color_attribute($class,$att) || $val;
1040	  }
1041	}
1042      # change attribute name/value?
1043      if (exists $map->{$att})
1044	{
1045        $att = $map->{$att} unless ref $map->{$att};		# change attribute name?
1046        ($att,$val) = &{$map->{$att}}($self,$att,$val,$class) if ref $map->{$att};
1047	}
1048
1049      # value is "inherit"?
1050      if ($class ne 'graph' && $att && $val && $val eq 'inherit')
1051        {
1052        # get the value from one class "up"
1053
1054	# node.foo => node, node => graph
1055        my $base_class = $class; $base_class = 'graph' unless $base_class =~ /\./;
1056	$base_class =~ s/\..*//;
1057
1058        $val = $a->{$base_class}->{$att};
1059
1060	if ($base_class ne 'graph' && (!defined $val || $val eq 'inherit'))
1061	  {
1062	  # node.foo => node, inherit => graph
1063          $val = $a->{graph}->{$att};
1064	  $att = undef if !defined $val;
1065	  }
1066	}
1067
1068      $css_txt .= "$indent2$att: $val;\n" if defined $att && defined $val;
1069      }
1070
1071    $css_txt .= "$indent}\n";
1072    $css .= $css_txt if $done > 0;			# skip if no attributes at all
1073    }
1074  $css;
1075  }
1076
1077sub _skip
1078  {
1079  # return a regexp that specifies which attributes to suppress in CSS
1080  my ($self) = shift;
1081
1082  # skip these for CSS
1083  qr/^(basename|columns|colorscheme|comment|class|flow|format|group|rows|root|size|offset|origin|linkbase|(auto)?(label|link|title)|auto(join|split)|(node|edge)class|shape|arrowstyle|label(color|pos)|point(style|shape)|textstyle|style)\z/;
1084  }
1085
1086#############################################################################
1087# These routines are used by as_html for the generation of CSS
1088
1089sub _remap_text_wrap
1090  {
1091  my ($self,$name,$style) = @_;
1092
1093  return (undef,undef) if $style ne 'auto';
1094
1095  # make text wrap again
1096  ('white-space','normal');
1097  }
1098
1099sub _remap_fill
1100  {
1101  my ($self,$name,$color,$class) = @_;
1102
1103  return ('background',$color) unless $class =~ /edge/;
1104
1105  # for edges, the fill is ignored
1106  (undef,undef);
1107  }
1108
1109#############################################################################
1110
1111sub css
1112  {
1113  my $self = shift;
1114
1115  my $a = $self->{att};
1116  my $id = $self->{id};
1117
1118  # for each primary class (node/group/edge) we need to find all subclasses,
1119  # and list them in the CSS, too. Otherwise "node_city" would not inherit
1120  # the attributes from "node".
1121
1122  my $css = $self->_class_styles( $self->_skip(),
1123    {
1124      fill => \&_remap_fill,
1125      textwrap => \&_remap_text_wrap,
1126      align => 'text-align',
1127      font => 'font-family',
1128      fontsize => 'font-size',
1129      bordercolor => 'border-color',
1130      borderstyle => 'border-style',
1131      borderwidth => 'border-width',
1132    },
1133    undef,
1134    undef,
1135    $html_att,
1136    );
1137
1138  my @groups = $self->groups();
1139
1140  # Set attributes for all TDs that start with "group":
1141  $css .= <<CSS
1142table.graph##id## td[class|="group"] { padding: 0.2em; }
1143CSS
1144  if @groups > 0;
1145
1146  $css .= <<CSS
1147table.graph##id## td {
1148  padding: 2px;
1149  background: inherit;
1150  white-space: nowrap;
1151  }
1152table.graph##id## span.l { float: left; }
1153table.graph##id## span.r { float: right; }
1154CSS
1155;
1156
1157  # append CSS for edge cells (and their parts like va (vertical arrow
1158  # (left/right), vertical empty), etc)
1159
1160  # eb	- empty bottom or arrow pointing down/up
1161  # el  - (vertical) empty left space of ver edge
1162  #       or empty vertical space on hor edge starts
1163  # lh  - edge label horizontal
1164  # le  - edge label, but empty (no label)
1165  # lv  - edge label vertical
1166  # sh  - shifted arrow horizontal (shift right)
1167  # sa  - shifted arrow horizontal (shift left for corners)
1168  # shl - shifted arrow horizontal (shift left)
1169  # sv  - shifted arrow vertical (pointing down)
1170  # su  - shifted arrow vertical (pointing up)
1171
1172  $css .= <<CSS
1173table.graph##id## .va {
1174  vertical-align: middle;
1175  line-height: 1em;
1176  width: 0.4em;
1177  }
1178table.graph##id## .el {
1179  width: 0.1em;
1180  max-width: 0.1em;
1181  min-width: 0.1em;
1182  }
1183table.graph##id## .lh, table.graph##id## .lv {
1184  font-size: 0.8em;
1185  padding-left: 0.4em;
1186  }
1187table.graph##id## .sv, table.graph##id## .sh, table.graph##id## .shl, table.graph##id## .sa, table.graph##id## .su {
1188  max-height: 1em;
1189  line-height: 1em;
1190  position: relative;
1191  top: 0.55em;
1192  left: -0.3em;
1193  overflow: visible;
1194  }
1195table.graph##id## .sv, table.graph##id## .su {
1196  max-height: 0.5em;
1197  line-height: 0.5em;
1198  }
1199table.graph##id## .shl { left: 0.3em; }
1200table.graph##id## .sv { left: -0.5em; top: -0.4em; }
1201table.graph##id## .su { left: -0.5em; top: 0.4em; }
1202table.graph##id## .sa { left: -0.3em; top: 0; }
1203table.graph##id## .eb { max-height: 0; line-height: 0; height: 0; }
1204CSS
1205  # if we have edges
1206  if keys %{$self->{edges}}  > 0;
1207
1208  # if we have nodes with rounded shapes:
1209  my $rounded = 0;
1210  for my $n (ord_values ( $self->{nodes} ))
1211    {
1212    $rounded ++ and last if $n->shape() =~ /circle|ellipse|rounded/;
1213    }
1214
1215  $css .= <<CSS
1216table.graph##id## span.c { position: relative; top: 1.5em; }
1217table.graph##id## div.c { -moz-border-radius: 100%; border-radius: 100%; }
1218table.graph##id## div.r { -moz-border-radius: 1em; border-radius: 1em; }
1219CSS
1220  if $rounded > 0;
1221
1222  # append CSS for group cells (only if we actually have groups)
1223
1224  if (@groups > 0)
1225    {
1226    foreach my $group (@groups)
1227      {
1228      my $class = $group->class();
1229
1230      my $border = $group->attribute('borderstyle');
1231
1232      $class =~ s/.*\.//;	# leave only subclass
1233      $css .= Graph::Easy::Group::Cell->_css($self->{id}, $class, $border);
1234      }
1235    }
1236
1237  # replace the id with either '' or '123', depending on our ID
1238  $css =~ s/##id##/$id/g;
1239
1240  $css;
1241  }
1242
1243sub html_page_header
1244  {
1245  # return the HTML header for as_html_file()
1246  my ($self, $css) = @_;
1247
1248  my $html = <<HTML
1249<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
1250<html>
1251 <head>
1252 <meta http-equiv="Content-Type" content="text/html; charset=##charset##">
1253 <title>##title##</title>##CSS##
1254</head>
1255<body bgcolor=white text=black>
1256HTML
1257;
1258
1259  $html =~ s/\n\z//;
1260  $html =~ s/##charset##/utf-8/g;
1261  my $t = $self->title();
1262  $html =~ s/##title##/$t/g;
1263
1264  # insert CSS if requested
1265  $css = $self->css() unless defined $css;
1266
1267  $html =~ s/##CSS##/\n <style type="text\/css">\n <!--\n $css -->\n <\/style>/ if $css ne '';
1268  $html =~ s/##CSS##//;
1269
1270  $html;
1271  }
1272
1273sub title
1274  {
1275  my $self = shift;
1276
1277  my $title = $self->{att}->{graph}->{title};
1278  $title = $self->{att}->{graph}->{label} if !defined $title;
1279  $title = 'Untitled graph' if !defined $title;
1280
1281  $title = $self->_un_escape($title, 1) if !$_[0] && $title =~ /\\[EGHNTL]/;
1282  $title;
1283  }
1284
1285sub html_page_footer
1286  {
1287  # return the HTML footer for as_html_file()
1288  my $self = shift;
1289
1290  "\n</body></html>\n";
1291  }
1292
1293sub as_html_file
1294  {
1295  my $self = shift;
1296
1297  $self->html_page_header() . $self->as_html() . $self->html_page_footer();
1298  }
1299
1300#############################################################################
1301
1302sub _caption
1303  {
1304  # create the graph label as caption
1305  my $self = shift;
1306
1307  my ($caption,$switch_to_center) = $self->_label_as_html();
1308
1309  return ('','') unless defined $caption && $caption ne '';
1310
1311  my $bg = $self->raw_color_attribute('fill');
1312
1313  my $style = ' style="';
1314  $style .= "background: $bg;" if $bg;
1315
1316  # the font family
1317  my $f = $self->raw_attribute('font') || '';
1318  $style .= "font-family: $f;" if $f ne '';
1319
1320  # the text color
1321  my $c = $self->raw_color_attribute('color');
1322  $style .= "color: $c;" if $c;
1323
1324  # bold, italic, underline, incl. fontsize and align
1325  $style .= $self->text_styles_as_css();
1326
1327  $style =~ s/;\z//;				# remove last ';'
1328  $style .= '"' unless $style eq ' style="';
1329
1330  $style =~ s/style="\s/style="/;		# remove leading space
1331
1332  my $link = $self->link();
1333
1334  if ($link ne '')
1335    {
1336    # encode critical entities
1337    $link =~ s/\s/\+/g;				# space
1338    $link =~ s/'/%27/g;				# replace quotation marks
1339    $caption = "<a href='$link'>$caption</a>";
1340    }
1341
1342  $caption = "<tr>\n  <td colspan=##cols##$style>$caption</td>\n</tr>\n";
1343
1344  my $pos = $self->attribute('labelpos');
1345
1346  ($caption,$pos);
1347  }
1348
1349sub as_html
1350  {
1351  # convert the graph to HTML+CSS
1352  my ($self) = shift;
1353
1354  $self->layout() unless defined $self->{score};
1355
1356  my $top = "\n" . $self->quoted_comment();
1357
1358  my $cells = $self->{cells};
1359  my ($rows,$cols);
1360
1361  my $max_x = undef;
1362  my $min_x = undef;
1363
1364  # find all x and y occurrences to sort them by row/columns
1365  for my $k (sort keys %$cells)
1366    {
1367    my ($x,$y) = split/,/, $k;
1368    my $node = $cells->{$k};
1369
1370    $max_x = $x if !defined $max_x || $x > $max_x;
1371    $min_x = $x if !defined $min_x || $x < $min_x;
1372
1373    # trace the rows we do have
1374    $rows->{$y}->{$x} = $node;
1375    # record all possible columns
1376    $cols->{$x} = undef;
1377    }
1378
1379  $max_x = 1, $min_x = 1 unless defined $max_x;
1380
1381  # number of cells in the table, maximum
1382  my $max_cells = $max_x - $min_x + 1;
1383
1384  my $groups = scalar $self->groups();
1385
1386  my $id = $self->{id};
1387
1388  $top .=  "\n<table class=\"graph$id\" cellpadding=0 cellspacing=0";
1389  $top .= ">\n";
1390
1391  my $html = '';
1392
1393  # prepare the graph label
1394  my ($caption,$pos) = $self->_caption();
1395
1396  my $row_id = 0;
1397  # now run through all rows, and for each of them through all columns
1398  for my $y (sort { ($a||0) <=> ($b||0) } keys %$rows)
1399    {
1400
1401    # four rows at a time
1402    my $rs = [ [], [], [], [] ];
1403
1404    # for all possible columns
1405    for my $x (sort { $a <=> $b } keys %$cols)
1406      {
1407      if (!exists $rows->{$y}->{$x})
1408	{
1409	# fill empty spaces with undef, but not for parts of multicelled objects:
1410	push @{$rs->[0]}, undef;
1411	next;
1412	}
1413      my $node = $rows->{$y}->{$x};
1414      next if $node->isa('Graph::Easy::Node::Cell');		# skip empty cells
1415
1416      my $h = $node->as_html();
1417
1418      if (ref($h) eq 'ARRAY')
1419        {
1420        #print STDERR '# expected 4 rows, but got ' . scalar @$h if @$h != 4;
1421        local $_; my $i = 0;
1422        push @{$rs->[$i++]}, $_ for @$h;
1423        }
1424      else
1425        {
1426        push @{$rs->[0]}, $h;
1427        }
1428      }
1429
1430    ######################################################################
1431    # remove trailing empty tag-pairs, then replace undef with empty tags
1432
1433    for my $row (@$rs)
1434      {
1435      pop @$row while (@$row > 0 && !defined $row->[-1]);
1436      local $_;
1437      foreach (@$row)
1438        {
1439        $_ = " <td colspan=4 rowspan=4></td>\n" unless defined $_;
1440        }
1441      }
1442
1443    # now combine equal columns to shorten output
1444    for my $row (@$rs)
1445      {
1446      next;
1447
1448      # append row to output
1449      my $i = 0;
1450      while ($i < @$row)
1451        {
1452        next if $row->[$i] =~ /border(:|-left)/;
1453#        next if $row->[$i] !~ />(\&nbsp;)?</;	# non-empty?
1454#        next if $row->[$i] =~ /span /;		# non-empty?
1455#        next if $row->[$i] =~ /^(\s|\n)*\z/;	# empty?
1456
1457	# Combining these cells shows weird artifacts when using the Firefox
1458	# WebDeveloper toolbar and outlining table cells, but it does not
1459	# seem to harm rendering in browsers:
1460        #next if $row->[$i] =~ /class="[^"]+ eb"/;	# is class=".. eb"
1461
1462	# contains wo succ. cell?
1463        next if $row->[$i] =~ /(row|col)span.*\1span/m;
1464
1465        # count all successive equal ones
1466        my $j = $i + 1;
1467
1468        $j++ while ($j < @$row && $row->[$j] eq $row->[$i]); # { $j++; }
1469
1470        if ($j > $i + 1)
1471          {
1472          my $cnt = $j - $i - 1;
1473
1474#         print STDERR "combining row $i to $j ($cnt) (\n'$row->[$i]'\n'$row->[$i+1]'\n'$row->[$j-1]'\n";
1475
1476          # throw away
1477          splice (@$row, $i + 1, $cnt);
1478
1479          # insert empty colspan if not already there
1480          $row->[$i] =~ s/<td/<td colspan=0/ unless $row->[$i] =~ /colspan/;
1481          # replace
1482          $row->[$i] =~ s/colspan=(\d+)/'colspan='.($1+$cnt*4)/e;
1483          }
1484        } continue { $i++; }
1485      }
1486
1487    ######################################################################
1488
1489    my $i = 0;
1490    for my $row (@$rs)
1491      {
1492      # append row to output
1493      my $r = join('',@$row);
1494
1495      if ($r !~ s/^[\s\n]*\z//)
1496	{
1497        # non empty rows get "\n</tr>"
1498        $r = "\n" . $r; # if length($r) > 0;
1499        }
1500
1501      $html .= "<!-- row $row_id line $i -->\n" . '<tr>' . $r . "</tr>\n\n";
1502      $i++;
1503      }
1504    $row_id++;
1505    }
1506
1507  ###########################################################################
1508  # finally insert the graph label
1509  $max_cells *= 4;					# 4 rows for each cell
1510  $caption =~ s/##cols##/$max_cells/ if defined $caption;
1511
1512  $html .= $caption if $pos eq 'bottom';
1513  $top .= $caption if $pos eq 'top';
1514
1515  $html = $top . $html;
1516
1517  # remove empty trailing <tr></tr> pairs
1518  $html =~ s#(<tr></tr>\n\n)+\z##;
1519
1520  $html .= "</table>\n";
1521
1522  $html;
1523  }
1524
1525#############################################################################
1526# as_boxart_*
1527
1528sub as_boxart
1529  {
1530  # Create box-drawing art using Unicode characters - will return utf-8.
1531  my ($self) = shift;
1532
1533  require Graph::Easy::As_ascii;
1534
1535  # select Unicode box drawing characters
1536  $self->{_ascii_style} = 1;
1537
1538  $self->_as_ascii(@_);
1539  }
1540
1541sub as_boxart_html
1542  {
1543  # Output a box-drawing using Unicode, then return it as a HTML chunk
1544  # suitable to be embedded into an HTML page.
1545  my ($self) = shift;
1546
1547  "<pre style='line-height: 1em; line-spacing: 0;'>\n" .
1548    $self->as_boxart(@_) .
1549    "\n</pre>\n";
1550  }
1551
1552sub as_boxart_html_file
1553  {
1554  my $self = shift;
1555
1556  $self->layout() unless defined $self->{score};
1557
1558  $self->html_page_header(' ') . "\n" .
1559    $self->as_boxart_html() . $self->html_page_footer();
1560  }
1561
1562#############################################################################
1563# as_ascii_*
1564
1565sub as_ascii
1566  {
1567  # Convert the graph to pretty ASCII art - will return utf-8.
1568  my $self = shift;
1569
1570  # select 'ascii' characters
1571  $self->{_ascii_style} = 0;
1572
1573  $self->_as_ascii(@_);
1574  }
1575
1576sub _as_ascii
1577  {
1578  # Convert the graph to pretty ASCII or box art art - will return utf-8.
1579  my $self = shift;
1580
1581  require Graph::Easy::As_ascii;
1582  require Graph::Easy::Layout::Grid;
1583
1584  my $opt = ref($_[0]) eq 'HASH' ? $_[0] : { @_ };
1585
1586  # include links?
1587  $self->{_links} = $opt->{links};
1588
1589  $self->layout() unless defined $self->{score};
1590
1591  # generate for each cell the width/height etc
1592
1593  my ($rows,$cols,$max_x,$max_y) = $self->_prepare_layout('ascii');
1594  my $cells = $self->{cells};
1595
1596  # offset where to draw the graph (non-zero if graph has label)
1597  my $y_start = 0;
1598  my $x_start = 0;
1599
1600  my $align = $self->attribute('align');
1601
1602  # get the label lines and their alignment
1603  my ($label,$aligns) = $self->_aligned_label($align);
1604
1605  # if the graph has a label, reserve space for it
1606  my $label_pos = 'top';
1607  if (@$label > 0)
1608    {
1609    # insert one line over and below
1610    unshift @$label, '';   push @$label, '';
1611    unshift @$aligns, 'c'; push @$aligns, 'c';
1612
1613    $label_pos = $self->attribute('graph','label-pos') || 'top';
1614    $y_start += scalar @$label if $label_pos eq 'top';
1615    $max_y += scalar @$label + 1;
1616    print STDERR "# Graph with label, position $label_pos\n" if $self->{debug};
1617
1618    my $old_max_x = $max_x;
1619    # find out the dimensions of the label and make sure max_x is big enough
1620    for my $l (@$label)
1621      {
1622      $max_x = length($l)+2 if (length($l) > $max_x+2);
1623      }
1624    $x_start = int(($max_x - $old_max_x) / 2);
1625    }
1626
1627  print STDERR "# Allocating framebuffer $max_x x $max_y\n" if $self->{debug};
1628
1629  # generate the actual framebuffer for the output
1630  my $fb = Graph::Easy::Node->_framebuffer($max_x, $max_y);
1631
1632  # output the label
1633  if (@$label > 0)
1634    {
1635    my $y = 0; $y = $max_y - scalar @$label if $label_pos eq 'bottom';
1636    Graph::Easy::Node->_printfb_aligned($fb, 0, $y, $max_x, $max_y, $label, $aligns, 'top');
1637    }
1638
1639  # draw all cells into framebuffer
1640  foreach my $v (ord_values ($cells))
1641    {
1642    next if $v->isa('Graph::Easy::Node::Cell');		# skip empty cells
1643
1644    # get as ASCII box
1645    my $x = $cols->{ $v->{x} } + $x_start;
1646    my $y = $rows->{ $v->{y} } + $y_start;
1647
1648    my @lines = split /\n/, $v->as_ascii($x,$y);
1649    # get position from cell
1650    for my $i (0 .. scalar @lines-1)
1651      {
1652      next if length($lines[$i]) == 0;
1653      # XXX TODO: framebuffer shouldn't be to small!
1654      $fb->[$y+$i] = ' ' x $max_x if !defined $fb->[$y+$i];
1655      substr($fb->[$y+$i], $x, length($lines[$i])) = $lines[$i];
1656      }
1657    }
1658
1659  for my $y (0..$max_y)
1660    {
1661    $fb->[$y] = '' unless defined $fb->[$y];
1662    $fb->[$y] =~ s/\s+\z//;		# remove trailing whitespace
1663    }
1664  my $out = join("\n", @$fb) . "\n";
1665
1666  $out =~ s/\n+\z/\n/;		# remove trailing empty lines
1667
1668  # restore height/width of cells from minw/minh
1669  foreach my $v (ord_values $cells)
1670    {
1671    $v->{h} = $v->{minh};
1672    $v->{w} = $v->{minw};
1673    }
1674  $out;				# return output
1675  }
1676
1677sub as_ascii_html
1678  {
1679  # Convert the graph to pretty ASCII art, then return it as a HTML chunk
1680  # suitable to be embedded into an HTML page.
1681  my ($self) = shift;
1682
1683  "<pre>\n" . $self->_as_ascii(@_) . "\n</pre>\n";
1684  }
1685
1686#############################################################################
1687# as_txt, as_debug, as_graphviz
1688
1689sub as_txt
1690  {
1691  require Graph::Easy::As_txt;
1692
1693  _as_txt(@_);
1694  }
1695
1696sub as_graphviz
1697  {
1698  require Graph::Easy::As_graphviz;
1699
1700  _as_graphviz(@_);
1701  }
1702
1703sub as_debug
1704  {
1705  require Graph::Easy::As_txt;
1706  eval { require Graph::Easy::As_svg; };
1707
1708  my $self = shift;
1709
1710  my $output = '';
1711
1712  $output .= '# Using Graph::Easy v' . $Graph::Easy::VERSION . "\n";
1713  if ($Graph::Easy::As_svg::VERSION)
1714    {
1715    $output .= '# Using Graph::Easy::As_svg v' . $Graph::Easy::As_svg::VERSION . "\n";
1716    }
1717  $output .= '# Running Perl v' . $] . " under $^O\n";
1718
1719  $output . "\n# Input normalized as_txt:\n\n" . $self->_as_txt(@_);
1720  }
1721
1722#############################################################################
1723# as_vcg(as_gdl
1724
1725sub as_vcg
1726  {
1727  require Graph::Easy::As_vcg;
1728
1729  _as_vcg(@_);
1730  }
1731
1732sub as_gdl
1733  {
1734  require Graph::Easy::As_vcg;
1735
1736  _as_vcg(@_, { gdl => 1 });
1737  }
1738
1739#############################################################################
1740# as_svg
1741
1742sub as_svg
1743  {
1744  require Graph::Easy::As_svg;
1745  require Graph::Easy::Layout::Grid;
1746
1747  _as_svg(@_);
1748  }
1749
1750sub as_svg_file
1751  {
1752  require Graph::Easy::As_svg;
1753  require Graph::Easy::Layout::Grid;
1754
1755  _as_svg( $_[0], { standalone => 1 } );
1756  }
1757
1758sub svg_information
1759  {
1760  my ($self) = @_;
1761
1762  require Graph::Easy::As_svg;
1763  require Graph::Easy::Layout::Grid;
1764
1765  # if it doesn't exist, render as SVG and thus create it
1766  _as_svg(@_) unless $self->{svg_info};
1767
1768  $self->{svg_info};
1769  }
1770
1771#############################################################################
1772# as_graphml
1773
1774sub as_graphml
1775  {
1776  require Graph::Easy::As_graphml;
1777
1778  _as_graphml(@_);
1779  }
1780
1781#############################################################################
1782
1783sub add_edge
1784  {
1785  my ($self,$x,$y,$edge) = @_;
1786
1787  my $uc = $self->{use_class};
1788
1789  my $ec = $uc->{edge};
1790  $edge = $ec->new() unless defined $edge;
1791  $edge = $ec->new(label => $edge) unless ref($edge);
1792
1793  $self->_croak("Adding an edge object twice is not possible")
1794    if (exists ($self->{edges}->{$edge->{id}}));
1795
1796  $self->_croak("Cannot add edge $edge ($edge->{id}), it already belongs to another graph")
1797    if ref($edge->{graph}) && $edge->{graph} != $self;
1798
1799  my $nodes = $self->{nodes};
1800  my $groups = $self->{groups};
1801
1802  $self->_croak("Cannot add edge for undefined node names ($x -> $y)")
1803    unless defined $x && defined $y;
1804
1805  my $xn = $x; my $yn = $y;
1806  $xn = $x->{name} if ref($x);
1807  $yn = $y->{name} if ref($y);
1808
1809  # convert plain scalars to Node objects if nec.
1810
1811  # XXX TODO: this might be a problem when adding an edge from a group with the same
1812  #           name as a node
1813
1814  $x = $nodes->{$xn} if exists $nodes->{$xn};		# first look them up
1815  $y = $nodes->{$yn} if exists $nodes->{$yn};
1816
1817  $x = $uc->{node}->new( $x ) unless ref $x;		# if this fails, create
1818  $y = $x if !ref($y) && $y eq $xn;			# make add_edge('A','A') work
1819  $y = $uc->{node}->new( $y ) unless ref $y;
1820
1821  print STDERR "# add_edge '$x->{name}' ($x->{id}) -> '$y->{name}' ($y->{id}) (edge $edge->{id}) ($x -> $y)\n" if $self->{debug};
1822
1823  for my $n ($x,$y)
1824    {
1825    $self->_croak("Cannot add node $n ($n->{name}), it already belongs to another graph")
1826      if ref($n->{graph}) && $n->{graph} != $self;
1827    }
1828
1829  # Register the nodes and the edge with our graph object
1830  # and weaken the references. Be careful to not needlessly
1831  # override and weaken again an already existing reference, this
1832  # is an O(N) operation in most Perl versions, and thus very slow.
1833
1834  weaken($x->{graph} = $self) unless ref($x->{graph});
1835  weaken($y->{graph} = $self) unless ref($y->{graph});
1836  weaken($edge->{graph} = $self) unless ref($edge->{graph});
1837
1838  # Store at the edge from where to where it goes for easier reference
1839  $edge->{from} = $x;
1840  $edge->{to} = $y;
1841
1842  # store the edge at the nodes/groups, too
1843  $x->{edges}->{$edge->{id}} = $edge;
1844  $y->{edges}->{$edge->{id}} = $edge;
1845
1846  # index nodes by their name so that we can find $x from $x->{name} fast
1847  my $store = $nodes; $store = $groups if $x->isa('Graph::Easy::Group');
1848  $store->{$x->{name}} = $x;
1849  $store = $nodes; $store = $groups if $y->isa('Graph::Easy::Group');
1850  $store->{$y->{name}} = $y;
1851
1852  # index edges by "edgeid" so we can find them fast
1853  $self->{edges}->{$edge->{id}} = $edge;
1854
1855  $self->{score} = undef;			# invalidate last layout
1856
1857  wantarray ? ($x,$y,$edge) : $edge;
1858  }
1859
1860sub add_anon_node
1861  {
1862  my ($self) = shift;
1863
1864  $self->warn('add_anon_node does not take argumens') if @_ > 0;
1865
1866  my $node = Graph::Easy::Node::Anon->new();
1867
1868  $self->add_node($node);
1869
1870  $node;
1871  }
1872
1873sub add_node
1874  {
1875  my ($self,$x) = @_;
1876
1877  my $n = $x;
1878  if (ref($x))
1879    {
1880    $n = $x->{name}; $n = '0' unless defined $n;
1881    }
1882
1883  return $self->_croak("Cannot add node with empty name to graph.") if $n eq '';
1884
1885  return $self->_croak("Cannot add node $x ($n), it already belongs to another graph")
1886    if ref($x) && ref($x->{graph}) && $x->{graph} != $self;
1887
1888  my $no = $self->{nodes};
1889  # already exists?
1890  return $no->{$n} if exists $no->{$n};
1891
1892  my $uc = $self->{use_class};
1893  $x = $uc->{node}->new( $x ) unless ref $x;
1894
1895  # store the node
1896  $no->{$n} = $x;
1897
1898  # Register the nodes and the edge with our graph object
1899  # and weaken the references. Be careful to not needlessly
1900  # override and weaken again an already existing reference, this
1901  # is an O(N) operation in most Perl versions, and thus very slow.
1902
1903  weaken($x->{graph} = $self) unless ref($x->{graph});
1904
1905  $self->{score} = undef;			# invalidate last layout
1906
1907  $x;
1908  }
1909
1910sub add_nodes
1911  {
1912  my $self = shift;
1913
1914  my @rc;
1915  for my $x (@_)
1916    {
1917    my $n = $x;
1918    if (ref($x))
1919      {
1920      $n = $x->{name}; $n = '0' unless defined $n;
1921      }
1922
1923    return $self->_croak("Cannot add node with empty name to graph.") if $n eq '';
1924
1925    return $self->_croak("Cannot add node $x ($n), it already belongs to another graph")
1926      if ref($x) && ref($x->{graph}) && $x->{graph} != $self;
1927
1928    my $no = $self->{nodes};
1929    # this one already exists
1930    next if exists $no->{$n};
1931
1932    my $uc = $self->{use_class};
1933    # make it work with read-only scalars:
1934    my $xx = $x;
1935    $xx = $uc->{node}->new( $x ) unless ref $x;
1936
1937    # store the node
1938    $no->{$n} = $xx;
1939
1940    # Register the nodes and the edge with our graph object
1941    # and weaken the references. Be careful to not needlessly
1942    # override and weaken again an already existing reference, this
1943    # is an O(N) operation in most Perl versions, and thus very slow.
1944
1945    weaken($xx->{graph} = $self) unless ref($xx->{graph});
1946
1947    push @rc, $xx;
1948    }
1949
1950  $self->{score} = undef;			# invalidate last layout
1951
1952  @rc;
1953  }
1954
1955#############################################################################
1956#############################################################################
1957# Cloning/merging of graphs and objects
1958
1959sub copy
1960  {
1961  # create a copy of this graph and return it as new graph
1962  my $self = shift;
1963
1964  my $new = Graph::Easy->new();
1965
1966  # clone all the settings
1967  for my $k (sort keys %$self)
1968    {
1969    $new->{$k} = $self->{$k} unless ref($self->{$k});
1970    }
1971
1972  for my $g (sort keys %{$self->{groups}})
1973    {
1974    my $ng = $new->add_group($g);
1975    # clone the attributes
1976    $ng->{att} = $self->_clone( $self->{groups}->{$g}->{att} );
1977    }
1978  for my $n (ord_values ( $self->{nodes} ))
1979    {
1980    my $nn = $new->add_node($n->{name});
1981    # clone the attributes
1982    $nn->{att} = $self->_clone( $n->{att} );
1983    # restore group membership for the node
1984    $nn->add_to_group( $n->{group}->{name} ) if $n->{group};
1985    }
1986  for my $e (ord_values ( $self->{edges} ))
1987    {
1988    my $ne = $new->add_edge($e->{from}->{name}, $e->{to}->{name} );
1989    # clone the attributes
1990    $ne->{att} = $self->_clone( $e->{att} );
1991    }
1992  # clone the attributes
1993  $new->{att} = $self->_clone( $self->{att});
1994
1995  $new;
1996  }
1997
1998sub _clone
1999  {
2000  # recursively clone a data structure
2001  my ($self,$in) = @_;
2002
2003  my $out = { };
2004
2005  for my $k (sort keys %$in)
2006    {
2007    if (ref($k) eq 'HASH')
2008      {
2009      $out->{$k} = $self->_clone($in->{$k});
2010      }
2011    elsif (ref($k))
2012      {
2013      $self->error("Can't clone $k");
2014      }
2015    else
2016      {
2017      $out->{$k} = $in->{$k};
2018      }
2019    }
2020  $out;
2021  }
2022
2023sub merge_nodes
2024  {
2025  # Merge two nodes, by dropping all connections between them, and then
2026  # drawing all connections from/to $B to $A, then drop $B
2027  my ($self, $A, $B, $joiner) = @_;
2028
2029  $A = $self->node($A) unless ref($A);
2030  $B = $self->node($B) unless ref($B);
2031
2032  # if the node is part of a group, deregister it first from there
2033  $B->{group}->del_node($B) if ref($B->{group});
2034
2035  my @edges = ord_values ( $A->{edges} );
2036
2037  # drop all connections from A --> B
2038  for my $edge (@edges)
2039    {
2040    next unless $edge->{to} == $B;
2041
2042#    print STDERR "# dropping $edge->{from}->{name} --> $edge->{to}->{name}\n";
2043    $self->del_edge($edge);
2044    }
2045
2046  # Move all edges from/to B over to A, but drop "B --> B" and "B --> A".
2047  for my $edge (ord_values ( $B->{edges} ))
2048    {
2049    # skip if going from B --> A or B --> B
2050    next if $edge->{to} == $A || ($edge->{to} == $B && $edge->{from} == $B);
2051
2052#    print STDERR "# moving $edge->{from}->{name} --> $edge->{to}->{name} to ";
2053
2054    $edge->{from} = $A if $edge->{from} == $B;
2055    $edge->{to} = $A if $edge->{to} == $B;
2056
2057#   print STDERR " $edge->{from}->{name} --> $edge->{to}->{name}\n";
2058
2059    delete $B->{edges}->{$edge->{id}};
2060    $A->{edges}->{$edge->{id}} = $edge;
2061    }
2062
2063  # should we join the label from B to A?
2064  $A->set_attribute('label', $A->label() . $joiner . $B->label() ) if defined $joiner;
2065
2066  $self->del_node($B);
2067
2068  $self;
2069  }
2070
2071#############################################################################
2072# deletion
2073
2074sub del_node
2075  {
2076  my ($self, $node) = @_;
2077
2078  # make object
2079  $node = $self->{nodes}->{$node} unless ref($node);
2080
2081  # doesn't exist, so we don't need to do anything
2082  return unless ref($node);
2083
2084  # if node is part of a group, delete it there, too
2085  $node->{group}->del_node($node) if ref $node->{group};
2086
2087  delete $self->{nodes}->{$node->{name}};
2088
2089  # delete all edges from/to this node
2090  for my $edge (ord_values ( $node->{edges} ))
2091    {
2092    # drop the edge from our global edge list
2093    delete $self->{edges}->{$edge->{id}};
2094
2095    my $to = $edge->{to}; my $from = $edge->{from};
2096
2097    # drop the edge from the other node
2098    delete $from->{edges}->{$edge->{id}} if $from != $node;
2099    delete $to->{edges}->{$edge->{id}} if $to != $node;
2100    }
2101
2102  # decouple node from the graph
2103  $node->{graph} = undef;
2104  # reset cached size
2105  $node->{w} = undef;
2106
2107  # drop all edges from the node locally
2108  $node->{edges} = { };
2109
2110  # if the node is a child of another node, deregister it there
2111  delete $node->{origin}->{children}->{$node->{id}} if defined $node->{origin};
2112
2113  $self->{score} = undef;			# invalidate last layout
2114
2115  $self;
2116  }
2117
2118sub del_edge
2119  {
2120  my ($self, $edge) = @_;
2121
2122  $self->_croak("del_edge() needs an object") unless ref $edge;
2123
2124  # if edge is part of a group, delete it there, too
2125  $edge->{group}->_del_edge($edge) if ref $edge->{group};
2126
2127  my $to = $edge->{to}; my $from = $edge->{from};
2128
2129  # delete the edge from the nodes
2130  delete $from->{edges}->{$edge->{id}};
2131  delete $to->{edges}->{$edge->{id}};
2132
2133  # drop the edge from our global edge list
2134  delete $self->{edges}->{$edge->{id}};
2135
2136  $edge->{from} = undef;
2137  $edge->{to} = undef;
2138
2139  $self;
2140  }
2141
2142#############################################################################
2143# group management
2144
2145sub add_group
2146  {
2147  # add a group object
2148  my ($self,$group) = @_;
2149
2150  my $uc = $self->{use_class};
2151
2152  # group with that name already exists?
2153  my $name = $group;
2154  $group = $self->{groups}->{ $group } unless ref $group;
2155
2156  # group with that name doesn't exist, so create new one
2157  $group = $uc->{group}->new( name => $name ) unless ref $group;
2158
2159  # index under the group name for easier lookup
2160  $self->{groups}->{ $group->{name} } = $group;
2161
2162  # register group with ourself and weaken the reference
2163  $group->{graph} = $self;
2164  {
2165    no warnings; # don't warn on already weak references
2166    weaken($group->{graph});
2167  }
2168  $self->{score} = undef;			# invalidate last layout
2169
2170  $group;
2171  }
2172
2173sub del_group
2174  {
2175  # delete group
2176  my ($self,$group) = @_;
2177
2178  delete $self->{groups}->{ $group->{name} };
2179
2180  $self->{score} = undef;			# invalidate last layout
2181
2182  $self;
2183  }
2184
2185sub group
2186  {
2187  # return group by name
2188  my ($self,$name) = @_;
2189
2190  $self->{groups}->{ $name };
2191  }
2192
2193sub groups
2194  {
2195  # return number of groups (or groups as object list)
2196  my ($self) = @_;
2197
2198  return sort { $a->{name} cmp $b->{name} } values %{$self->{groups}}
2199    if wantarray;
2200
2201  scalar keys %{$self->{groups}};
2202  }
2203
2204sub groups_within
2205  {
2206  # Return the groups that are directly inside this graph/group. The optional
2207  # level is either -1 (meaning return all groups contained within), or a
2208  # positive number indicating how many levels down we need to go.
2209  my ($self, $level) = @_;
2210
2211  $level = -1 if !defined $level || $level < 0;
2212
2213  # inline call to $self->groups;
2214  if ($level == -1)
2215    {
2216    return sort { $a->{name} cmp $b->{name} } values %{$self->{groups}}
2217      if wantarray;
2218
2219    return scalar keys %{$self->{groups}};
2220    }
2221
2222  my $are_graph = $self->{graph} ? 0 : 1;
2223
2224  # get the groups at level 0
2225  my $current = 0;
2226  my @todo;
2227  for my $g (ord_values ( $self->{groups} ))
2228    {
2229    # no group set => belongs to graph, set to ourself => belongs to ourself
2230    push @todo, $g if ( ($are_graph && !defined $g->{group}) || $g->{group} == $self);
2231    }
2232
2233  if ($level == 0)
2234    {
2235    return wantarray ? @todo : scalar @todo;
2236    }
2237
2238  # we need to recursively count groups until the wanted level is reached
2239  my @cur = @todo;
2240  for my $g (@todo)
2241    {
2242    # _groups_within() is defined in Graph::Easy::Group
2243    $g->_groups_within(1, $level, \@cur);
2244    }
2245
2246  wantarray ? @cur : scalar @cur;
2247  }
2248
2249sub anon_groups
2250  {
2251  # return all anon groups as objects
2252  my ($self) = @_;
2253
2254  my $n = $self->{groups};
2255
2256  if (!wantarray)
2257    {
2258    my $count = 0;
2259    for my $group (ord_values ($n))
2260      {
2261      $count++ if $group->is_anon();
2262      }
2263    return $count;
2264    }
2265
2266  my @anon = ();
2267  for my $group (ord_values ($n))
2268    {
2269    push @anon, $group if $group->is_anon();
2270    }
2271  @anon;
2272  }
2273
2274sub use_class
2275  {
2276  # use the provided class for generating objects of the type $object
2277  my ($self, $object, $class) = @_;
2278
2279  $self->_croak("Expected one of node, edge or group, but got $object")
2280    unless $object =~ /^(node|group|edge)\z/;
2281
2282  $self->{use_class}->{$object} = $class;
2283
2284  $self;
2285  }
2286
2287#############################################################################
2288#############################################################################
2289# Support for Graph interface to make Graph::Maker happy:
2290
2291sub add_vertex
2292  {
2293  my ($self,$x) = @_;
2294
2295  $self->add_node($x);
2296  $self;
2297  }
2298
2299sub add_vertices
2300  {
2301  my ($self) = shift;
2302
2303  $self->add_nodes(@_);
2304  $self;
2305  }
2306
2307sub add_path
2308  {
2309  my ($self) = shift;
2310
2311  my $first = shift;
2312
2313  while (@_)
2314    {
2315    my $second = shift;
2316    $self->add_edge($first, $second );
2317    $first = $second;
2318    }
2319  $self;
2320  }
2321
2322sub add_cycle
2323  {
2324  my ($self) = shift;
2325
2326  my $first = shift; my $a = $first;
2327
2328  while (@_)
2329    {
2330    my $second = shift;
2331    $self->add_edge($first, $second );
2332    $first = $second;
2333    }
2334  # complete the cycle
2335  $self->add_edge($first, $a);
2336  $self;
2337  }
2338
2339sub has_edge
2340  {
2341  # return true if at least one edge between X and Y exists
2342  my ($self, $x, $y) = @_;
2343
2344  # turn plaintext scalars into objects
2345  $x = $self->{nodes}->{$x} unless ref $x;
2346  $y = $self->{nodes}->{$y} unless ref $y;
2347
2348  # node does not exist => edge does not exist
2349  return 0 unless ref($x) && ref($y);
2350
2351  scalar $x->edges_to($y) ? 1 : 0;
2352  }
2353
2354sub set_vertex_attribute
2355  {
2356  my ($self, $node, $name, $value) = @_;
2357
2358  $node = $self->add_node($node);
2359  $node->set_attribute($name,$value);
2360
2361  $self;
2362  }
2363
2364sub get_vertex_attribute
2365  {
2366  my ($self, $node, $name) = @_;
2367
2368  $self->node($node)->get_attribute($name);
2369  }
2370
2371#############################################################################
2372#############################################################################
2373# Animation support
2374
2375sub animation_as_graph
2376  {
2377  my $self = shift;
2378
2379  my $graph = Graph::Easy->new();
2380
2381  $graph->add_node('onload');
2382
2383  # XXX TODO
2384
2385  $graph;
2386  }
2387
23881;
2389__END__
2390
2391=pod
2392
2393=encoding utf-8
2394
2395=head1 NAME
2396
2397Graph::Easy - Convert or render graphs (as ASCII, HTML, SVG or via Graphviz)
2398
2399=head1 SYNOPSIS
2400
2401	use Graph::Easy;
2402
2403	my $graph = Graph::Easy->new();
2404
2405	# make a fresh copy of the graph
2406	my $new_graph = $graph->copy();
2407
2408	$graph->add_edge ('Bonn', 'Berlin');
2409
2410	# will not add it, since it already exists
2411	$graph->add_edge_once ('Bonn', 'Berlin');
2412
2413	print $graph->as_ascii( ); 		# prints:
2414
2415	# +------+     +--------+
2416	# | Bonn | --> | Berlin |
2417	# +------+     +--------+
2418
2419	#####################################################
2420	# alternatively, let Graph::Easy parse some text:
2421
2422	my $graph = Graph::Easy->new( '[Bonn] -> [Berlin]' );
2423
2424	#####################################################
2425	# slightly more verbose way:
2426
2427	my $graph = Graph::Easy->new();
2428
2429	my $bonn = $graph->add_node('Bonn');
2430	$bonn->set_attribute('border', 'solid 1px black');
2431
2432	my $berlin = $graph->add_node('Berlin');
2433
2434	$graph->add_edge ($bonn, $berlin);
2435
2436	print $graph->as_ascii( );
2437
2438	# You can use plain scalars as node names and for the edge label:
2439	$graph->add_edge ('Berlin', 'Frankfurt', 'via train');
2440
2441	# adding edges with attributes:
2442
2443	my $edge = Graph::Easy::Edge->new();
2444	$edge->set_attributes( {
2445		label => 'train',
2446		style => 'dotted',
2447		color => 'red',
2448	} );
2449
2450	# now with the optional edge object
2451	$graph->add_edge ($bonn, $berlin, $edge);
2452
2453	# raw HTML section
2454	print $graph->as_html( );
2455
2456	# complete HTML page (with CSS)
2457	print $graph->as_html_file( );
2458
2459	# Other possibilities:
2460
2461	# SVG (possible after you installed Graph::Easy::As_svg):
2462	print $graph->as_svg( );
2463
2464	# Graphviz:
2465	my $graphviz = $graph->as_graphviz();
2466	open $DOT, '|dot -Tpng -o graph.png' or die ("Cannot open pipe to dot: $!");
2467	print $DOT $graphviz;
2468	close $DOT;
2469
2470	# Please see also the command line utility 'graph-easy'
2471
2472=head1 DESCRIPTION
2473
2474C<Graph::Easy> lets you generate graphs consisting of various shaped
2475nodes connected by edges (with optional labels).
2476
2477It can read and write graphs in a variety of formats, as well as render
2478them via its own grid-based layouter.
2479
2480Since the layouter works on a grid (manhattan layout), the output is
2481most useful for flow charts, network diagrams, or hierarchy trees.
2482
2483X<graph>
2484X<drawing>
2485X<diagram>
2486X<flowchart>
2487X<layout>
2488X<manhattan>
2489
2490=head2 Input
2491
2492Apart from driving the module with Perl code, you can also use
2493C<Graph::Easy::Parser> to parse graph descriptions like:
2494
2495	[ Bonn ]      --> [ Berlin ]
2496	[ Frankfurt ] <=> [ Dresden ]
2497	[ Bonn ]      --  [ Frankfurt ]
2498
2499See the C<EXAMPLES> section below for how this might be rendered.
2500
2501=head2 Creating graphs
2502
2503First, create a graph object:
2504
2505	my $graph = Graph::Easy->new();
2506
2507Then add a node to it:
2508
2509	my $node = $graph->add_node('Koblenz');
2510
2511Don't worry, adding the node again will do nothing:
2512
2513	$node = $graph->add_node('Koblenz');
2514
2515You can get back a node by its name with C<node()>:
2516
2517	$node = $graph->node('Koblenz');
2518
2519You can either add another node:
2520
2521	my $second = $graph->node('Frankfurt');
2522
2523Or add an edge straight-away:
2524
2525	my ($first,$second,$edge) = $graph->add_edge('Mainz','Ulm');
2526
2527Adding the edge the second time creates another edge from 'Mainz' to 'Ulm':
2528
2529	my $other_edge;
2530	 ($first,$second,$other_edge) = $graph->add_edge('Mainz','Ulm');
2531
2532This can be avoided by using C<add_edge_once()>:
2533
2534	my $edge = $graph->add_edge_once('Mainz','Ulm');
2535	if (defined $edge)
2536	  {
2537	  # the first time the edge was added, do something with it
2538	  $edge->set_attribute('color','blue');
2539	  }
2540
2541You can set attributes on nodes and edges:
2542
2543	$node->attribute('fill', 'yellow');
2544	$edge->attribute('label', 'train');
2545
2546It is possible to add an edge with a label:
2547
2548	$graph->add_edge('Cottbus', 'Berlin', 'my label');
2549
2550You can also add self-loops:
2551
2552	$graph->add_edge('Bremen','Bremen');
2553
2554Adding multiple nodes is easy:
2555
2556	my ($bonn,$rom) = Graph::Easy->add_nodes('Bonn','Rom');
2557
2558You can also have subgraphs (these are called groups):
2559
2560	my ($group) = Graph::Easy->add_group('Cities');
2561
2562Only nodes can be part of a group, edges are automatically considered
2563to be in the group if they lead from one node inside the group to
2564another node in the same group. There are multiple ways to add one or
2565more nodes into a group:
2566
2567	$group->add_member($bonn);
2568	$group->add_node($rom);
2569	$group->add_nodes($rom,$bonn);
2570
2571For more options please see the online manual:
2572L<http://bloodgate.com/perl/graph/manual/> .
2573
2574=head2 Output
2575
2576The output can be done in various styles:
2577
2578=over 2
2579
2580=item ASCII ART
2581
2582Uses things like C<+>, C<-> C<< < >> and C<|> to render the boxes.
2583
2584=item BOXART
2585
2586Uses Unicode box art drawing elements to output the graph.
2587
2588=item HTML
2589
2590HTML tables with CSS making everything "pretty".
2591
2592=item SVG
2593
2594Creates a Scalable Vector Graphics output.
2595
2596=item Graphviz
2597
2598Creates graphviz code that can be feed to 'dot', 'neato' or similar programs.
2599
2600=item GraphML
2601
2602Creates a textual description of the graph in the GraphML format.
2603
2604=item GDL/VCG
2605
2606Creates a textual description of the graph in the VCG or GDL (Graph
2607Description Language) format.
2608
2609=back
2610
2611X<ascii>
2612X<html>
2613X<svg>
2614X<boxart>
2615X<graphviz>
2616X<dot>
2617X<neato>
2618
2619=head1 EXAMPLES
2620
2621The following examples are given in the simple text format that is understood
2622by L<Graph::Easy::Parser|Graph::Easy::Parser>.
2623
2624You can also see many more examples at:
2625
2626L<http://bloodgate.com/perl/graph/>
2627
2628=head2 One node
2629
2630The most simple graph (apart from the empty one :) is a graph consisting of
2631only one node:
2632
2633	[ Dresden ]
2634
2635=head2 Two nodes
2636
2637A simple graph consisting of two nodes, linked together by a directed edge:
2638
2639	[ Bonn ] -> [ Berlin ]
2640
2641=head2 Three nodes
2642
2643A graph consisting of three nodes, and both are linked from the first:
2644
2645	[ Bonn ] -> [ Berlin ]
2646	[ Bonn ] -> [ Hamburg ]
2647
2648=head2 Three nodes in a chain
2649
2650A graph consisting of three nodes, showing that you can chain connections together:
2651
2652	[ Bonn ] -> [ Berlin ] -> [ Hamburg ]
2653
2654=head2 Two not connected graphs
2655
2656A graph consisting of two separate parts, both of them not connected
2657to each other:
2658
2659	[ Bonn ] -> [ Berlin ]
2660	[ Freiburg ] -> [ Hamburg ]
2661
2662=head2 Three nodes, interlinked
2663
2664A graph consisting of three nodes, and two of the are connected from
2665the first node:
2666
2667	[ Bonn ] -> [ Berlin ]
2668	[ Berlin ] -> [ Hamburg ]
2669	[ Bonn ] -> [ Hamburg ]
2670
2671=head2 Different edge styles
2672
2673A graph consisting of a couple of nodes, linked with the
2674different possible edge styles.
2675
2676	[ Bonn ] <-> [ Berlin ]		# bidirectional
2677	[ Berlin ] ==> [ Rostock ]	# double
2678	[ Hamburg ] ..> [ Altona ]	# dotted
2679	[ Dresden ] - > [ Bautzen ]	# dashed
2680	[ Leipzig ] ~~> [ Kirchhain ]	# wave
2681	[ Hof ] .-> [ Chemnitz ]	# dot-dash
2682	[ Magdeburg ] <=> [ Ulm ]	# bidrectional, double etc
2683	[ Magdeburg ] -- [ Ulm ]	# arrow-less edge
2684
2685More examples at: L<http://bloodgate.com/perl/graph/>
2686
2687=head1 ANIMATION SUPPORT
2688
2689B<Note: Animations are not yet implemented!>
2690
2691It is possible to add animations to a graph. This is done by
2692adding I<steps> via the pseudo-class C<step>:
2693
2694	step.0 {
2695	  target: Bonn;		# find object with id=Bonn, or
2696				# if this fails, the node named
2697				# "Bonn".
2698	  animate: fill:	# animate this attribute
2699	  from: yellow;		# start value (0% of duration)
2700	  via: red;		# at 50% of the duration
2701	  to: yellow;		# and 100% of duration
2702	  wait: 0;		# after triggering, wait so many seconds
2703	  duration: 5;		# entire time to go from "from" to "to"
2704	  trigger: onload;	# when to trigger this animation
2705	  repeat: 2;		# how often to repeat ("2" means two times)
2706				# also "infinite", then "next" will be ignored
2707	  next: 1;		# which step to take after repeat is up
2708	}
2709	step.1 {
2710	  from: white;		# set to white
2711	  to: white;
2712	  duration: 0.1;	# 100ms
2713	  next: 0;		# go back to step.0
2714	}
2715
2716Here two steps are created, I<0> and I<1> and the animation will
2717be going like this:
2718
2719                               0.1s
2720	                     +-------------------------------+
2721	                     v                               |
2722	+--------+  0s   +--------+  5s   +--------+  5s   +--------+
2723	| onload | ----> | step.0 | ----> | step.0 | ----> | step.1 |
2724	+--------+       +--------+       +--------+       +--------+
2725
2726You can generate a a graph with the animation flow via
2727C<animation_as_graph()>.
2728
2729=head2 Output
2730
2731Currently no output formats supports animations yet.
2732
2733=head1 METHODS
2734
2735C<Graph::Easy> supports the following methods:
2736
2737=head2 new()
2738
2739        use Graph::Easy;
2740
2741        my $graph = Graph::Easy->new( );
2742
2743Creates a new, empty C<Graph::Easy> object.
2744
2745Takes optional a hash reference with a list of options. The following are
2746valid options:
2747
2748	debug			if true, enables debug output
2749	timeout			timeout (in seconds) for the layouter
2750	fatal_errors		wrong attributes are fatal errors, default: true
2751	strict			test attribute names for being valid, default: true
2752	undirected		create an undirected graph, default: false
2753
2754=head2 copy()
2755
2756    my $copy = $graph->copy( );
2757
2758Create a copy of this graph and return it as a new Graph::Easy object.
2759
2760=head2 error()
2761
2762	my $error = $graph->error();
2763
2764Returns the last error or '' for none.
2765Optionally, takes an error message to be set.
2766
2767	$graph->error( 'Expected Foo, but found Bar.' );
2768
2769See L<warn()> on how to catch error messages. See also L<non_fatal_errors()>
2770on how to turn errors into warnings.
2771
2772=head2 warn()
2773
2774	my $warning = $graph->warn();
2775
2776Returns the last warning or '' for none.
2777Optionally, takes a warning message to be output to STDERR:
2778
2779	$graph->warn( 'Expected Foo, but found Bar.' );
2780
2781If you want to catch warnings from the layouter, enable catching
2782of warnings or errors:
2783
2784	$graph->catch_messages(1);
2785
2786	# Or individually:
2787	# $graph->catch_warnings(1);
2788	# $graph->catch_errors(1);
2789
2790	# something which warns or throws an error:
2791	...
2792
2793	if ($graph->error())
2794	  {
2795	  my @errors = $graph->errors();
2796	  }
2797	if ($graph->warning())
2798	  {
2799	  my @warnings = $graph->warnings();
2800	  }
2801
2802See L<Graph::Easy::Base> for more details on error/warning message capture.
2803
2804=head2 add_edge()
2805
2806	my ($first, $second, $edge) = $graph->add_edge( 'node 1', 'node 2');
2807
2808=head2 add_edge()
2809
2810	my ($first, $second, $edge) = $graph->add_edge( 'node 1', 'node 2');
2811	my $edge = $graph->add_edge( $x, $y, $edge);
2812	$graph->add_edge( $x, $y);
2813
2814Add an edge between nodes X and Y. The optional edge object defines
2815the style of the edge, if not present, a default object will be used.
2816
2817When called in scalar context, will return C<$edge>. In array/list context
2818it will return the two nodes and the edge object.
2819
2820C<$x> and C<$y> should be either plain scalars with the names of
2821the nodes, or objects of L<Graph::Easy::Node|Graph::Easy::Node>,
2822while the optional C<$edge> should be L<Graph::Easy::Edge|Graph::Easy::Edge>.
2823
2824Note: C<Graph::Easy> graphs are multi-edged, and adding the same edge
2825twice will result in two edges going from C<$x> to C<$y>! See
2826C<add_edge_once()> on how to avoid that.
2827
2828You can also use C<edge()> to check whether an edge from X to Y already exists
2829in the graph.
2830
2831=head2 add_edge_once()
2832
2833	my ($first, $second, $edge) = $graph->add_edge_once( 'node 1', 'node 2');
2834	my $edge = $graph->add_edge_once( $x, $y, $edge);
2835	$graph->add_edge_once( $x, $y);
2836
2837	if (defined $edge)
2838	  {
2839	  # got added once, so do something with it
2840	  $edge->set_attribute('label','unique');
2841	  }
2842
2843Adds an edge between nodes X and Y, unless there exists already
2844an edge between these two nodes. See C<add_edge()>.
2845
2846Returns undef when an edge between X and Y already exists.
2847
2848When called in scalar context, will return C<$edge>. In array/list context
2849it will return the two nodes and the edge object.
2850
2851=head2 flip_edges()
2852
2853	my $graph = Graph::Easy->new();
2854	$graph->add_edge('Bonn','Berlin');
2855	$graph->add_edge('Berlin','Bonn');
2856
2857	print $graph->as_ascii();
2858
2859	#   +--------------+
2860	#   v              |
2861	# +--------+     +------+
2862	# | Berlin | --> | Bonn |
2863	# +--------+     +------+
2864
2865	$graph->flip_edges('Bonn', 'Berlin');
2866
2867	print $graph->as_ascii();
2868
2869	#   +--------------+
2870	#   |              v
2871	# +--------+     +------+
2872	# | Berlin | --> | Bonn |
2873	# +--------+     +------+
2874
2875Turn around (transpose) all edges that are going from the first node to the
2876second node.
2877
2878X<transpose>
2879
2880=head2 add_node()
2881
2882	my $node = $graph->add_node( 'Node 1' );
2883	# or if you already have a Graph::Easy::Node object:
2884	$graph->add_node( $x );
2885
2886Add a single node X to the graph. C<$x> should be either a
2887C<Graph::Easy::Node> object, or a unique name for the node. Will do
2888nothing if the node already exists in the graph.
2889
2890It returns an L<Graph::Easy::Node> object.
2891
2892=head2 add_anon_node()
2893
2894	my $anon_node = $graph->add_anon_node( );
2895
2896Creates a single, anonymous node and adds it to the graph, returning the
2897C<Graph::Easy::Node::Anon> object.
2898
2899The created node is equal to one created via C< [ ] > in the Graph::Easy
2900text description.
2901
2902=head2 add_nodes()
2903
2904	my @nodes = $graph->add_nodes( 'Node 1', 'Node 2' );
2905
2906Add all the given nodes to the graph. The arguments should be either a
2907C<Graph::Easy::Node> object, or a unique name for the node. Will do
2908nothing if the node already exists in the graph.
2909
2910It returns a list of L<Graph::Easy::Node> objects.
2911
2912=head2 rename_node()
2913
2914	$node = $graph->rename_node($node, $new_name);
2915
2916Changes the name of a node. If the passed node is not part of
2917this graph or just a string, it will be added with the new
2918name to this graph.
2919
2920If the node was part of another graph, it will be deleted there and added
2921to this graph with the new name, effectively moving the node from the old
2922to the new graph and renaming it at the same time.
2923
2924=head2 del_node()
2925
2926	$graph->del_node('Node name');
2927	$graph->del_node($node);
2928
2929Delete the node with the given name from the graph.
2930
2931=head2 del_edge()
2932
2933	$graph->del_edge($edge);
2934
2935Delete the given edge object from the graph. You can use C<edge()> to find
2936an edge from Node A to B:
2937
2938	$graph->del_edge( $graph->edge('A','B') );
2939
2940=head2 merge_nodes()
2941
2942	$graph->merge_nodes( $first_node, $second_node );
2943	$graph->merge_nodes( $first_node, $second_node, $joiner );
2944
2945Merge two nodes. Will delete all connections between the two nodes, then
2946move over any connection to/from the second node to the first, then delete
2947the second node from the graph.
2948
2949Any attributes on the second node will be lost.
2950
2951If present, the optional C<< $joiner >> argument will be used to join
2952the label of the second node to the label of the first node. If not
2953present, the label of the second node will be dropped along with all
2954the other attributes:
2955
2956	my $graph = Graph::Easy->new('[A]->[B]->[C]->[D]');
2957
2958	# this produces "[A]->[C]->[D]"
2959	$graph->merge_nodes( 'A', 'B' );
2960
2961	# this produces "[A C]->[D]"
2962	$graph->merge_nodes( 'A', 'C', ' ' );
2963
2964	# this produces "[A C \n D]", note single quotes on the third argument!
2965	$graph->merge_nodes( 'A', 'C', ' \n ' );
2966
2967=head2 get_attribute()
2968
2969	my $value = $graph->get_attribute( $class, $name );
2970
2971Return the value of attribute C<$name> from class C<$class>.
2972
2973Example:
2974
2975	my $color = $graph->attribute( 'node', 'color' );
2976
2977You can also call all the various attribute related methods on members of the
2978graph directly, for instance:
2979
2980	$node->get_attribute('label');
2981	$edge->get_attribute('color');
2982	$group->get_attribute('fill');
2983
2984=head2 attribute()
2985
2986	my $value = $graph->attribute( $class, $name );
2987
2988Is an alias for L<get_attribute>.
2989
2990=head2 color_attribute()
2991
2992	# returns f.i. #ff0000
2993	my $color = $graph->get_color_attribute( 'node', 'color' );
2994
2995Just like L<get_attribute()>, but only for colors, and returns them as hex,
2996using the current colorscheme.
2997
2998=head2 get_color_attribute()
2999
3000Is an alias for L<color_attribute()>.
3001
3002=head2 get_attributes()
3003
3004	my $att = $object->get_attributes();
3005
3006Return all effective attributes on this object (graph/node/group/edge) as
3007an anonymous hash ref. This respects inheritance and default values.
3008
3009Note that this does not include custom attributes.
3010
3011See also L<get_custom_attributes> and L<raw_attributes()>.
3012
3013=head2 get_custom_attributes()
3014
3015	my $att = $object->get_custom_attributes();
3016
3017Return all the custom attributes on this object (graph/node/group/edge) as
3018an anonymous hash ref.
3019
3020=head2 custom_attributes()
3021
3022	my $att = $object->custom_attributes();
3023
3024C<< custom_attributes() >> is an alias for L<< get_custom_attributes >>.
3025
3026=head2 raw_attributes()
3027
3028	my $att = $object->raw_attributes();
3029
3030Return all set attributes on this object (graph, node, group or edge) as
3031an anonymous hash ref. Thus you get all the locally active attributes
3032for this object.
3033
3034Inheritance is respected, e.g. attributes that have the value "inherit"
3035and are inheritable, will be inherited from the base class.
3036
3037But default values for unset attributes are skipped. Here is an example:
3038
3039	node { color: red; }
3040
3041	[ A ] { class: foo; color: inherit; }
3042
3043This will return:
3044
3045	{ class => foo, color => red }
3046
3047As you can see, attributes like C<background> etc. are not included, while
3048the color value was inherited properly.
3049
3050See also L<get_attributes()>.
3051
3052=head2 default_attribute()
3053
3054	my $def = $graph->default_attribute($class, 'fill');
3055
3056Returns the default value for the given attribute B<in the class>
3057of the object.
3058
3059The default attribute is the value that will be used if
3060the attribute on the object itself, as well as the attribute
3061on the class is unset.
3062
3063To find out what attribute is on the class, use the three-arg form
3064of L<attribute> on the graph:
3065
3066	my $g = Graph::Easy->new();
3067	my $node = $g->add_node('Berlin');
3068
3069	print $node->attribute('fill'), "\n";		# print "white"
3070	print $node->default_attribute('fill'), "\n";	# print "white"
3071	print $g->attribute('node','fill'), "\n";	# print "white"
3072
3073	$g->set_attribute('node','fill','red');		# class is "red"
3074	$node->set_attribute('fill','green');		# this object is "green"
3075
3076	print $node->attribute('fill'), "\n";		# print "green"
3077	print $node->default_attribute('fill'), "\n";	# print "white"
3078	print $g->attribute('node','fill'), "\n";	# print "red"
3079
3080See also L<raw_attribute()>.
3081
3082=head2 raw_attribute()
3083
3084	my $value = $object->raw_attribute( $name );
3085
3086Return the value of attribute C<$name> from the object it this
3087method is called on (graph, node, edge, group etc.). If the
3088attribute is not set on the object itself, returns undef.
3089
3090This method respects inheritance, so an attribute value of 'inherit'
3091on an object will make the method return the inherited value:
3092
3093	my $g = Graph::Easy->new();
3094	my $n = $g->add_node('A');
3095
3096	$g->set_attribute('color','red');
3097
3098	print $n->raw_attribute('color');		# undef
3099	$n->set_attribute('color','inherit');
3100	print $n->raw_attribute('color');		# 'red'
3101
3102See also L<attribute()>.
3103
3104=head2 raw_color_attribute()
3105
3106	# returns f.i. #ff0000
3107	my $color = $graph->raw_color_attribute('color' );
3108
3109Just like L<raw_attribute()>, but only for colors, and returns them as hex,
3110using the current colorscheme.
3111
3112If the attribute is not set on the object, returns C<undef>.
3113
3114=head2 raw_attributes()
3115
3116	my $att = $object->raw_attributes();
3117
3118Returns a hash with all the raw attributes of that object.
3119Attributes that are no set on the object itself, but on
3120the class this object belongs to are B<not> included.
3121
3122This method respects inheritance, so an attribute value of 'inherit'
3123on an object will make the method return the inherited value.
3124
3125=head2 set_attribute()
3126
3127	# Set the attribute on the given class.
3128	$graph->set_attribute( $class, $name, $val );
3129
3130	# Set the attribute on the graph itself. This is synonymous
3131	# to using 'graph' as class in the form above.
3132	$graph->set_attribute( $name, $val );
3133
3134Sets a given attribute named C<$name> to the new value C<$val> in the class
3135specified in C<$class>.
3136
3137Example:
3138
3139	$graph->set_attribute( 'graph', 'gid', '123' );
3140
3141The class can be one of C<graph>, C<edge>, C<node> or C<group>. The last
3142three can also have subclasses like in C<node.subclassname>.
3143
3144You can also call the various attribute related methods on members of the
3145graph directly, for instance:
3146
3147	$node->set_attribute('label', 'my node');
3148	$edge->set_attribute('color', 'red');
3149	$group->set_attribute('fill', 'green');
3150
3151=head2 set_attributes()
3152
3153	$graph->set_attributes( $class, $att );
3154
3155Given a class name in C<$class> and a hash of mappings between attribute names
3156and values in C<$att>, will set all these attributes.
3157
3158The class can be one of C<graph>, C<edge>, C<node> or C<group>. The last
3159three can also have subclasses like in C<node.subclassname>.
3160
3161Example:
3162
3163	$graph->set_attributes( 'node', { color => 'red', background => 'none' } );
3164
3165=head2 del_attribute()
3166
3167	$graph->del_attribute('border');
3168
3169Delete the attribute with the given name from the object.
3170
3171You can also call the various attribute related methods on members of the
3172graph directly, for instance:
3173
3174	$node->del_attribute('label');
3175	$edge->del_attribute('color');
3176	$group->del_attribute('fill');
3177
3178=head2 unquote_attribute()
3179
3180	# returns '"Hello World!"'
3181	my $value = $self->unquote_attribute('node','label','"Hello World!"');
3182	# returns 'red'
3183	my $color = $self->unquote_attribute('node','color','"red"');
3184
3185Return the attribute unquoted except for labels and titles, that is it removes
3186double quotes at the start and the end of the string, unless these are
3187escaped with a backslash.
3188
3189=head2 border_attribute()
3190
3191  	my $border = $graph->border_attribute();
3192
3193Return the combined border attribute like "1px solid red" from the
3194border(style|color|width) attributes.
3195
3196=head2 split_border_attributes()
3197
3198  	my ($style,$width,$color) = $graph->split_border_attribute($border);
3199
3200Split the border attribute (like "1px solid red") into the three different parts.
3201
3202=head2 quoted_comment()
3203
3204	my $cmt = $node->comment();
3205
3206Comment of this object, quoted suitable as to be embedded into HTML/SVG.
3207Returns the empty string if this object doesn't have a comment set.
3208
3209=head2 flow()
3210
3211	my $flow = $graph->flow();
3212
3213Returns the flow of the graph, as absolute number in degress.
3214
3215=head2 source_nodes()
3216
3217	my @roots = $graph->source_nodes();
3218
3219Returns all nodes that have only outgoing edges, e.g. are the root of a tree,
3220in no particular order.
3221
3222Isolated nodes (no edges at all) will B<not> be included, see
3223L<predecessorless_nodes()> to get these, too.
3224
3225In scalar context, returns the number of source nodes.
3226
3227=head2 predecessorless_nodes()
3228
3229	my @roots = $graph->predecessorless_nodes();
3230
3231Returns all nodes that have no incoming edges, regardless of whether
3232they have outgoing edges or not, in no particular order.
3233
3234Isolated nodes (no edges at all) B<will> be included in the list.
3235
3236See also L<source_nodes()>.
3237
3238In scalar context, returns the number of predecessorless nodes.
3239
3240=head2 root_node()
3241
3242	my $root = $graph->root_node();
3243
3244Return the root node as L<Graph::Easy::Node> object, if it was
3245set with the 'root' attribute.
3246
3247=head2 timeout()
3248
3249	print $graph->timeout(), " seconds timeout for layouts.\n";
3250	$graph->timeout(12);
3251
3252Get/set the timeout for layouts in seconds. If the layout process did not
3253finish after that time, it will be stopped and a warning will be printed.
3254
3255The default timeout is 5 seconds.
3256
3257=head2 strict()
3258
3259	print "Graph has strict checking\n" if $graph->strict();
3260	$graph->strict(undef);		# disable strict attribute checks
3261
3262Get/set the strict option. When set to a true value, all attribute names and
3263values will be strictly checked and unknown/invalid one will be rejected.
3264
3265This option is on by default.
3266
3267=head2 type()
3268
3269	print "Graph is " . $graph->type() . "\n";
3270
3271Returns the type of the graph as string, either "directed" or "undirected".
3272
3273=head2 layout()
3274
3275	$graph->layout();
3276	$graph->layout( type => 'force', timeout => 60 );
3277
3278Creates the internal structures to layout the graph.
3279
3280This method will be called automatically when you call any of the
3281C<as_FOO> methods or C<output()> as described below.
3282
3283The options are:
3284
3285	type		the type of the layout, possible values:
3286			'force'		- force based layouter
3287			'adhoc'		- the default layouter
3288	timeout		timeout in seconds
3289
3290See also: L<timeout()>.
3291
3292=head2 output_format()
3293
3294	$graph->output_format('html');
3295
3296Set the outputformat. One of 'html', 'ascii', 'graphviz', 'svg' or 'txt'.
3297See also L<output()>.
3298
3299=head2 output()
3300
3301	my $out = $graph->output();
3302
3303Output the graph in the format set by C<output_format()>.
3304
3305=head2 as_ascii()
3306
3307	print $graph->as_ascii();
3308
3309Return the graph layout in ASCII art, in utf-8.
3310
3311=head2 as_ascii_file()
3312
3313	print $graph->as_ascii_file();
3314
3315Is an alias for L<as_ascii>.
3316
3317=head2 as_ascii_html()
3318
3319	print $graph->as_ascii_html();
3320
3321Return the graph layout in ASCII art, suitable to be embedded into an HTML
3322page. Basically it wraps the output from L<as_ascii()> into
3323C<< <pre> </pre> >> and inserts real HTML links. The returned
3324string is in utf-8.
3325
3326=head2 as_boxart()
3327
3328	print $graph->as_box();
3329
3330Return the graph layout as box drawing using Unicode characters (in utf-8,
3331as always).
3332
3333=head2 as_boxart_file()
3334
3335	print $graph->as_boxart_file();
3336
3337Is an alias for C<as_box>.
3338
3339=head2 as_boxart_html()
3340
3341	print $graph->as_boxart_html();
3342
3343Return the graph layout as box drawing using Unicode characters,
3344as chunk that can be embedded into an HTML page.
3345
3346Basically it wraps the output from L<as_boxart()> into
3347C<< <pre> </pre> >> and inserts real HTML links. The returned
3348string is in utf-8.
3349
3350=head2 as_boxart_html_file()
3351
3352	print $graph->as_boxart_html_file();
3353
3354Return the graph layout as box drawing using Unicode characters,
3355as a full HTML page complete with header and footer.
3356
3357=head2 as_html()
3358
3359	print $graph->as_html();
3360
3361Return the graph layout as HTML section. See L<css()> to get the
3362CSS section to go with that HTML code. If you want a complete HTML page
3363then use L<as_html_file()>.
3364
3365=head2 as_html_page()
3366
3367	print $graph->as_html_page();
3368
3369Is an alias for C<as_html_file>.
3370
3371=head2 as_html_file()
3372
3373	print $graph->as_html_file();
3374
3375Return the graph layout as HTML complete with headers, CSS section and
3376footer. Can be viewed in the browser of your choice.
3377
3378=head2 add_group()
3379
3380	my $group = $graph->add_group('Group name');
3381
3382Add a group to the graph and return it as L<Graph::Easy::Group> object.
3383
3384=head2 group()
3385
3386	my $group = $graph->group('Name');
3387
3388Returns the group with the name C<Name> as L<Graph::Easy::Group> object.
3389
3390=head2 rename_group()
3391
3392	$group = $graph->rename_group($group, $new_name);
3393
3394Changes the name of the given group. If the passed group is not part of
3395this graph or just a string, it will be added with the new
3396name to this graph.
3397
3398If the group was part of another graph, it will be deleted there and added
3399to this graph with the new name, effectively moving the group from the old
3400to the new graph and renaming it at the same time.
3401
3402=head2 groups()
3403
3404	my @groups = $graph->groups();
3405
3406Returns the groups of the graph as L<Graph::Easy::Group> objects,
3407in arbitrary order.
3408
3409=head2 groups_within()
3410
3411	# equivalent to $graph->groups():
3412	my @groups = $graph->groups_within();		# all
3413	my @toplevel_groups = $graph->groups_within(0);	# level 0 only
3414
3415Return the groups that are inside this graph, up to the specified level,
3416in arbitrary order.
3417
3418The default level is -1, indicating no bounds and thus all contained
3419groups are returned.
3420
3421A level of 0 means only the direct children, and hence only the toplevel
3422groups will be returned. A level 1 means the toplevel groups and their
3423toplevel children, and so on.
3424
3425=head2 anon_groups()
3426
3427	my $anon_groups = $graph->anon_groups();
3428
3429In scalar context, returns the number of anon groups (aka
3430L<Graph::Easy::Group::Anon>) the graph has.
3431
3432In list context, returns all anon groups as objects, in arbitrary order.
3433
3434=head2 del_group()
3435
3436	$graph->del_group($name);
3437
3438Delete the group with the given name.
3439
3440=head2 edges(), edges_within()
3441
3442	my @edges = $graph->edges();
3443
3444Returns the edges of the graph as L<Graph::Easy::Edge> objects,
3445in arbitrary order.
3446
3447L<edges_within()> is an alias for C<edges()>.
3448
3449=head2 is_simple_graph(), is_simple()
3450
3451	if ($graph->is_simple())
3452	  {
3453	  }
3454
3455Returns true if the graph does not have multiedges, e.g. if it
3456does not have more than one edge going from any node to any other
3457node or group.
3458
3459Since this method has to look at all edges, it is costly in terms of
3460both CPU and memory.
3461
3462=head2 is_directed()
3463
3464	if ($graph->is_directed())
3465	  {
3466	  }
3467
3468Returns true if the graph is directed.
3469
3470=head2 is_undirected()
3471
3472	if ($graph->is_undirected())
3473	  {
3474	  }
3475
3476Returns true if the graph is undirected.
3477
3478=head2 parent()
3479
3480	my $parent = $graph->parent();
3481
3482Returns the parent graph, for graphs this is undef.
3483
3484=head2 label()
3485
3486	my $label = $graph->label();
3487
3488Returns the label of the graph.
3489
3490=head2 title()
3491
3492	my $title = $graph->title();
3493
3494Returns the (mouseover) title of the graph.
3495
3496=head2 link()
3497
3498	my $link = $graph->link();
3499
3500Return a potential link (for the graphs label), build from the attributes C<linkbase>
3501and C<link> (or autolink). Returns '' if there is no link.
3502
3503=head2 as_graphviz()
3504
3505	print $graph->as_graphviz();
3506
3507Return the graph as graphviz code, suitable to be feed to a program like
3508C<dot> etc.
3509
3510=head2 as_graphviz_file()
3511
3512	print $graph->as_graphviz_file();
3513
3514Is an alias for L<as_graphviz()>.
3515
3516=head2 angle()
3517
3518        my $degrees = Graph::Easy->angle( 'south' );
3519        my $degrees = Graph::Easy->angle( 120 );
3520
3521Check an angle for being valid and return a value between -359 and 359
3522degrees. The special values C<south>, C<north>, C<west>, C<east>, C<up>
3523and C<down> are also valid and converted to degrees.
3524
3525=head2 nodes()
3526
3527	my $nodes = $graph->nodes();
3528
3529In scalar context, returns the number of nodes/vertices the graph has.
3530
3531In list context, returns all nodes as objects, in arbitrary order.
3532
3533=head2 anon_nodes()
3534
3535	my $anon_nodes = $graph->anon_nodes();
3536
3537In scalar context, returns the number of anon nodes (aka
3538L<Graph::Easy::Node::Anon>) the graph has.
3539
3540In list context, returns all anon nodes as objects, in arbitrary order.
3541
3542=head2 html_page_header()
3543
3544	my $header = $graph->html_page_header();
3545	my $header = $graph->html_page_header($css);
3546
3547Return the header of an HTML page. Used together with L<html_page_footer>
3548by L<as_html_page> to construct a complete HTML page.
3549
3550Takes an optional parameter with the CSS styles to be inserted into the
3551header. If C<$css> is not defined, embedds the result of C<< $self->css() >>.
3552
3553=head2 html_page_footer()
3554
3555	my $footer = $graph->html_page_footer();
3556
3557Return the footer of an HTML page. Used together with L<html_page_header>
3558by L<as_html_page> to construct a complete HTML page.
3559
3560=head2 css()
3561
3562	my $css = $graph->css();
3563
3564Return CSS code for that graph. See L<as_html()>.
3565
3566=head2 as_txt()
3567
3568	print $graph->as_txt();
3569
3570Return the graph as a normalized textual representation, that can be
3571parsed with L<Graph::Easy::Parser> back to the same graph.
3572
3573This does not call L<layout()> since the actual text representation
3574is just a dump of the graph.
3575
3576=head2 as_txt_file()
3577
3578	print $graph->as_txt_file();
3579
3580Is an alias for L<as_txt()>.
3581
3582=head2 as_svg()
3583
3584	print $graph->as_svg();
3585
3586Return the graph as SVG (Scalable Vector Graphics), which can be
3587embedded into HTML pages. You need to install
3588L<Graph::Easy::As_svg> first to make this work.
3589
3590See also L<as_svg_file()>.
3591
3592B<Note:> You need L<Graph::Easy::As_svg> installed for this to work!
3593
3594=head2 as_svg_file()
3595
3596	print $graph->as_svg_file();
3597
3598Returns SVG just like C<as_svg()>, but this time as standalone SVG,
3599suitable for storing it in a file and referencing it externally.
3600
3601After calling C<as_svg_file()> or C<as_svg()>, you can retrieve
3602some SVG information, notable C<width> and C<height> via
3603C<svg_information>.
3604
3605B<Note:> You need L<Graph::Easy::As_svg> installed for this to work!
3606
3607=head2 svg_information()
3608
3609	my $info = $graph->svg_information();
3610
3611	print "Size: $info->{width}, $info->{height}\n";
3612
3613Return information about the graph created by the last
3614C<as_svg()> or C<as_svg_file()> call.
3615
3616The following fields are set:
3617
3618	width		width of the SVG in pixels
3619	height		height of the SVG in pixels
3620
3621B<Note:> You need L<Graph::Easy::As_svg> installed for this to work!
3622
3623=head2 as_vcg()
3624
3625	print $graph->as_vcg();
3626
3627Return the graph as VCG text. VCG is a subset of GDL (Graph Description
3628Language).
3629
3630This does not call L<layout()> since the actual text representation
3631is just a dump of the graph.
3632
3633=head2 as_vcg_file()
3634
3635	print $graph->as_vcg_file();
3636
3637Is an alias for L<as_vcg()>.
3638
3639=head2 as_gdl()
3640
3641	print $graph->as_gdl();
3642
3643Return the graph as GDL (Graph Description Language) text. GDL is a superset
3644of VCG.
3645
3646This does not call L<layout()> since the actual text representation
3647is just a dump of the graph.
3648
3649=head2 as_gdl_file()
3650
3651	print $graph->as_gdl_file();
3652
3653Is an alias for L<as_gdl()>.
3654
3655=head2 as_graphml()
3656
3657	print $graph->as_graphml();
3658
3659Return the graph as a GraphML representation.
3660
3661This does not call L<layout()> since the actual text representation
3662is just a dump of the graph.
3663
3664The output contains only the set attributes, e.g. default attribute values
3665are not specifically mentioned. The attribute names and values are the
3666in the format that C<Graph::Easy> defines.
3667
3668=head2 as_graphml_file()
3669
3670	print $graph->as_graphml_file();
3671
3672Is an alias for L<as_graphml()>.
3673
3674=head2 sorted_nodes()
3675
3676	my $nodes =
3677	 $graph->sorted_nodes( );		# default sort on 'id'
3678	my $nodes =
3679	 $graph->sorted_nodes( 'name' );	# sort on 'name'
3680	my $nodes =
3681	 $graph->sorted_nodes( 'layer', 'id' );	# sort on 'layer', then on 'id'
3682
3683In scalar context, returns the number of nodes/vertices the graph has.
3684In list context returns a list of all the node objects (as reference),
3685sorted by their attribute(s) given as arguments. The default is 'id',
3686e.g. their internal ID number, which amounts more or less to the order
3687they have been inserted.
3688
3689This routine will sort the nodes by their group first, so the requested
3690sort order will be only valid if there are no groups or inside each
3691group.
3692
3693=head2 as_debug()
3694
3695	print $graph->as_debug();
3696
3697Return debugging information like version numbers of used modules,
3698and a textual representation of the graph.
3699
3700This does not call L<layout()> since the actual text representation
3701is more a dump of the graph, than a certain layout.
3702
3703=head2 node()
3704
3705	my $node = $graph->node('node name');
3706
3707Return node by unique name (case sensitive). Returns undef if the node
3708does not exist in the graph.
3709
3710=head2 edge()
3711
3712	my $edge = $graph->edge( $x, $y );
3713
3714Returns the edge objects between nodes C<$x> and C<$y>. Both C<$x> and C<$y>
3715can be either scalars with names or C<Graph::Easy::Node> objects.
3716
3717Returns undef if the edge does not yet exist.
3718
3719In list context it will return all edges from C<$x> to C<$y>, in
3720scalar context it will return only one (arbitrary) edge.
3721
3722=head2 id()
3723
3724	my $graph_id = $graph->id();
3725	$graph->id('123');
3726
3727Returns the id of the graph. You can also set a new ID with this routine. The
3728default is ''.
3729
3730The graph's ID is used to generate unique CSS classes for each graph, in the
3731case you want to have more than one graph in an HTML page.
3732
3733=head2 seed()
3734
3735	my $seed = $graph->seed();
3736	$graph->seed(2);
3737
3738Get/set the random seed for the graph object. See L<randomize()>
3739for a method to set a random seed.
3740
3741The seed is used to create random numbers for the layouter. For
3742the same graph, the same seed will always lead to the same layout.
3743
3744=head2 randomize()
3745
3746	$graph->randomize();
3747
3748Set a random seed for the graph object. See L<seed()>.
3749
3750=head2 debug()
3751
3752	my $debug = $graph->debug();	# get
3753	$graph->debug(1);		# enable
3754	$graph->debug(0);		# disable
3755
3756Enable, disable or read out the debug status. When the debug status is true,
3757additional debug messages will be printed on STDERR.
3758
3759=head2 score()
3760
3761	my $score = $graph->score();
3762
3763Returns the score of the graph, or undef if L<layout()> has not yet been called.
3764
3765Higher scores are better, although you cannot compare scores for different
3766graphs. The score should only be used to compare different layouts of the same
3767graph against each other:
3768
3769	my $max = undef;
3770
3771	$graph->randomize();
3772	my $seed = $graph->seed();
3773
3774	$graph->layout();
3775	$max = $graph->score();
3776
3777	for (1..10)
3778	  {
3779	  $graph->randomize();			# select random seed
3780	  $graph->layout();			# layout with that seed
3781	  if ($graph->score() > $max)
3782	    {
3783	    $max = $graph->score();		# store the new max store
3784	    $seed = $graph->seed();		# and it's seed
3785	    }
3786	  }
3787
3788	# redo the best layout
3789	if ($seed ne $graph->seed())
3790	  {
3791	  $graph->seed($seed);
3792	  $graph->layout();
3793	  }
3794	# output graph:
3795	print $graph->as_ascii();		# or as_html() etc
3796
3797=head2 valid_attribute()
3798
3799	my $graph = Graph::Easy->new();
3800	my $new_value =
3801	  $graph->valid_attribute( $name, $value, $class );
3802
3803	if (ref($new_value) eq 'ARRAY' && @$new_value == 0)
3804	  {
3805	  # throw error
3806          die ("'$name' is not a valid attribute name for '$class'")
3807		if $self->{_warn_on_unused_attributes};
3808	  }
3809	elsif (!defined $new_value)
3810	  {
3811	  # throw error
3812          die ("'$value' is no valid '$name' for '$class'");
3813	  }
3814
3815Deprecated, please use L<validate_attribute()>.
3816
3817Check that a C<$name,$value> pair is a valid attribute in class C<$class>,
3818and returns a new value.
3819
3820It returns an array ref if the attribute name is invalid, and undef if the
3821value is invalid.
3822
3823The return value can differ from the passed in value, f.i.:
3824
3825	print $graph->valid_attribute( 'color', 'red' );
3826
3827This would print '#ff0000';
3828
3829=head2 validate_attribute()
3830
3831	my $graph = Graph::Easy->new();
3832	my ($rc,$new_name, $new_value) =
3833	  $graph->validate_attribute( $name, $value, $class );
3834
3835Checks a given attribute name and value (or values, in case of a
3836value like "red|green") for being valid. It returns a new
3837attribute name (in case of "font-color" => "fontcolor") and
3838either a single new attribute, or a list of attribute values
3839as array ref.
3840
3841If C<$rc> is defined, it is the error number:
3842
3843	1			unknown attribute name
3844	2			invalid attribute value
3845	4			found multiple attributes, but these arent
3846				allowed at this place
3847
3848=head2 color_as_hex()
3849
3850	my $hexred   = Graph::Easy->color_as_hex( 'red' );
3851	my $hexblue  = Graph::Easy->color_as_hex( '#0000ff' );
3852	my $hexcyan  = Graph::Easy->color_as_hex( '#f0f' );
3853	my $hexgreen = Graph::Easy->color_as_hex( 'rgb(0,255,0)' );
3854
3855Takes a valid color name or definition (hex, short hex, or RGB) and returns the
3856color in hex like C<#ff00ff>.
3857
3858=head2 color_value($color_name, $color_scheme)
3859
3860	my $color = Graph::Easy->color_name( 'red' );	# #ff0000
3861	print Graph::Easy->color_name( '#ff0000' );	# #ff0000
3862
3863	print Graph::Easy->color_name( 'snow', 'x11' );
3864
3865Given a color name, returns the color in hex. See L<color_name>
3866for a list of possible values for the optional C<$color_scheme>
3867parameter.
3868
3869=head2 color_name($color_value, $color_scheme)
3870
3871	my $color = Graph::Easy->color_name( 'red' );	# red
3872	print Graph::Easy->color_name( '#ff0000' );	# red
3873
3874	print Graph::Easy->color_name( 'snow', 'x11' );
3875
3876Takes a hex color value and returns the name of the color.
3877
3878The optional parameter is the color scheme, where the following
3879values are possible:
3880
3881 w3c			(the default)
3882 x11			(what graphviz uses as default)
3883
3884Plus the following ColorBrewer schemes are supported, see the
3885online manual for examples and their usage:
3886
3887 accent3 accent4 accent5 accent6 accent7 accent8
3888
3889 blues3 blues4 blues5 blues6 blues7 blues8 blues9
3890
3891 brbg3 brbg4 brbg5 brbg6 brbg7 brbg8 brbg9 brbg10 brbg11
3892
3893 bugn3 bugn4 bugn5 bugn6 bugn7 bugn8 bugn9 bupu3 bupu4 bupu5 bupu6 bupu7
3894 bupu8 bupu9
3895
3896 dark23 dark24 dark25 dark26 dark27 dark28
3897
3898 gnbu3 gnbu4 gnbu5 gnbu6 gnbu7 gnbu8 gnbu9
3899
3900 greens3 greens4 greens5 greens6 greens7 greens8 greens9
3901
3902 greys3 greys4 greys5 greys6 greys7 greys8 greys9
3903
3904 oranges3 oranges4 oranges5 oranges6 oranges7 oranges8 oranges9
3905
3906 orrd3 orrd4 orrd5 orrd6 orrd7 orrd8 orrd9
3907
3908 paired3 paired4 paired5 paired6 paired7 paired8 paired9 paired10 paired11
3909 paired12
3910
3911 pastel13 pastel14 pastel15 pastel16 pastel17 pastel18 pastel19
3912
3913 pastel23 pastel24 pastel25 pastel26 pastel27 pastel28
3914
3915 piyg3 piyg4 piyg5 piyg6 piyg7 piyg8 piyg9 piyg10 piyg11
3916
3917 prgn3 prgn4 prgn5 prgn6 prgn7 prgn8 prgn9 prgn10 prgn11
3918
3919 pubu3 pubu4 pubu5 pubu6 pubu7 pubu8 pubu9
3920
3921 pubugn3 pubugn4 pubugn5 pubugn6 pubugn7 pubugn8 pubugn9
3922
3923 puor3 puor4 puor5 puor6 puor7 puor8 puor9 puor10 puor11
3924
3925 purd3 purd4 purd5 purd6 purd7 purd8 purd9
3926
3927 purples3 purples4 purples5 purples6 purples7 purples8 purples9
3928
3929 rdbu3 rdbu4 rdbu5 rdbu6 rdbu7 rdbu8 rdbu9 rdbu10 rdbu11
3930
3931 rdgy3 rdgy4 rdgy5 rdgy6 rdgy7 rdgy8 rdgy9
3932
3933 rdpu3 rdpu4 rdpu5 rdpu6 rdpu7 rdpu8 rdpu9 rdgy10 rdgy11
3934
3935 rdylbu3 rdylbu4 rdylbu5 rdylbu6 rdylbu7 rdylbu8 rdylbu9 rdylbu10 rdylbu11
3936
3937 rdylgn3 rdylgn4 rdylgn5 rdylgn6 rdylgn7 rdylgn8 rdylgn9 rdylgn10 rdylgn11
3938
3939 reds3 reds4 reds5 reds6 reds7 reds8 reds9
3940
3941 set13 set14 set15 set16 set17 set18 set19
3942
3943 set23 set24 set25 set26 set27 set28
3944
3945 set33 set34 set35 set36 set37 set38 set39 set310 set311 set312
3946
3947 spectral3 spectral4 spectral5 spectral6 spectral7 spectral8 spectral9
3948 spectral10 spectral11
3949
3950 ylgn3 ylgn4 ylgn5 ylgn6 ylgn7 ylgn8 ylgn9
3951
3952 ylgnbu3 ylgnbu4 ylgnbu5 ylgnbu6 ylgnbu7 ylgnbu8 ylgnbu9
3953
3954 ylorbr3 ylorbr4 ylorbr5 ylorbr6 ylorbr7 ylorbr8 ylorbr9
3955
3956 ylorrd3 ylorrd4 ylorrd5 ylorrd6 ylorrd7 ylorrd8 ylorrd9
3957
3958=head2 color_names()
3959
3960	my $names = Graph::Easy->color_names();
3961
3962Return a hash with name => value mapping for all known colors.
3963
3964=head2 text_style()
3965
3966	if ($graph->text_style('bold, italic'))
3967	  {
3968	  ...
3969	  }
3970
3971Checks the given style list for being valid.
3972
3973=head2 text_styles()
3974
3975	my $styles = $graph->text_styles();	# or $edge->text_styles() etc.
3976
3977	if ($styles->{'italic'})
3978	  {
3979	  print 'is italic\n';
3980	  }
3981
3982Return a hash with the given text-style properties, aka 'underline', 'bold' etc.
3983
3984=head2 text_styles_as_css()
3985
3986	my $styles = $graph->text_styles_as_css();	# or $edge->...() etc.
3987
3988Return the text styles as a chunk of CSS styling that can be embedded into
3989a C< style="" > parameter.
3990
3991=head2 use_class()
3992
3993	$graph->use_class('node', 'Graph::Easy::MyNode');
3994
3995Override the class to be used to constructs objects when calling
3996C<add_edge()>, C<add_group()> or C<add_node()>.
3997
3998The first parameter can be one of the following:
3999
4000	node
4001	edge
4002	group
4003
4004Please see the documentation about C<use_class()> in C<Graph::Easy::Parser>
4005for examples and details.
4006
4007=head2 animation_as_graph()
4008
4009	my $graph_2 = $graph->animation_as_graph();
4010	print $graph_2->as_ascii();
4011
4012Returns the animation of C<$graph> as a graph describing the flow of the
4013animation. Useful for debugging animation flows.
4014
4015=head2 add_cycle()
4016
4017	$graph->add_cycle('A','B','C');		# A -> B -> C -> A
4018
4019Compatibility method for Graph, adds the edges between each node
4020and back from the last node to the first. Returns the graph.
4021
4022=head2 add_path()
4023
4024	$graph->add_path('A','B','C');		# A -> B -> C
4025
4026Compatibility method for Graph, adds the edges between each node.
4027Returns the graph.
4028
4029=head2 add_vertex()
4030
4031	$graph->add_vertex('A');
4032
4033Compatibility method for Graph, adds the node and returns the graph.
4034
4035=head2 add_vertices()
4036
4037	$graph->add_vertices('A','B');
4038
4039Compatibility method for Graph, adds these nodes and returns the graph.
4040
4041=head2 has_edge()
4042
4043	$graph->has_edge('A','B');
4044
4045Compatibility method for Graph, returns true if at least one edge between
4046A and B exists.
4047
4048=head2 vertices()
4049
4050Compatibility method for Graph, returns in scalar context the number
4051of nodes this graph has, in list context a (arbitrarily sorted) list
4052of node objects.
4053
4054=head2 set_vertex_attribute()
4055
4056	$graph->set_vertex_attribute( 'A', 'fill', '#deadff' );
4057
4058Compatibility method for Graph, set the named vertex attribute.
4059
4060Please note that this routine will only accept Graph::Easy attribute
4061names and values. If you want to attach custom attributes, you need to
4062start their name with 'x-':
4063
4064	$graph->set_vertex_attribute( 'A', 'x-foo', 'bar' );
4065
4066=head2 get_vertex_attribute()
4067
4068	my $fill = $graph->get_vertex_attribute( 'A', 'fill' );
4069
4070Compatibility method for Graph, get the named vertex attribute.
4071
4072Please note that this routine will only accept Graph::Easy attribute
4073names. See L<set_vertex_attribute()>.
4074
4075=head1 EXPORT
4076
4077Exports nothing.
4078
4079=head1 SEE ALSO
4080
4081L<Graph>, L<Graph::Convert>, L<Graph::Easy::As_svg>, L<Graph::Easy::Manual> and
4082L<Graph::Easy::Parser>.
4083
4084=head2 Related Projects
4085
4086L<Graph::Layout::Aesthetic>, L<Graph> and L<Text::Flowchart>.
4087
4088There is also an very old, unrelated project from ca. 1995, which does something similar.
4089See L<http://rw4.cs.uni-sb.de/users/sander/html/gsvcg1.html>.
4090
4091Testcases and more examples under:
4092
4093L<http://bloodgate.com/perl/graph/>.
4094
4095=head1 LIMITATIONS
4096
4097This module is now quite complete, but there are still some limitations.
4098Hopefully further development will lift these.
4099
4100=head2 Scoring
4101
4102Scoring is not yet implemented, each generated graph will be the same regardless
4103of the random seed.
4104
4105=head2 Layouter
4106
4107The layouter can not yet handle links between groups (or between
4108a group and a node, or vice versa). These links will thus only
4109appear in L<as_graphviz()> or L<as_txt()> output.
4110
4111=head2 Paths
4112
4113=over 2
4114
4115=item No optimizations
4116
4117In complex graphs, non-optimal layout part like this one might appear:
4118
4119	+------+     +--------+
4120	| Bonn | --> | Berlin | --> ...
4121	+------+     +--------+
4122	               ^
4123	               |
4124	               |
4125	+---------+    |
4126	| Kassel  | ---+
4127	+---------+
4128
4129A second-stage optimizer that simplifies these layouts is not yet implemented.
4130
4131In addition the general placement/processing strategy as well as the local
4132strategy might be improved.
4133
4134=item attributes
4135
4136The following attributes are currently ignored by the layouter:
4137
4138	undirected graphs
4139	autosplit/autojoin for edges
4140	tail/head label/title/link for edges
4141
4142=item groups
4143
4144The layouter is not fully recursive yet, so groups do not properly nest.
4145
4146In addition, links to/from groups are missing, too.
4147
4148=back
4149
4150=head2 Output formats
4151
4152Some output formats are not yet complete in their
4153implementation. Please see the online manual at
4154L<http://bloodgate.com/perl/graph/manual> under "Output" for
4155details.
4156
4157X<graph>
4158X<manual>
4159X<online>
4160
4161=head1 LICENSE
4162
4163This library is free software; you can redistribute it and/or modify
4164it under the terms of the GPL 2.0 or a later version.
4165
4166See the LICENSE file for a copy of the GPL.
4167
4168This product includes color specifications and designs developed by Cynthia
4169Brewer (http://colorbrewer.org/). See the LICENSE file for the full license
4170text that applies to these color schemes.
4171
4172X<gpl>
4173X<apache-style>
4174X<cynthia>
4175X<brewer>
4176X<colorscheme>
4177X<license>
4178
4179=head1 NAME CHANGE
4180
4181The package was formerly known as C<Graph::Simple>. The name was changed
4182for two reasons:
4183
4184=over 2
4185
4186=item *
4187
4188In graph theory, a C<simple> graph is a special type of graph. This software,
4189however, supports more than simple graphs.
4190
4191=item *
4192
4193Creating graphs should be easy even when the graphs are quite complex.
4194
4195=back
4196
4197=head1 AUTHOR
4198
4199Copyright (C) 2004 - 2008 by Tels L<http://bloodgate.com>
4200
4201X<tels>
4202
4203=cut
4204