File Coverage

lib/Graph/Easy/Edge.pm

Criterion	Covered	Total	%
statement	143	191	74.8
branch	76	110	69.0
condition	40	73	54.7
subroutine	23	28	82.1
pod	18	18	100.0
total	300	420	71.4

#############################################################################
# An edge connecting two nodes in Graph::Easy.
#
#############################################################################

package Graph::Easy::Edge;

use Graph::Easy::Node;
@ISA = qw/Graph::Easy::Node/;		# an edge is just a special node
$VERSION = '0.76';

use strict;
use warnings;

use constant isa_cell => 1;

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

sub _init
  {
  # generic init, override in subclasses
  my ($self,$args) = @_;

  $self->{class} = 'edge';

  # leave this unitialized until we need it
  # $self->{cells} = [ ];

  foreach my $k (sort keys %$args)
    {
    if ($k !~ /^(label|name|style)\z/)
      {
      require Carp;
      Carp::confess ("Invalid argument '$k' passed to Graph::Easy::Node->new()");
      }
    my $n = $k; $n = 'label' if $k eq 'name';

    $self->{att}->{$n} = $args->{$k};
    }

  $self;
  }

#############################################################################
# accessor methods

sub bidirectional
  {
  my $self = shift;

  if (@_ > 0)
    {
    my $old = $self->{bidirectional} || 0;
    $self->{bidirectional} = $_[0] ? 1 : 0;

    # invalidate layout?
    $self->{graph}->{score} = undef if $old != $self->{bidirectional} && ref($self->{graph});
    }

  $self->{bidirectional};
  }

sub undirected
  {
  my $self = shift;

  if (@_ > 0)
    {
    my $old = $self->{undirected} || 0;
    $self->{undirected} = $_[0] ? 1 : 0;

    # invalidate layout?
    $self->{graph}->{score} = undef if $old != $self->{undirected} && ref($self->{graph});
    }

  $self->{undirected};
  }

sub has_ports
  {
  my $self = shift;

  my $s_port = $self->{att}->{start} || $self->attribute('start');

  return 1 if $s_port ne '';

  my $e_port = $self->{att}->{end} || $self->attribute('end');

  return 1 if $e_port ne '';

  0;
  }

sub start_port
  {
  # return the side and portnumber if the edge has a shared source port
  # undef for none
  my $self = shift;

  my $s = $self->{att}->{start} || $self->attribute('start');
  return undef if !defined $s || $s !~ /,/;	# "south, 0" => ok, "south" => no

  return (split /\s*,\s*/, $s) if wantarray;

  $s =~ s/\s+//g;		# remove spaces to normalize "south, 0" to "south,0"
  $s;
  }

sub end_port
  {
  # return the side and portnumber if the edge has a shared source port
  # undef for none
  my $self = shift;

  my $s = $self->{att}->{end} || $self->attribute('end');
  return undef if !defined $s || $s !~ /,/;	# "south, 0" => ok, "south" => no

  return split /\s*,\s*/, $s if wantarray;

  $s =~ s/\s+//g;		# remove spaces to normalize "south, 0" to "south,0"
  $s;
  }

sub style
  {
  my $self = shift;

  $self->{att}->{style} || $self->attribute('style');
  }

sub name
  {
  # returns actually the label
  my $self = shift;

  $self->{att}->{label} || '';
  }

#############################################################################
# cell management - used by the cell-based layouter

sub _cells
  {
  # return all the cells this edge currently occupies
  my $self = shift;

  $self->{cells} = [] unless defined $self->{cells};

  @{$self->{cells}};
  }

sub _clear_cells
  {
  # remove all belonging cells
  my $self = shift;

  $self->{cells} = [];

  $self;
  }

sub _unplace
  {
  # Take an edge, and remove all the cells it covers from the cells area
  my ($self, $cells) = @_;

  print STDERR "# clearing path from $self->{from}->{name} to $self->{to}->{name}\n" if $self->{debug};

  for my $key (@{$self->{cells}})
    {
    # XXX TODO: handle crossed edges differently (from CROSS => HOR or VER)
    # free in our cells area
    delete $cells->{$key};
    }

  $self->clear_cells();

  $self;
  }

