1############################################################################# 2# One chain of nodes in a Graph::Easy - used internally for layouts. 3# 4# (c) by Tels 2004-2006. Part of Graph::Easy 5############################################################################# 6 7package Graph::Easy::Layout::Chain; 8 9use Graph::Easy::Base; 10$VERSION = '0.76'; 11@ISA = qw/Graph::Easy::Base/; 12 13use strict; 14use warnings; 15 16use Graph::Easy::Util qw(ord_values); 17 18use constant { 19 _ACTION_NODE => 0, # place node somewhere 20 _ACTION_TRACE => 1, # trace path from src to dest 21 _ACTION_CHAIN => 2, # place node in chain (with parent) 22 _ACTION_EDGES => 3, # trace all edges (shortes connect. first) 23 }; 24 25############################################################################# 26 27sub _init 28 { 29 # Generic init routine, to be overriden in subclasses. 30 my ($self,$args) = @_; 31 32 foreach my $k (sort keys %$args) 33 { 34 if ($k !~ /^(start|graph)\z/) 35 { 36 require Carp; 37 Carp::confess ("Invalid argument '$k' passed to __PACKAGE__->new()"); 38 } 39 $self->{$k} = $args->{$k}; 40 } 41 42 $self->{end} = $self->{start}; 43 44 # store chain at node (to lookup node => chain info) 45 $self->{start}->{_chain} = $self; 46 $self->{start}->{_next} = undef; 47 48 $self->{len} = 1; 49 50 $self; 51 } 52 53sub start 54 { 55 # return first node in the chain 56 my $self = shift; 57 58 $self->{start}; 59 } 60 61sub end 62 { 63 # return last node in the chain 64 my $self = shift; 65 66 $self->{end}; 67 } 68 69sub add_node 70 { 71 # add a node at the end of the chain 72 my ($self, $node) = @_; 73 74 # store at end 75 $self->{end}->{_next} = $node; 76 $self->{end} = $node; 77 78 # store chain at node (to lookup node => chain info) 79 $node->{_chain} = $self; 80 $node->{_next} = undef; 81 82 $self->{len} ++; 83 84 $self; 85 } 86 87sub length 88 { 89 # Return the length of the chain in nodes. Takes optional 90 # node from where to calculate length. 91 my ($self, $node) = @_; 92 93 return $self->{len} unless defined $node; 94 95 my $len = 0; 96 while (defined $node) 97 { 98 $len++; $node = $node->{_next}; 99 } 100 101 $len; 102 } 103 104sub nodes 105 { 106 # return all the nodes in the chain as a list, in order. 107 my $self = shift; 108 109 my @nodes = (); 110 my $n = $self->{start}; 111 while (defined $n) 112 { 113 push @nodes, $n; 114 $n = $n->{_next}; 115 } 116 117 @nodes; 118 } 119 120sub layout 121 { 122 # Return an action stack containing the nec. actions to 123 # lay out the nodes in the chain, plus any connections between 124 # them. 125 my ($self, $edge) = @_; 126 127 # prevent doing it twice 128 return [] if $self->{_done}; $self->{_done} = 1; 129 130 my @TODO = (); 131 132 my $g = $self->{graph}; 133 134 # first, layout all the nodes in the chain: 135 136 # start with first node 137 my $pre = $self->{start}; my $n = $pre->{_next}; 138 if (exists $pre->{_todo}) 139 { 140 # edges with a flow attribute must be handled differently 141 # XXX TODO: the test for attribute('flow') might be wrong (raw_attribute()?) 142 if ($edge && ($edge->{to} == $pre) && ($edge->attribute('flow') || $edge->has_ports())) 143 { 144 push @TODO, $g->_action( _ACTION_CHAIN, $pre, 0, $edge->{from}, $edge); 145 } 146 else 147 { 148 push @TODO, $g->_action( _ACTION_NODE, $pre, 0, $edge ); 149 } 150 } 151 152 print STDERR "# Stack after first:\n" if $g->{debug}; 153 $g->_dump_stack(@TODO) if $g->{debug}; 154 155 while (defined $n) 156 { 157 if (exists $n->{_todo}) 158 { 159 # CHAIN means if $n isn't placed yet, it will be done with 160 # $pre as parent: 161 162 # in case there are multiple edges to the target node, use the first 163 # one to determine the flow: 164 my @edges = $g->edge($pre,$n); 165 166 push @TODO, $g->_action( _ACTION_CHAIN, $n, 0, $pre, $edges[0] ); 167 } 168 $pre = $n; 169 $n = $n->{_next}; 170 } 171 172 print STDERR "# Stack after chaining:\n" if $g->{debug}; 173 $g->_dump_stack(@TODO) if $g->{debug}; 174 175 # link from each node to the next 176 $pre = $self->{start}; $n = $pre->{_next}; 177 while (defined $n) 178 { 179 # first do edges going from P to N 180 #for my $e (sort { $a->{to}->{name} cmp $b->{to}->{name} } values %{$pre->{edges}}) 181 for my $e (ord_values ( $pre->{edges})) 182 { 183 # skip selfloops and backward links, these will be done later 184 next if $e->{to} != $n; 185 186 next unless exists $e->{_todo}; 187 188 # skip links from/to groups 189 next if $e->{to}->isa('Graph::Easy::Group') || 190 $e->{from}->isa('Graph::Easy::Group'); 191 192# # skip edges with a flow 193# next if exists $e->{att}->{start} || exist $e->{att}->{end}; 194 195 push @TODO, [ _ACTION_TRACE, $e ]; 196 delete $e->{_todo}; 197 } 198 199 } continue { $pre = $n; $n = $n->{_next}; } 200 201 print STDERR "# Stack after chain-linking:\n" if $g->{debug}; 202 $g->_dump_stack(@TODO) if $g->{debug}; 203 204 # Do all other links inside the chain (backwards, going forward more than 205 # one node etc) 206 207 $n = $self->{start}; 208 while (defined $n) 209 { 210 my @edges; 211 212 my @count; 213 214 print STDERR "# inter-chain link from $n->{name}\n" if $g->{debug}; 215 216 # gather all edges starting at $n, but do the ones with a flow first 217# for my $e (sort { $a->{to}->{name} cmp $b->{to}->{name} } values %{$n->{edges}}) 218 for my $e (ord_values ( $n->{edges})) 219 { 220 # skip selfloops, these will be done later 221 next if $e->{to} == $n; 222 223 next if !ref($e->{to}->{_chain}); 224 next if !ref($e->{from}->{_chain}); 225 226 next if $e->has_ports(); 227 228 # skip links from/to groups 229 next if $e->{to}->isa('Graph::Easy::Group') || 230 $e->{from}->isa('Graph::Easy::Group'); 231 232 print STDERR "# inter-chain link from $n->{name} to $e->{to}->{name}\n" if $g->{debug}; 233 234 # leaving the chain? 235 next if $e->{to}->{_chain} != $self; 236 237# print STDERR "# trying for $n->{name}:\t $e->{from}->{name} to $e->{to}->{name}\n"; 238 next unless exists $e->{_todo}; 239 240 # calculate for this edge, how far it goes 241 my $count = 0; 242 my $curr = $n; 243 while (defined $curr && $curr != $e->{to}) 244 { 245 $curr = $curr->{_next}; $count ++; 246 } 247 if (!defined $curr) 248 { 249 # edge goes backward 250 251 # start at $to 252 $curr = $e->{to}; 253 $count = 0; 254 while (defined $curr && $curr != $e->{from}) 255 { 256 $curr = $curr->{_next}; $count ++; 257 } 258 $count = 100000 if !defined $curr; # should not happen 259 } 260 push @edges, [ $count, $e ]; 261 push @count, [ $count, $e->{from}->{name}, $e->{to}->{name} ]; 262 } 263 264# use Data::Dumper; print STDERR "count\n", Dumper(@count); 265 266 # do edges, shortest first 267 for my $e (sort { $a->[0] <=> $b->[0] } @edges) 268 { 269 push @TODO, [ _ACTION_TRACE, $e->[1] ]; 270 delete $e->[1]->{_todo}; 271 } 272 273 $n = $n->{_next}; 274 } 275 276 # also do all selfloops on $n 277 $n = $self->{start}; 278 while (defined $n) 279 { 280# for my $e (sort { $a->{to}->{name} cmp $b->{to}->{name} } values %{$n->{edges}}) 281 for my $e (ord_values $n->{edges}) 282 { 283 next unless exists $e->{_todo}; 284 285# print STDERR "# $e->{from}->{name} to $e->{to}->{name} on $n->{name}\n"; 286# print STDERR "# ne $e->{to} $n $e->{id}\n" 287# if $e->{from} != $n || $e->{to} != $n; # no selfloop? 288 289 next if $e->{from} != $n || $e->{to} != $n; # no selfloop? 290 291 push @TODO, [ _ACTION_TRACE, $e ]; 292 delete $e->{_todo}; 293 } 294 $n = $n->{_next}; 295 } 296 297 print STDERR "# Stack after self-loops:\n" if $g->{debug}; 298 $g->_dump_stack(@TODO) if $g->{debug}; 299 300 # XXX TODO 301 # now we should do any links that start or end at this chain, recursively 302 303 $n = $self->{start}; 304 while (defined $n) 305 { 306 307 # all chains that start at this node 308 for my $e (sort { $a->{to}->{name} cmp $b->{to}->{name} } values %{$n->{edges}}) 309 { 310 my $to = $e->{to}; 311 312 # skip links to groups 313 next if $to->isa('Graph::Easy::Group'); 314 315# print STDERR "# chain-tracking to: $to->{name} $to->{_chain}\n"; 316 317 next unless exists $to->{_chain} && ref($to->{_chain}) =~ /Chain/; 318 my $chain = $to->{_chain}; 319 next if $chain->{_done}; 320 321# print STDERR "# chain-tracking to: $to->{name}\n"; 322 323 # pass the edge along, in case it has a flow 324# my @pass = (); 325# push @pass, $e if $chain->{_first} && $e->{to} == $chain->{_first}; 326 push @TODO, @{ $chain->layout($e) } unless $chain->{_done}; 327 328 # link the edges to $to 329 next unless exists $e->{_todo}; # was already done above? 330 331 # next if $e->has_ports(); 332 333 push @TODO, [ _ACTION_TRACE, $e ]; 334 delete $e->{_todo}; 335 } 336 $n = $n->{_next}; 337 } 338 339 \@TODO; 340 } 341 342sub dump 343 { 344 # dump the chain to STDERR 345 my ($self, $indent) = @_; 346 347 $indent = '' unless defined $indent; 348 349 print STDERR "#$indent chain id $self->{id} (len $self->{len}):\n"; 350 print STDERR "#$indent is empty\n" and return if $self->{len} == 0; 351 352 my $n = $self->{start}; 353 while (defined $n) 354 { 355 print STDERR "#$indent $n->{name} (chain id: $n->{_chain}->{id})\n"; 356 $n = $n->{_next}; 357 } 358 $self; 359 } 360 361sub merge 362 { 363 # take another chain, and merge it into ourselves. If $where is defined, 364 # absorb only the nodes from $where onwards (instead of all of them). 365 my ($self, $other, $where) = @_; 366 367 my $g = $self->{graph}; 368 369 print STDERR "# panik: ", join(" \n",caller()),"\n" if !defined $other; 370 371 print STDERR 372 "# Merging chain $other->{id} (len $other->{len}) into $self->{id} (len $self->{len})\n" 373 if $g->{debug}; 374 375 print STDERR 376 "# Merging from $where->{name} onwards\n" 377 if $g->{debug} && ref($where); 378 379 # cannot merge myself into myself (without allocating infinitely memory) 380 return if $self == $other; 381 382 # start at start as default 383 $where = undef unless ref($where) && exists $where->{_chain} && $where->{_chain} == $other; 384 385 $where = $other->{start} unless defined $where; 386 387 # make all nodes from chain #1 belong to it (to detect loops) 388 my $n = $self->{start}; 389 while (defined $n) 390 { 391 $n->{_chain} = $self; 392 $n = $n->{_next}; 393 } 394 395 print STDERR "# changed nodes\n" if $g->{debug}; 396 $self->dump() if $g->{debug}; 397 398 # terminate at $where 399 $self->{end}->{_next} = $where; 400 $self->{end} = $other->{end}; 401 402 # start at joiner 403 $n = $where; 404 while (ref($n)) 405 { 406 $n->{_chain} = $self; 407 my $pre = $n; 408 $n = $n->{_next}; 409 410# sleep(1); 411# print "# at $n->{name} $n->{_chain}\n" if ref($n); 412 if (ref($n) && defined $n->{_chain} && $n->{_chain} == $self) # already points into ourself? 413 { 414# sleep(1); 415# print "# pre $pre->{name} $pre->{_chain}\n"; 416 $pre->{_next} = undef; # terminate 417 $self->{end} = $pre; 418 last; 419 } 420 } 421 422 # could speed this up 423 $self->{len} = 0; $n = $self->{start}; 424 while (defined $n) 425 { 426 $self->{len}++; $n = $n->{_next}; 427 } 428 429# print "done merging, dumping result:\n"; 430# $self->dump(); sleep(10); 431 432 if (defined $other->{start} && $where == $other->{start}) 433 { 434 # we absorbed the other chain completely, so drop it 435 $other->{end} = undef; 436 $other->{start} = undef; 437 $other->{len} = 0; 438 # caller is responsible for cleaning it up 439 } 440 441 print STDERR "# after merging\n" if $g->{debug}; 442 $self->dump() if $g->{debug}; 443 444 $self; 445 } 446 4471; 448__END__ 449 450=head1 NAME 451 452Graph::Easy::Layout::Chain - Chain of nodes for layouter 453 454=head1 SYNOPSIS 455 456 # used internally, do not use directly 457 458 use Graph::Easy; 459 use Graph::Easy::Layout::Chain; 460 461 my $graph = Graph::Easy->new( ); 462 my ($node, $node2) = $graph->add_edge( 'A', 'B' ); 463 464 my $chain = Graph::Easy::Layout::Chain->new( 465 start => $node, 466 graph => $graph, ); 467 468 $chain->add_node( $node2 ); 469 470=head1 DESCRIPTION 471 472A C<Graph::Easy::Layout::Chain> object represents a chain of nodes 473for the layouter. 474 475=head1 METHODS 476 477=head2 new() 478 479 my $chain = Graph::Easy::Layout::Chain->new( start => $node ); 480 481Create a new chain and set its starting node to C<$node>. 482 483=head2 length() 484 485 my $len = $chain->length(); 486 487Return the length of the chain, in nodes. 488 489 my $len = $chain->length( $node ); 490 491Given an optional C<$node> as argument, returns the length 492from that node onwards. For the chain with the three nodes 493A, B and C would return 3, 2, and 1 for A, B and C, respectively. 494 495Returns 0 if the passed node is not part of this chain. 496 497=head2 nodes() 498 499 my @nodes = $chain->nodes(); 500 501Return all the node objects in the chain as list, in order. 502 503=head2 add_node() 504 505 $chain->add_node( $node ); 506 507Add C<$node> to the end of the chain. 508 509=head2 start() 510 511 my $node = $chain->start(); 512 513Return first node in the chain. 514 515=head2 end() 516 517 my $node = $chain->end(); 518 519Return last node in the chain. 520 521=head2 layout() 522 523 my $todo = $chain->layout(); 524 525Return an action stack as array ref, containing the nec. actions to 526layout the chain (nodes, plus interlinks in the chain). 527 528Will recursively traverse all chains linked to this chain. 529 530=head2 merge() 531 532 my $chain->merge ( $other_chain ); 533 my $chain->merge ( $other_chain, $where ); 534 535Merge the other chain into ourselves, adding its nodes at our end. 536The other chain is emptied and must be deleted by the caller. 537 538If C<$where> is defined and a member of C<$other_chain>, absorb only the 539nodes from C<$where> onwards, instead of all of them. 540 541=head2 error() 542 543 $last_error = $node->error(); 544 545 $node->error($error); # set new messages 546 $node->error(''); # clear error 547 548Returns the last error message, or '' for no error. 549 550=head2 dump() 551 552 $chain->dump(); 553 554Dump the chain to STDERR, to aid debugging. 555 556=head1 EXPORT 557 558None by default. 559 560=head1 SEE ALSO 561 562L<Graph::Easy>, L<Graph::Easy::Layout>. 563 564=head1 AUTHOR 565 566Copyright (C) 2004 - 2006 by Tels L<http://bloodgate.com>. 567 568See the LICENSE file for more details. 569 570=cut 571