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] !~ />(\ )?</; # 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