sub _distance
  {
  # estimate the distance from SRC to DST node
  my ($self) = @_;

  my $src = $self->{from};
  my $dst = $self->{to};

  # one of them not yet placed?
  return 100000 unless defined $src->{x} && defined $dst->{x};

  my $cells = $self->{graph}->{cells};

  # get all the starting positions
  # distance = 1: slots, generate starting types, the direction is shifted
  # by 90° counter-clockwise

  my @start = $src->_near_places($cells, 1, undef, undef, $src->_shift(-90) );

  # potential stop positions
  my @stop = $dst->_near_places($cells, 1);		# distance = 1: slots

  my ($s_p,@ss_p) = $self->port('start');
  my ($e_p,@ee_p) = $self->port('end');

  # the edge has a port description, limiting the start places
  @start = $src->_allowed_places( \@start, $src->_allow( $s_p, @ss_p ), 3)
    if defined $s_p;

  # the edge has a port description, limiting the stop places
  @stop = $dst->_allowed_places( \@stop, $dst->_allow( $e_p, @ee_p ), 3)
    if defined $e_p;

  my $stop = scalar @stop;

  return 0 unless @stop > 0 && @start > 0;	# no free slots on one node?

  my $lowest;

  my $i = 0;
  while ($i < scalar @start)
    {
    my $sx = $start[$i]; my $sy = $start[$i+1]; $i += 2;

    # for each start point, calculate the distance to each stop point, then use
    # the smallest as value

    for (my $u = 0; $u < $stop; $u += 2)
      {
      my $dist = Graph::Easy::_astar_distance($sx,$sy, $stop[$u], $stop[$u+1]);
      $lowest = $dist if !defined $lowest || $dist < $lowest;
      }
    }

  $lowest;
  }

sub _add_cell
  {
  # add a cell to the list of cells this edge covers. If $after is a ref
  # to a cell, then the new cell will be inserted right after this cell.
  # if after is defined, but not a ref, the new cell will be inserted
  # at the specified position.
  my ($self, $cell, $after, $before) = @_;

  $self->{cells} = [] unless defined $self->{cells};
  my $cells = $self->{cells};

  # if both are defined, but belong to different edges, just ignore $before:
  $before = undef if ref($before) && $before->{edge} != $self;
  $after = undef if ref($after) && $after->{edge} != $self;
  if (!defined $after && ref($before))
    {
    $after = $before; $before = undef;
    }

  if (defined $after)
    {
    # insert the new cell right after $after
    my $ofs = $after;
    if (ref($after) && !ref($before))
      {
      # insert after $after
      $ofs = 1;
      for my $cell (@$cells)
        {
        last if $cell == $after;
        $ofs++;
        }
      }
    elsif (ref($after) && ref($before))
      {
      # insert between after and before (or before/after for "reversed edges)
      $ofs = 0;
      my $found = 0;
      while ($ofs < scalar @$cells - 1)		# 0,1,2,3 => 0 .. 2
        {
        my $c1 = $cells->[$ofs];
        my $c2 = $cells->[$ofs+1];
	$ofs++;
        $found++, last if (($c1 == $after && $c2 == $before) ||
                 ($c1 == $before && $c2 == $after));
        }
      if (!$found)
	{
        # XXX TODO: last effort

        # insert after $after
        $ofs = 1;
        for my $cell (@$cells)
          {
          last if $cell == $after;
          $ofs++;
          }
        $found++;
	}
      $self->_croak("Could not find $after and $before") unless $found;
      }
    splice (@$cells, $ofs, 0, $cell);
    }
  else
    {
    # insert new cell at the end
    push @$cells, $cell;
    }

  $cell->_update_boundaries();

  $self;
  }

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

sub from
  {
  my $self = shift;

  $self->{from};
  }

sub to
  {
  my $self = shift;

  $self->{to};
  }

sub nodes
  {
  my $self = shift;

  ($self->{from}, $self->{to});
  }

