view release on metacpan or  search on metacpan

lib/Graph/Easy/Parser.pm  view on Meta::CPAN

#############################################################################
# Parse text definition into a Graph::Easy object
#
#############################################################################

package Graph::Easy::Parser;

use Graph::Easy;

$VERSION = '0.76';
use Graph::Easy::Base;
@ISA = qw/Graph::Easy::Base/;
use Scalar::Util qw/weaken/;

use strict;
use warnings;
use constant NO_MULTIPLES => 1;

use Graph::Easy::Util qw(ord_values);

sub _init
  {
  my ($self,$args) = @_;

  $self->{error} = '';
  $self->{debug} = 0;
  $self->{fatal_errors} = 1;

  foreach my $k (sort keys %$args)
    {
    if ($k !~ /^(debug|fatal_errors)\z/)
      {
      require Carp;
      my $class = ref($self);
      Carp::confess ("Invalid argument '$k' passed to $class" . '->new()');
      }
    $self->{$k} = $args->{$k};
    }

  # what to replace the matched text with
  $self->{replace} = '';
  $self->{attr_sep} = ':';
  # An optional regexp to remove parts of an autosplit label, used by Graphviz
  # to remove " <p1> ":
  $self->{_qr_part_clean} = undef;

  # setup default class names for generated objects
  $self->{use_class} = {
    edge  => 'Graph::Easy::Edge',
    group => 'Graph::Easy::Group',
    graph => 'Graph::Easy',
    node  => 'Graph::Easy::Node',
  };

  $self;
  }

sub reset
  {
  # reset the status of the parser, clear errors etc.
  my $self = shift;

  $self->{error} = '';
  $self->{anon_id} = 0;
  $self->{cluster_id} = '';		# each cluster gets a unique ID
  $self->{line_nr} = -1;
  $self->{match_stack} = [];		# patterns and their handlers

  $self->{clusters} = {};		# cluster names we already created

  Graph::Easy::Base::_reset_id();	# start with the same set of IDs

  # After "[ 1 ] -> [ 2 ]" we push "2" on the stack and when we encounter

lib/Graph/Easy/Parser.pm  view on Meta::CPAN

      }
    else
      {
      $part =~ s/^\s+//;	# rem spaces at front
      $part =~ s/\s+\z//;	# rem spaces at end
      }

    my $node_name = "$base_name.$idx";

    if ($graph->{debug})
      {
      my $empty = '';
      $empty = ' empty' if $class ne $self->{use_class}->{node};
      print STDERR "# Parser:  Creating$empty autosplit part '$part'\n" if $graph->{debug};
      }

    # if it doesn't exist, add it, otherwise retrieve node object to $node
    if ($class =~ /::Empty/)
      {
      my $node = $graph->node($node_name);
      if (!defined $node)
	{
	# create node object from the correct class
	$node = $class->new($node_name);
        $graph->add_node($node);
	}
      }

    my $node = $graph->add_node($node_name);
    $node->{autosplit_label} = $part;
    # remember these two for Graphviz
    $node->{autosplit_portname} = $port_name;
    $node->{autosplit_basename} = $base_name;

    push @rc, $node;
    if (@rc == 1)
      {
      # for correct as_txt output
      $node->{autosplit} = $name;
      $node->{autosplit} =~ s/\s+\z//;		# strip trailing spaces
      $node->{autosplit} =~ s/^\s+//;		# strip leading spaces
      $node->{autosplit} =~ s/([^\|])\s+\|/$1 \|/g;	# 'foo  |' => 'foo |'
      $node->{autosplit} =~ s/\|\s+([^\|])/\| $1/g;	# '|  foo' => '| foo'
      $node->set_attribute('basename', $att->{basename}) if defined $att->{basename};
      # list of all autosplit parts so as_txt() can find them easily again
      $node->{autosplit_parts} = [ ];
      $first_in_row = $node;
      }
    else
      {
      # second, third etc. get previous as origin
      my ($sx,$sy) = (1,0);
      my $origin = $rc[-2];
      if ($last_sep eq '||')
        {
        ($sx,$sy) = (0,1); $origin = $first_in_row;
        $first_in_row = $node;
        }
      $node->relative_to($origin,$sx,$sy);
      push @{$rc[0]->{autosplit_parts}}, $node;
      weaken @{$rc[0]->{autosplit_parts}}[-1];

      # suppress as_txt output for other parts
      $node->{autosplit} = undef;
      }
    # nec. for border-collapse
    $node->{autosplit_xy} = "$x,$y";

    $idx++;						# next node ID
    $last_sep = $sep;
    $x++;
    # || starts a new row:
    if ($sep eq '||')
      {
      $x = 0; $y++;
      }
    }  # end for all parts

  @rc;	# return all created nodes
  }

sub _new_node
  {
  # Create a new node unless it doesn't already exist. If the group stack
  # contains entries, the new node appears first in this/these group(s), so
  # add it to these groups. If the newly created node contains "|", we auto
  # split it up into several nodes and cluster these together.
  my ($self, $graph, $name, $group_stack, $att, $stack) = @_;

  print STDERR "# Parser: new node '$name'\n" if $graph->{debug};

  $name = $self->_unquote($name, 'no_collapse');

  my $autosplit;
  my $uc = $self->{use_class};

  my @rc = ();

  if ($name =~ /^\s*\z/)
    {
    print STDERR "# Parser: Creating anon node\n" if $graph->{debug};
    # create a new anon node and add it to the graph
    my $class = $uc->{node} . '::Anon';
    my $node = $class->new();
    @rc = ( $graph->add_node($node) );
    }
  # nodes to be autosplit will be done in a sep. pass for Graphviz
  elsif ((ref($self) eq 'Graph::Easy::Parser') && $name =~ /[^\\]\|/)
    {
    $autosplit = 1;
    @rc = $self->_autosplit_node($graph, $name, $att);
    }
  else
    {
    # strip trailing and leading spaces
    $name =~ s/\s+\z//;
    $name =~ s/^\s+//;

    # collapse multiple spaces
    $name =~ s/\s+/ /g;