sub start_at
  {
  # move the edge's start point from the current node to the given node
  my ($self, $node) = @_;

  # if not a node yet, or not part of this graph, make into one proper node
  $node = $self->{graph}->add_node($node);

  $self->_croak("start_at() needs a node object, but got $node")
    unless ref($node) && $node->isa('Graph::Easy::Node');

  # A => A => nothing to do
  return $node if $self->{from} == $node;

  # delete self at A
  delete $self->{from}->{edges}->{ $self->{id} };

  # set "from" to B
  $self->{from} = $node;

  # add to B
  $self->{from}->{edges}->{ $self->{id} } = $self;

  # invalidate layout
  $self->{graph}->{score} = undef if ref($self->{graph});

  # return new start point
  $node;
  }

sub end_at
  {
  # move the edge's end point from the current node to the given node
  my ($self, $node) = @_;

  # if not a node yet, or not part of this graph, make into one proper node
  $node = $self->{graph}->add_node($node);

  $self->_croak("start_at() needs a node object, but got $node")
    unless ref($node) && $node->isa('Graph::Easy::Node');

  # A => A => nothing to do
  return $node if $self->{to} == $node;

  # delete self at A
  delete $self->{to}->{edges}->{ $self->{id} };

  # set "to" to B
  $self->{to} = $node;

  # add to node B
  $self->{to}->{edges}->{ $self->{id} } = $self;

  # invalidate layout
  $self->{graph}->{score} = undef if ref($self->{graph});

  # return new end point
  $node;
  }

sub edge_flow
  {
  # return the flow at this edge  or '' if the edge itself doesn't have a flow
  my $self = shift;

  # our flow comes from ourselves
  my $flow = $self->{att}->{flow};
  $flow = $self->raw_attribute('flow') unless defined $flow;

  $flow;
  }

sub flow
  {
  # return the flow at this edge (including inheriting flow from node)
  my ($self) = @_;

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

  # our flow comes from ourselves
  my $flow = $self->{att}->{flow};
  # or maybe our class
  $flow = $self->raw_attribute('flow') unless defined $flow;

  # if the edge doesn't have a flow, maybe the node has a default out flow
  $flow = $self->{from}->{att}->{flow} if !defined $flow;

  # if that didn't work out either, use the parents flows
  $flow = $self->parent()->attribute('flow') if !defined $flow;
  # or finally, the default "east":
  $flow = 90 if !defined $flow;

  # absolute flow does not depend on the in-flow, so can return early
  return $flow if $flow =~ /^(0|90|180|270)\z/;

  # in-flow comes from our "from" node
  my $in = $self->{from}->flow();

# print STDERR "# in: $self->{from}->{name} = $in\n";

  my $out = $self->{graph}->_flow_as_direction($in,$flow);
  $out;
  }

sub port
  {
  my ($self, $which) = @_;

  $self->_croak("'$which' must be one of 'start' or 'end' in port()") unless $which =~ /^(start|end)/;

  # our flow comes from ourselves
  my $sp = $self->attribute($which);

  return (undef,undef) unless defined $sp && $sp ne '';

  my ($side, $port) = split /\s*,\s*/, $sp;

  # if absolut direction, return as is
  my $s = Graph::Easy->_direction_as_side($side);

  if (defined $s)
    {
    my @rc = ($s); push @rc, $port if defined $port;
    return @rc;
    }

  # in_flow comes from our "from" node
  my $in = 90; $in = $self->{from}->flow() if ref($self->{from});

  # turn left in "south" etc:
  $s = Graph::Easy->_flow_as_side($in,$side);

  my @rc = ($s); push @rc, $port if defined $port;
  @rc;
  }

sub flip
  {
  # swap from and to for this edge
  my ($self) = @_;

  ($self->{from}, $self->{to}) = ($self->{to}, $self->{from});

  # invalidate layout
  $self->{graph}->{score} = undef if ref($self->{graph});

  $self;
  }

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

  # invisible nodes, or very small ones
  return '' if $self->{w} == 0 || $self->{h} == 0;

  my $fb = $self->_framebuffer($self->{w}, $self->{h});

  ###########################################################################
  # "draw" the label into the framebuffer (e.g. the edge and the text)
  $self->_draw_label($fb, $x, $y, '');

  join ("\n", @$fb);
  }

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

  _as_txt(@_);
  }

1;
__END__