[libgraphviz-perl] 08/31: [svn-upgrade] Integrating new upstream version, libgraphviz-perl (2.04)
dom at earth.li
dom at earth.li
Sat Oct 4 21:05:03 UTC 2014
This is an automated email from the git hooks/post-receive script.
dom pushed a commit to branch master
in repository libgraphviz-perl.
commit bc2070a978f6ba662c84c45a20f2213744dac7ec
Author: Dominic Hargreaves <dom at earth.li>
Date: Fri Sep 4 11:06:26 2009 +0000
[svn-upgrade] Integrating new upstream version, libgraphviz-perl (2.04)
---
CHANGES | 5 +
META.yml | 14 +-
Makefile.PL | 43 +--
lib/GraphViz.pm | 673 +++++++++++++++++++++------------------
lib/GraphViz/Data/Grapher.pm | 148 ++++-----
lib/GraphViz/No.pm | 19 +-
lib/GraphViz/Parse/RecDescent.pm | 170 +++++-----
lib/GraphViz/Parse/Yacc.pm | 81 +++--
lib/GraphViz/Parse/Yapp.pm | 71 ++---
lib/GraphViz/Regex.pm | 304 +++++++++---------
lib/GraphViz/Small.pm | 17 +-
lib/GraphViz/XML.pm | 62 ++--
t/dumper.t | 30 +-
t/foo.t | 106 +++---
t/pod.t | 3 +-
t/simple.t | 29 +-
16 files changed, 921 insertions(+), 854 deletions(-)
diff --git a/CHANGES b/CHANGES
index ec0340b..859a45c 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,5 +1,10 @@
Revision history for Perl module GraphViz.
+2.04 Fri Dec 12 21:31:24 GMT 2008
+ - perltidy everything
+ - add human- and machine-readable license
+ - add use warnings
+
2.03 Sun Nov 18 14:40:20 GMT 2007
- make the graph name configurable (patch by Ruslan Zakirov)
diff --git a/META.yml b/META.yml
index 5515fea..0e826fd 100644
--- a/META.yml
+++ b/META.yml
@@ -1,13 +1,15 @@
--- #YAML:1.0
name: GraphViz
-version: 2.03
-abstract: ~
-license: ~
-generated_by: ExtUtils::MakeMaker version 6.32
+version: 2.04
+abstract: Interface to the GraphViz graphing tool
+license: perl
+author:
+ - Leon Brocard <acme at astray.com>
+generated_by: ExtUtils::MakeMaker version 6.44
distribution_type: module
requires:
IPC::Run: 0.6
Test::More: 0
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.2.html
- version: 1.2
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
diff --git a/Makefile.PL b/Makefile.PL
index 57d9568..b4615cc 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,4 +1,6 @@
+#!perl
use strict;
+use warnings;
use Config;
use ExtUtils::MakeMaker;
use File::Spec::Functions;
@@ -7,10 +9,10 @@ print "Looking for dot... ";
my $found = find("dot");
if ($found) {
- print "found it at $found\n";
+ print "found it at $found\n";
} else {
- print "didn't find it\n";
- die "****************************************************************
+ print "didn't find it\n";
+ die "****************************************************************
GraphViz.pm has not been able to find the graphviz program 'dot'
GraphViz.pm needs graphviz to function
Please install graphviz first: http://www.graphviz.org/
@@ -18,23 +20,26 @@ Please install graphviz first: http://www.graphviz.org/
}
WriteMakefile(
- 'NAME' => 'GraphViz',
- 'VERSION_FROM' => 'lib/GraphViz.pm', # finds $VERSION
- 'PREREQ_PM' => {
- 'IPC::Run' => 0.6,
- 'Test::More' => 0,
- },
- 'dist' => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ 'NAME' => 'GraphViz',
+ 'VERSION_FROM' => 'lib/GraphViz.pm',
+ 'LICENSE' => 'perl',
+ 'AUTHOR' => 'Leon Brocard <acme at astray.com>',
+ 'ABSTRACT' => 'Interface to the GraphViz graphing tool',
+ 'PREREQ_PM' => {
+ 'IPC::Run' => 0.6,
+ 'Test::More' => 0,
+ },
+ 'dist' => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
);
sub find {
- my $binary = shift;
- my $path = join ', ', @ENV{PATH};
- my $path_sep = $Config{path_sep};
- my $exe_ext = $Config{exe_ext};
- foreach my $dir (split $path_sep, @ENV{PATH}) {
- my $filename = catfile($dir, $binary);
- return $filename if -x "$filename$exe_ext";
- }
- return 0;
+ my $binary = shift;
+ my $path = join ', ', @ENV{PATH};
+ my $path_sep = $Config{path_sep};
+ my $exe_ext = $Config{exe_ext};
+ foreach my $dir ( split $path_sep, @ENV{PATH} ) {
+ my $filename = catfile( $dir, $binary );
+ return $filename if -x "$filename$exe_ext";
+ }
+ return 0;
}
diff --git a/lib/GraphViz.pm b/lib/GraphViz.pm
index 6f1c8be..549c1fd 100644
--- a/lib/GraphViz.pm
+++ b/lib/GraphViz.pm
@@ -1,6 +1,7 @@
package GraphViz;
use strict;
+use warnings;
use vars qw($AUTOLOAD $VERSION);
use Carp;
@@ -8,7 +9,7 @@ use Config;
use IPC::Run qw(run binary);
# This is incremented every time there is a change to the API
-$VERSION = '2.03';
+$VERSION = '2.04';
=head1 NAME
@@ -333,77 +334,80 @@ to make all nodes box-shaped (unless explicity given another shape):
=cut
-
sub new {
- my $proto = shift;
- my $config = shift;
- my $class = ref($proto) || $proto;
- my $self = {};
-
- # Cope with the old hashref format
- if (ref($config) ne 'HASH') {
- my %config;
- %config = ($config, @_) if @_;
- $config = \%config;
- }
+ my $proto = shift;
+ my $config = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+
+ # Cope with the old hashref format
+ if ( ref($config) ne 'HASH' ) {
+ my %config;
+ %config = ( $config, @_ ) if @_;
+ $config = \%config;
+ }
- $self->{NODES} = {};
- $self->{NODELIST} = [];
- $self->{EDGES} = [];
+ $self->{NODES} = {};
+ $self->{NODELIST} = [];
+ $self->{EDGES} = [];
- if (exists $config->{directed}) {
- $self->{DIRECTED} = $config->{directed};
- } else {
- $self->{DIRECTED} = 1; # default to directed
- }
+ if ( exists $config->{directed} ) {
+ $self->{DIRECTED} = $config->{directed};
+ } else {
+ $self->{DIRECTED} = 1; # default to directed
+ }
- if (exists $config->{layout}) {
- $self->{LAYOUT} = $config->{layout};
- } else {
- $self->{LAYOUT} = "dot"; # default layout
- }
+ if ( exists $config->{layout} ) {
+ $self->{LAYOUT} = $config->{layout};
+ } else {
+ $self->{LAYOUT} = "dot"; # default layout
+ }
- if (exists $config->{name}) {
- $self->{NAME} = $config->{name};
- } else {
- $self->{NAME} = 'test';
- }
+ if ( exists $config->{name} ) {
+ $self->{NAME} = $config->{name};
+ } else {
+ $self->{NAME} = 'test';
+ }
- if (exists $config->{bgcolor}) {
- $self->{BGCOLOR} = $config->{bgcolor};
- }
+ if ( exists $config->{bgcolor} ) {
+ $self->{BGCOLOR} = $config->{bgcolor};
+ }
- $self->{RANK_DIR} = $config->{rankdir} if (exists $config->{rankdir});
+ $self->{RANK_DIR} = $config->{rankdir} if ( exists $config->{rankdir} );
- $self->{WIDTH} = $config->{width} if (exists $config->{width});
- $self->{HEIGHT} = $config->{height} if (exists $config->{height});
+ $self->{WIDTH} = $config->{width} if ( exists $config->{width} );
+ $self->{HEIGHT} = $config->{height} if ( exists $config->{height} );
- $self->{PAGEWIDTH} = $config->{pagewidth} if (exists $config->{pagewidth});
- $self->{PAGEHEIGHT} = $config->{pageheight} if (exists $config->{pageheight});
+ $self->{PAGEWIDTH} = $config->{pagewidth}
+ if ( exists $config->{pagewidth} );
+ $self->{PAGEHEIGHT} = $config->{pageheight}
+ if ( exists $config->{pageheight} );
- $self->{CONCENTRATE} = $config->{concentrate} if (exists $config->{concentrate});
+ $self->{CONCENTRATE} = $config->{concentrate}
+ if ( exists $config->{concentrate} );
- $self->{RANDOM_START} = $config->{random_start} if (exists $config->{random_start});
+ $self->{RANDOM_START} = $config->{random_start}
+ if ( exists $config->{random_start} );
- $self->{EPSILON} = $config->{epsilon} if (exists $config->{epsilon});
+ $self->{EPSILON} = $config->{epsilon} if ( exists $config->{epsilon} );
- $self->{SORT} = $config->{sort} if (exists $config->{sort});
+ $self->{SORT} = $config->{sort} if ( exists $config->{sort} );
- $self->{OVERLAP} = $config->{overlap} if (exists $config->{overlap});
- # no_overlap overrides overlap setting.
- $self->{OVERLAP} = 'false' if (exists $config->{no_overlap});
+ $self->{OVERLAP} = $config->{overlap} if ( exists $config->{overlap} );
- $self->{RATIO} = $config->{ratio} || 'fill';
+ # no_overlap overrides overlap setting.
+ $self->{OVERLAP} = 'false' if ( exists $config->{no_overlap} );
- # Global node, edge and graph attributes
- $self->{NODE_ATTRS} = $config->{node} if (exists $config->{node});
- $self->{EDGE_ATTRS} = $config->{edge} if (exists $config->{edge});
- $self->{GRAPH_ATTRS} = $config->{graph} if (exists $config->{graph});
+ $self->{RATIO} = $config->{ratio} || 'fill';
- bless($self, $class);
- return $self;
-}
+ # Global node, edge and graph attributes
+ $self->{NODE_ATTRS} = $config->{node} if ( exists $config->{node} );
+ $self->{EDGE_ATTRS} = $config->{edge} if ( exists $config->{edge} );
+ $self->{GRAPH_ATTRS} = $config->{graph} if ( exists $config->{graph} );
+ bless( $self, $class );
+ return $self;
+}
=head2 add_node
@@ -530,81 +534,90 @@ system, this is just a simple interface to it. See the 'from_port' and
=cut
sub add_node {
- my $self = shift;
- my $node = shift;
-
- # Cope with the new simple notation
- if (ref($node) ne 'HASH') {
- my $name = $node;
- my %node;
- if (@_ % 2 == 1) {
- # No name passed
- %node = ($name, @_);
- } else {
- # Name passed
- %node = (@_, name => $name);
+ my $self = shift;
+ my $node = shift;
+
+ # Cope with the new simple notation
+ if ( ref($node) ne 'HASH' ) {
+ my $name = $node;
+ my %node;
+ if ( @_ % 2 == 1 ) {
+
+ # No name passed
+ %node = ( $name, @_ );
+ } else {
+
+ # Name passed
+ %node = ( @_, name => $name );
+ }
+ $node = \%node;
}
- $node = \%node;
- }
- $self->add_node_munge($node) if $self->can('add_node_munge');
+ $self->add_node_munge($node) if $self->can('add_node_munge');
- # The _code attribute is our internal name for the node
- $node->{_code} = $self->_quote_name($node->{name});
+ # The _code attribute is our internal name for the node
+ $node->{_code} = $self->_quote_name( $node->{name} );
- if (not exists $node->{name}) {
- $node->{name} = $node->{_code};
- }
+ if ( not exists $node->{name} ) {
+ $node->{name} = $node->{_code};
+ }
- if (not exists $node->{label}) {
- if (exists $self->{NODES}->{$node->{name}} and defined $self->{NODES}->{$node->{name}}->{label}) {
- # keep our old label if we already exist
- $node->{label} = $self->{NODES}->{$node->{name}}->{label};
+ if ( not exists $node->{label} ) {
+ if ( exists $self->{NODES}->{ $node->{name} }
+ and defined $self->{NODES}->{ $node->{name} }->{label} )
+ {
+
+ # keep our old label if we already exist
+ $node->{label} = $self->{NODES}->{ $node->{name} }->{label};
+ } else {
+ $node->{label} = $node->{name};
+ }
} else {
- $node->{label} = $node->{name};
+ $node->{label} =~ s#([|<>\[\]{}"])#\\$1#g
+ unless $node->{shape}
+ && ($node->{shape} eq 'record'
+ || ( $node->{label} =~ /^<</
+ && $node->{shape} eq 'plaintext' )
+ );
}
- } else {
- $node->{label} =~ s#([|<>\[\]{}"])#\\$1#g unless $node->{shape} &&
- ($node->{shape} eq 'record' || ($node->{label} =~ /^<</ && $node->{shape} eq
- 'plaintext'));
- }
- delete $node->{cluster}
- if exists $node->{cluster} && !length $node->{cluster} ;
+ delete $node->{cluster}
+ if exists $node->{cluster} && !length $node->{cluster};
- $node->{_label} = $node->{label};
+ $node->{_label} = $node->{label};
- # Deal with ports
- if (ref($node->{label}) eq 'ARRAY') {
- $node->{shape} = 'record'; # force a record
- my $nports = 0;
- $node->{label} = join '|', map
- { $_ =~ s#([|<>\[\]{}"])#\\$1#g; '<port' . $nports++ . '>' . $_ }
- (@{$node->{label}});
- }
+ # Deal with ports
+ if ( ref( $node->{label} ) eq 'ARRAY' ) {
+ $node->{shape} = 'record'; # force a record
+ my $nports = 0;
+ $node->{label} = join '|', map {
+ $_ =~ s#([|<>\[\]{}"])#\\$1#g;
+ '<port' . $nports++ . '>' . $_
+ } ( @{ $node->{label} } );
+ }
- # Save ourselves
- if (!exists($self->{NODES}->{$node->{name}})) {
- $self->{NODES}->{$node->{name}} = $node;
- } else {
- # If the node already exists, add or overwrite attributes.
- foreach (keys %$node) {
- $self->{NODES}->{$node->{name}}->{$_} = $node->{$_};
+ # Save ourselves
+ if ( !exists( $self->{NODES}->{ $node->{name} } ) ) {
+ $self->{NODES}->{ $node->{name} } = $node;
+ } else {
+
+ # If the node already exists, add or overwrite attributes.
+ foreach ( keys %$node ) {
+ $self->{NODES}->{ $node->{name} }->{$_} = $node->{$_};
+ }
}
- }
- $self->{CODES}->{$node->{_code}} = $node->{name};
+ $self->{CODES}->{ $node->{_code} } = $node->{name};
- # Add the node to the nodelist, which contains the names of
- # all the nodes in the order that they were inserted (but only
- # if it's not already there)
- push @{$self->{NODELIST}}, $node->{name} unless
- grep { $_ eq $node->{name} } @{$self->{NODELIST}};
+ # Add the node to the nodelist, which contains the names of
+ # all the nodes in the order that they were inserted (but only
+ # if it's not already there)
+ push @{ $self->{NODELIST} }, $node->{name}
+ unless grep { $_ eq $node->{name} } @{ $self->{NODELIST} };
- return $node->{name};
+ return $node->{name};
}
-
=head2 add_edge
Edges are directed (or undirected) links between nodes. This method
@@ -717,32 +730,31 @@ offset of the port (ie 0, 1, 2...).
=cut
sub add_edge {
- my $self = shift;
- my $edge = shift;
-
- # Also cope with simple $from => $to
- if (ref($edge) ne 'HASH') {
- my $from = $edge;
- my %edge = (from => $from, to => shift, @_);
- $edge = \%edge;
- }
+ my $self = shift;
+ my $edge = shift;
+
+ # Also cope with simple $from => $to
+ if ( ref($edge) ne 'HASH' ) {
+ my $from = $edge;
+ my %edge = ( from => $from, to => shift, @_ );
+ $edge = \%edge;
+ }
- $self->add_edge_munge($edge) if $self->can('add_edge_munge');
+ $self->add_edge_munge($edge) if $self->can('add_edge_munge');
- if (not exists $edge->{from} or not exists $edge->{to}) {
- carp("GraphViz add_edge: 'from' or 'to' parameter missing!");
- return;
- }
+ if ( not exists $edge->{from} or not exists $edge->{to} ) {
+ carp("GraphViz add_edge: 'from' or 'to' parameter missing!");
+ return;
+ }
- my $from = $edge->{from};
- my $to = $edge->{to};
- $self->add_node($from) unless exists $self->{NODES}->{$from};
- $self->add_node($to) unless exists $self->{NODES}->{$to};
+ my $from = $edge->{from};
+ my $to = $edge->{to};
+ $self->add_node($from) unless exists $self->{NODES}->{$from};
+ $self->add_node($to) unless exists $self->{NODES}->{$to};
- push @{$self->{EDGES}}, $edge; # should remove!
+ push @{ $self->{EDGES} }, $edge; # should remove!
}
-
=head2 as_canon, as_text, as_gif etc. methods
There are a number of methods which generate input for dot / neato /
@@ -963,261 +975,286 @@ Returns a string which contains a layed-out simple-format file.
# Generate magic methods to save typing
sub AUTOLOAD {
- my $self = shift;
- my $type = ref($self)
- or croak("$self is not an object");
- my $output = shift;
+ my $self = shift;
+ my $type = ref($self)
+ or croak("$self is not an object");
+ my $output = shift;
- my $name = $AUTOLOAD;
- $name =~ s/.*://; # strip fully-qualified portion
+ my $name = $AUTOLOAD;
+ $name =~ s/.*://; # strip fully-qualified portion
- return if $name =~ /DESTROY/;
+ return if $name =~ /DESTROY/;
- if ($name eq 'as_text') {
- $name = "as_dot";
- }
+ if ( $name eq 'as_text' ) {
+ $name = "as_dot";
+ }
- if ($name =~ /^as_(ps|hpgl|pcl|mif|pic|gd|gd2|gif|jpeg|png|wbmp|cmapx?|ismap|imap|vrml|vtx|mp|fig|svgz?|dot|canon|plain)$/) {
- my $data = $self->_as_generic('-T' . $1, $self->_as_debug, $output);
- return $data;
- }
+ if ( $name
+ =~ /^as_(ps|hpgl|pcl|mif|pic|gd|gd2|gif|jpeg|png|wbmp|cmapx?|ismap|imap|vrml|vtx|mp|fig|svgz?|dot|canon|plain)$/
+ )
+ {
+ my $data = $self->_as_generic( '-T' . $1, $self->_as_debug, $output );
+ return $data;
+ }
- croak "Method $name not defined!";
+ croak "Method $name not defined!";
}
-
# Return the main dot text
sub as_debug {
- my $self = shift;
- return $self->_as_debug(@_);
+ my $self = shift;
+ return $self->_as_debug(@_);
}
sub _as_debug {
- my $self = shift;
+ my $self = shift;
- my $dot;
+ my $dot;
- my $graph_type = $self->{DIRECTED} ? 'digraph' : 'graph';
+ my $graph_type = $self->{DIRECTED} ? 'digraph' : 'graph';
- $dot .= $graph_type ." ". $self->{NAME} ." {\n";
+ $dot .= $graph_type . " " . $self->{NAME} . " {\n";
- # the direction of the graph
- $dot .= "\trankdir=LR;\n" if $self->{RANK_DIR};
+ # the direction of the graph
+ $dot .= "\trankdir=LR;\n" if $self->{RANK_DIR};
- # the size of the graph
- $dot .= "\tsize=\"" . $self->{WIDTH} . "," . $self->{HEIGHT} ."\";\n" if $self->{WIDTH} && $self->{HEIGHT};
- $dot .= "\tpage=\"" . $self->{PAGEWIDTH} . "," . $self->{PAGEHEIGHT} ."\";\n" if $self->{PAGEWIDTH} && $self->{PAGEHEIGHT};
-
- # Ratio setting
- $dot .= "\tratio=\"" . $self->{RATIO} . "\";\n";
+ # the size of the graph
+ $dot .= "\tsize=\"" . $self->{WIDTH} . "," . $self->{HEIGHT} . "\";\n"
+ if $self->{WIDTH} && $self->{HEIGHT};
+ $dot
+ .= "\tpage=\""
+ . $self->{PAGEWIDTH} . ","
+ . $self->{PAGEHEIGHT} . "\";\n"
+ if $self->{PAGEWIDTH} && $self->{PAGEHEIGHT};
- # edge merging
- $dot .= "\tconcentrate=true;\n" if $self->{CONCENTRATE};
+ # Ratio setting
+ $dot .= "\tratio=\"" . $self->{RATIO} . "\";\n";
- # epsilon
- $dot .= "\tepsilon=" . $self->{EPSILON} . ";\n" if $self->{EPSILON};
+ # edge merging
+ $dot .= "\tconcentrate=true;\n" if $self->{CONCENTRATE};
- # random start
- $dot .= "\tstart=rand;\n" if $self->{RANDOM_START};
+ # epsilon
+ $dot .= "\tepsilon=" . $self->{EPSILON} . ";\n" if $self->{EPSILON};
- # overlap
- $dot .= "\toverlap=\"" . $self->{OVERLAP} . "\";\n" if $self->{OVERLAP};
+ # random start
+ $dot .= "\tstart=rand;\n" if $self->{RANDOM_START};
- # color, bgcolor
- $dot .= "\tbgcolor=\"" . $self->{BGCOLOR} . "\";\n" if $self->{BGCOLOR};
+ # overlap
+ $dot .= "\toverlap=\"" . $self->{OVERLAP} . "\";\n" if $self->{OVERLAP};
- # Global node, edge and graph attributes
- $dot .= "\tnode" . _attributes($self->{NODE_ATTRS}) . ";\n"
- if exists($self->{NODE_ATTRS});
- $dot .= "\tedge" . _attributes($self->{EDGE_ATTRS}) . ";\n"
- if exists($self->{EDGE_ATTRS});
- $dot .= "\tgraph" . _attributes($self->{GRAPH_ATTRS}) . ";\n"
- if exists($self->{GRAPH_ATTRS});
+ # color, bgcolor
+ $dot .= "\tbgcolor=\"" . $self->{BGCOLOR} . "\";\n" if $self->{BGCOLOR};
- my %clusters = ();
- my %cluster_nodes = ();
- my %clusters_edge = ();
+ # Global node, edge and graph attributes
+ $dot .= "\tnode" . _attributes( $self->{NODE_ATTRS} ) . ";\n"
+ if exists( $self->{NODE_ATTRS} );
+ $dot .= "\tedge" . _attributes( $self->{EDGE_ATTRS} ) . ";\n"
+ if exists( $self->{EDGE_ATTRS} );
+ $dot .= "\tgraph" . _attributes( $self->{GRAPH_ATTRS} ) . ";\n"
+ if exists( $self->{GRAPH_ATTRS} );
- my $arrow = $self->{DIRECTED} ? ' -> ' : ' -- ';
+ my %clusters = ();
+ my %cluster_nodes = ();
+ my %clusters_edge = ();
- # Add all the nodes
- my @nodelist = @{$self->{NODELIST}};
- @nodelist = sort @nodelist if $self->{SORT};
+ my $arrow = $self->{DIRECTED} ? ' -> ' : ' -- ';
- foreach my $name (@nodelist) {
- my $node = $self->{NODES}->{$name};
+ # Add all the nodes
+ my @nodelist = @{ $self->{NODELIST} };
+ @nodelist = sort @nodelist if $self->{SORT};
- # Note all the clusters
- if (exists $node->{cluster} && $node->{cluster}) {
- # map "name" to value in case cluster attribute is not a simple string
- $clusters{$node->{cluster}} = $node->{cluster};
- push @{$cluster_nodes{$node->{cluster}}}, $name;
- next;
- }
-
- $dot .= "\t" . $node->{_code} . _attributes($node) . ";\n";
- }
+ foreach my $name (@nodelist) {
+ my $node = $self->{NODES}->{$name};
- # Add all the edges
- foreach my $edge (sort { $a->{from} cmp $b->{from} || $a->{to} cmp $b->{to} } @{$self->{EDGES}}) {
+ # Note all the clusters
+ if ( exists $node->{cluster} && $node->{cluster} ) {
- my $from = $self->{NODES}->{$edge->{from}}->{_code};
- my $to = $self->{NODES}->{$edge->{to}}->{_code};
+ # map "name" to value in case cluster attribute is not a simple string
+ $clusters{ $node->{cluster} } = $node->{cluster};
+ push @{ $cluster_nodes{ $node->{cluster} } }, $name;
+ next;
+ }
- # Deal with ports
- if (exists $edge->{from_port}) {
- $from = '"' . $from . '"' . ':port' . $edge->{from_port};
- }
- if (exists $edge->{to_port}) {
- $to = '"' . $to . '"' . ':port' . $edge->{to_port};
+ $dot .= "\t" . $node->{_code} . _attributes($node) . ";\n";
}
- if (exists $self->{NODES}->{$from} && exists $self->{NODES}->{$from}->{cluster}
- && exists $self->{NODES}->{$to} && exists $self->{NODES}->{$to}->{cluster} &&
- $self->{NODES}->{$from}->{cluster} eq $self->{NODES}->{$to}->{cluster}) {
-
- $clusters_edge{$self->{NODES}->{$from}->{cluster}} .= "\t\t" . $from . $arrow . $to . _attributes($edge) . ";\n";
- } else {
- $dot .= "\t" . $from . $arrow . $to . _attributes($edge) . ";\n";
+ # Add all the edges
+ foreach
+ my $edge ( sort { $a->{from} cmp $b->{from} || $a->{to} cmp $b->{to} }
+ @{ $self->{EDGES} } )
+ {
+
+ my $from = $self->{NODES}->{ $edge->{from} }->{_code};
+ my $to = $self->{NODES}->{ $edge->{to} }->{_code};
+
+ # Deal with ports
+ if ( exists $edge->{from_port} ) {
+ $from = '"' . $from . '"' . ':port' . $edge->{from_port};
+ }
+ if ( exists $edge->{to_port} ) {
+ $to = '"' . $to . '"' . ':port' . $edge->{to_port};
+ }
+
+ if ( exists $self->{NODES}->{$from}
+ && exists $self->{NODES}->{$from}->{cluster}
+ && exists $self->{NODES}->{$to}
+ && exists $self->{NODES}->{$to}->{cluster}
+ && $self->{NODES}->{$from}->{cluster} eq
+ $self->{NODES}->{$to}->{cluster} )
+ {
+
+ $clusters_edge{ $self->{NODES}->{$from}->{cluster} }
+ .= "\t\t" . $from . $arrow . $to . _attributes($edge) . ";\n";
+ } else {
+ $dot .= "\t" . $from . $arrow . $to . _attributes($edge) . ";\n";
+ }
}
- }
- foreach my $clustername (sort keys %cluster_nodes) {
- my $cluster = $clusters{$clustername};
- my $attrs;
- my $name;
- if (ref($cluster) eq 'HASH') {
- if (exists $cluster->{label}) {
- $name = $cluster->{label};
- }
- elsif (exists $cluster->{name}) {
- # "coerce" name attribute into label attribute
- $name = $cluster->{name};
- $cluster->{label} = $name;
- delete $cluster->{name};
- }
- $attrs = _attributes($cluster);
- } else {
- $name = $cluster;
- $attrs = _attributes({ label => $cluster});
+ foreach my $clustername ( sort keys %cluster_nodes ) {
+ my $cluster = $clusters{$clustername};
+ my $attrs;
+ my $name;
+ if ( ref($cluster) eq 'HASH' ) {
+ if ( exists $cluster->{label} ) {
+ $name = $cluster->{label};
+ } elsif ( exists $cluster->{name} ) {
+
+ # "coerce" name attribute into label attribute
+ $name = $cluster->{name};
+ $cluster->{label} = $name;
+ delete $cluster->{name};
+ }
+ $attrs = _attributes($cluster);
+ } else {
+ $name = $cluster;
+ $attrs = _attributes( { label => $cluster } );
+ }
+
+ # rewrite attributes string slightly
+ $attrs =~ s/^\s\[//o;
+ $attrs =~ s/,/;/go;
+ $attrs =~ s/\]$//o;
+
+ $dot .= "\tsubgraph cluster_" . $self->_quote_name($name) . " {\n";
+ $dot .= "\t\t$attrs;\n";
+ $dot .= join "", map {
+ "\t\t"
+ . $self->{NODES}->{$_}->{_code}
+ . _attributes( $self->{NODES}->{$_} ) . ";\n";
+ } ( @{ $cluster_nodes{$cluster} } );
+ $dot .= $clusters_edge{$cluster} if exists $clusters_edge{$cluster};
+ $dot .= "\t}\n";
}
- # rewrite attributes string slightly
- $attrs =~ s/^\s\[//o;
- $attrs =~ s/,/;/go;
- $attrs =~ s/\]$//o;
-
- $dot .= "\tsubgraph cluster_" . $self->_quote_name($name) . " {\n";
- $dot .= "\t\t$attrs;\n";
- $dot .= join "", map { "\t\t" . $self->{NODES}->{$_}->{_code} . _attributes($self->{NODES}->{$_}) . ";\n"; } (@{$cluster_nodes{$cluster}});
- $dot .= $clusters_edge{$cluster} if exists $clusters_edge{$cluster};
- $dot .= "\t}\n";
- }
- # Deal with ranks
- my %ranks;
- foreach my $name (@nodelist) {
- my $node = $self->{NODES}->{$name};
- next unless exists $node->{rank};
- push @{$ranks{$node->{rank}}}, $name;
- }
+ # Deal with ranks
+ my %ranks;
+ foreach my $name (@nodelist) {
+ my $node = $self->{NODES}->{$name};
+ next unless exists $node->{rank};
+ push @{ $ranks{ $node->{rank} } }, $name;
+ }
- foreach my $rank (keys %ranks) {
- $dot .= qq|\t{rank=same; |;
- $dot .= join '; ', map { $self->_quote_name($_) } @{$ranks{$rank}};
- $dot .= qq|}\n|;
- }
-# {rank=same; Paris; Boston}
+ foreach my $rank ( keys %ranks ) {
+ $dot .= qq|\t{rank=same; |;
+ $dot .= join '; ', map { $self->_quote_name($_) } @{ $ranks{$rank} };
+ $dot .= qq|}\n|;
+ }
+ # {rank=same; Paris; Boston}
- $dot .= "}\n";
+ $dot .= "}\n";
- return $dot;
+ return $dot;
}
-
# Call dot / neato / twopi / circo / fdp with the input text and any parameters
sub _as_generic {
- my($self, $type, $dot, $output) = @_;
-
- my $buffer;
- my $out;
- if ( ref $output || UNIVERSAL::isa(\$output, 'GLOB') ) {
- # $output is a filehandle or a scalar reference or something.
- # have to take a reference to a bare filehandle or run will
- # complain
- $out = ref $output ? $output : \$output;
- } elsif (defined $output) {
- # if it's defined it must be a filename so we'll write to it.
- $out = $output;
- } else {
- # but otherwise we capture output in a scalar
- $out = \$buffer;
- }
+ my ( $self, $type, $dot, $output ) = @_;
- my $program = $self->{LAYOUT};
+ my $buffer;
+ my $out;
+ if ( ref $output || UNIVERSAL::isa( \$output, 'GLOB' ) ) {
- run [$program, $type], \$dot, ">", binary(), $out;
+ # $output is a filehandle or a scalar reference or something.
+ # have to take a reference to a bare filehandle or run will
+ # complain
+ $out = ref $output ? $output : \$output;
+ } elsif ( defined $output ) {
- return $buffer unless defined $output;
-}
+ # if it's defined it must be a filename so we'll write to it.
+ $out = $output;
+ } else {
+
+ # but otherwise we capture output in a scalar
+ $out = \$buffer;
+ }
+ my $program = $self->{LAYOUT};
+
+ run [ $program, $type ], \$dot, ">", binary(), $out;
+
+ return $buffer unless defined $output;
+}
# Quote a node/edge name using dot / neato / circo / fdp / twopi's quoting rules
sub _quote_name {
- my($self, $name) = @_;
- my $realname = $name;
-
- return $self->{_QUOTE_NAME_CACHE}->{$name} if $name && exists $self->{_QUOTE_NAME_CACHE}->{$name};
-
- if (defined $name && $name =~ /^[a-zA-Z]\w*$/ && $name ne "graph") {
- # name is fine
- } elsif (defined $name && $name =~ /^[a-zA-Z](\w| )*$/) {
- # name contains spaces, so quote it
- $name = '"' . $name . '"';
- } else {
- # name contains weird characters - let's make up a name for it
- $name = 'node' . ++$self->{_NAME_COUNTER};
- }
+ my ( $self, $name ) = @_;
+ my $realname = $name;
- $self->{_QUOTE_NAME_CACHE}->{$realname} = $name if defined $realname;
+ return $self->{_QUOTE_NAME_CACHE}->{$name}
+ if $name && exists $self->{_QUOTE_NAME_CACHE}->{$name};
-# warn "# $realname -> $name\n";
+ if ( defined $name && $name =~ /^[a-zA-Z]\w*$/ && $name ne "graph" ) {
- return $name;
-}
+ # name is fine
+ } elsif ( defined $name && $name =~ /^[a-zA-Z](\w| )*$/ ) {
+
+ # name contains spaces, so quote it
+ $name = '"' . $name . '"';
+ } else {
+
+ # name contains weird characters - let's make up a name for it
+ $name = 'node' . ++$self->{_NAME_COUNTER};
+ }
+
+ $self->{_QUOTE_NAME_CACHE}->{$realname} = $name if defined $realname;
+ # warn "# $realname -> $name\n";
+
+ return $name;
+}
# Return the attributes of a node or edge as a dot / neato / circo / fdp / twopi attribute
# string
sub _attributes {
- my $thing = shift;
+ my $thing = shift;
- my @attributes;
+ my @attributes;
- foreach my $key (keys %$thing) {
- next if $key =~ /^_/;
- next if $key =~ /^(to|from|name|cluster|from_port|to_port)$/;
+ foreach my $key ( keys %$thing ) {
+ next if $key =~ /^_/;
+ next if $key =~ /^(to|from|name|cluster|from_port|to_port)$/;
- my $value = $thing->{$key};
- $value =~ s|"|\"|g;
- $value = '"' . $value . '"' unless ($key eq 'label' && $value =~ /^<</);
- $value =~ s|\n|\\n|g;
+ my $value = $thing->{$key};
+ $value =~ s|"|\"|g;
+ $value = '"' . $value . '"'
+ unless ( $key eq 'label' && $value =~ /^<</ );
+ $value =~ s|\n|\\n|g;
- $value = '""' if not defined $value;
- push @attributes, "$key=$value";
- }
+ $value = '""' if not defined $value;
+ push @attributes, "$key=$value";
+ }
- if (@attributes) {
- return ' [' . (join ', ', sort @attributes) . "]";
- } else {
- return "";
- }
+ if (@attributes) {
+ return ' [' . ( join ', ', sort @attributes ) . "]";
+ } else {
+ return "";
+ }
}
-
=head1 NOTES
Older versions of GraphViz used a slightly different syntax for node
@@ -1237,6 +1274,8 @@ Leon Brocard E<lt>F<acme at astray.com>E<gt>
Copyright (C) 2000-4, Leon Brocard
+=head1 LICENSE
+
This module is free software; you can redistribute it or modify it
under the same terms as Perl itself.
diff --git a/lib/GraphViz/Data/Grapher.pm b/lib/GraphViz/Data/Grapher.pm
index a421f3d..01724f6 100755
--- a/lib/GraphViz/Data/Grapher.pm
+++ b/lib/GraphViz/Data/Grapher.pm
@@ -1,6 +1,7 @@
package GraphViz::Data::Grapher;
use strict;
+use warnings;
use vars qw($VERSION);
use Carp;
use lib '../..';
@@ -50,20 +51,18 @@ to be visualised. A GraphViz object is returned.
=cut
-
sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my @items = @_;
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my @items = @_;
- my $graph = GraphViz->new(sort => 1);
+ my $graph = GraphViz->new( sort => 1 );
- _init($graph, @items);
+ _init( $graph, @items );
- return $graph;
+ return $graph;
}
-
=head2 as_*
The data structure can be visualised in a number of different
@@ -80,78 +79,83 @@ documentation for more information. The two most common methods are:
=cut
-
sub _init {
- my($graph, @items) = @_;
-
- my @parts;
-
- foreach my $item (@items) {
- push @parts, _label($item);
- }
-
- my $colour = 'black';
- $colour = 'blue' if @parts == 1;
-
- my $source = $graph->add_node({ label => \@parts, color => $colour });
-
- foreach my $port (0.. @items-1) {
- my $item = $items[$port];
-#warn "$port = $item\n";
-
- next unless ref $item;
- my $ref = ref $item;
- if ($ref eq 'SCALAR') {
- my $target = _init($graph, $$item);
- $graph->add_edge({ from => $source, from_port => $port, to => $target });
- } elsif ($ref eq 'ARRAY') {
- my $target = _init($graph, @$item);
- $graph->add_edge({ from => $source, from_port => $port, to => $target });
- } elsif ($ref eq 'HASH') {
- my @hash;
- foreach my $key (sort keys(%$item)) {
- push @hash, $key;
- }
- my $hash = $graph->add_node({ label => \@hash, color => 'brown' });
- foreach my $port (0.. @hash-1) {
- my $key = $hash[$port];
- my $target = _init($graph, $item->{$key});
- $graph->add_edge({ from => $hash, from_port => $port, to => $target });
- }
- $graph->add_edge({ from => $source, from_port => $port, to => $hash });
- } else {
- my $target = $ref;
- $ref =~ s/=.+$//;
- $graph->add_node({ name=> $target, label => $ref, color => 'red' });
- $graph->add_edge({ from => $source, from_port => $port, to => $target });
+ my ( $graph, @items ) = @_;
+
+ my @parts;
+
+ foreach my $item (@items) {
+ push @parts, _label($item);
}
- }
- return $source;
-}
+ my $colour = 'black';
+ $colour = 'blue' if @parts == 1;
+
+ my $source = $graph->add_node( { label => \@parts, color => $colour } );
+
+ foreach my $port ( 0 .. @items - 1 ) {
+ my $item = $items[$port];
+
+ #warn "$port = $item\n";
+
+ next unless ref $item;
+ my $ref = ref $item;
+ if ( $ref eq 'SCALAR' ) {
+ my $target = _init( $graph, $$item );
+ $graph->add_edge(
+ { from => $source, from_port => $port, to => $target } );
+ } elsif ( $ref eq 'ARRAY' ) {
+ my $target = _init( $graph, @$item );
+ $graph->add_edge(
+ { from => $source, from_port => $port, to => $target } );
+ } elsif ( $ref eq 'HASH' ) {
+ my @hash;
+ foreach my $key ( sort keys(%$item) ) {
+ push @hash, $key;
+ }
+ my $hash
+ = $graph->add_node( { label => \@hash, color => 'brown' } );
+ foreach my $port ( 0 .. @hash - 1 ) {
+ my $key = $hash[$port];
+ my $target = _init( $graph, $item->{$key} );
+ $graph->add_edge(
+ { from => $hash, from_port => $port, to => $target } );
+ }
+ $graph->add_edge(
+ { from => $source, from_port => $port, to => $hash } );
+ } else {
+ my $target = $ref;
+ $ref =~ s/=.+$//;
+ $graph->add_node(
+ { name => $target, label => $ref, color => 'red' } );
+ $graph->add_edge(
+ { from => $source, from_port => $port, to => $target } );
+ }
+ }
+ return $source;
+}
sub _label {
- my $scalar = shift;
-
- my $ref = ref $scalar;
-
- if (not defined $scalar) {
- return 'undef';
- } elsif ($ref eq 'ARRAY') {
- return '@';
- } elsif ($ref eq 'SCALAR') {
- return '$';
- } elsif ($ref eq 'HASH') {
- return '%';
- } elsif ($ref) {
- return 'Object';
- } else {
- return $scalar;
- }
+ my $scalar = shift;
+
+ my $ref = ref $scalar;
+
+ if ( not defined $scalar ) {
+ return 'undef';
+ } elsif ( $ref eq 'ARRAY' ) {
+ return '@';
+ } elsif ( $ref eq 'SCALAR' ) {
+ return '$';
+ } elsif ( $ref eq 'HASH' ) {
+ return '%';
+ } elsif ($ref) {
+ return 'Object';
+ } else {
+ return $scalar;
+ }
}
-
=head1 AUTHOR
Leon Brocard E<lt>F<acme at astray.com>E<gt>
diff --git a/lib/GraphViz/No.pm b/lib/GraphViz/No.pm
index 68c18bb..a0f026c 100644
--- a/lib/GraphViz/No.pm
+++ b/lib/GraphViz/No.pm
@@ -1,6 +1,7 @@
package GraphViz::No;
use strict;
+use warnings;
use GraphViz;
use vars qw($VERSION @ISA);
@@ -33,20 +34,20 @@ As for GraphViz.
=cut
sub add_node_munge {
- my $self = shift;
- my $node = shift;
+ my $self = shift;
+ my $node = shift;
- $node->{label} = '';
- $node->{height} = 0;
- $node->{width} = 0;
- $node->{style} = 'invis';
+ $node->{label} = '';
+ $node->{height} = 0;
+ $node->{width} = 0;
+ $node->{style} = 'invis';
}
sub add_edge_munge {
- my $self = shift;
- my $edge = shift;
+ my $self = shift;
+ my $edge = shift;
- $edge->{color} = rand() . "," . "1,1";
+ $edge->{color} = rand() . "," . "1,1";
}
=head1 AUTHOR
diff --git a/lib/GraphViz/Parse/RecDescent.pm b/lib/GraphViz/Parse/RecDescent.pm
index efa622a..b38119f 100755
--- a/lib/GraphViz/Parse/RecDescent.pm
+++ b/lib/GraphViz/Parse/RecDescent.pm
@@ -1,6 +1,7 @@
package GraphViz::Parse::RecDescent;
use strict;
+use warnings;
use vars qw($VERSION);
use Carp;
use lib '../..';
@@ -64,21 +65,20 @@ grammar to be visualised. A GraphViz object is returned.
=cut
-
sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $parser = shift;
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $parser = shift;
- if (ref($parser) ne 'Parse::RecDescent') {
- # We got a grammar instead, so we construct our own parser
- $parser = Parse::RecDescent->new($parser)
- or carp("Bad grammar");
- }
+ if ( ref($parser) ne 'Parse::RecDescent' ) {
- return _init($parser);
-}
+ # We got a grammar instead, so we construct our own parser
+ $parser = Parse::RecDescent->new($parser)
+ or carp("Bad grammar");
+ }
+ return _init($parser);
+}
=head2 as_*
@@ -96,86 +96,90 @@ for more information. The two most common methods are:
=cut
-
# Given a parser object, we look inside its internals and build up a
# graph of the rules, productions, and items. This is a tad scary and
# hopefully Parse::FastDescent will make this all much easier.
sub _init {
- my $parser = shift;
-
- # Our wonderful graph object
- my $graph = GraphViz->new();
-
- # A grammar consists of rules
- my %rules = %{$parser->{rules}};
-
- foreach my $rule (keys %rules) {
-
-# print "$rule:\n";
- my $rule_label;
-
- # Rules consist of productions
- my @productions = @{$rules{$rule}->{prods}};
-
- foreach my $production (@productions) {
-
- my $production_text;
-
- # Productions consist of items
- my @items = @{$production->{items}};
-
- foreach my $item (@items) {
- my $text;
- my $type = ref $item;
- $type =~ s/^Parse::RecDescent:://;
-
- # We ignore Action rules
- next if $type eq 'Action';
-
- # We could probably use a switch here ;-)
- if ($type eq 'Subrule') {
- $text = $item->{subrule};
- $text .= $item->{argcode} if defined($item->{argcode});
- } elsif ($type =~ /^(Literal|Token|InterpLit)$/) {
- # These are all literals
- $text = $item->{description};
- } elsif ($type eq 'Error') {
- # We make sure error messages are shown
- if ($item->{msg}) {
- $text = '<error:' . $item->{msg} . '>';
- } else {
- $text = '<error>';
- }
- } elsif ($type eq 'Repetition') {
- # We make sure we show the repetition specifier
- $text = $item->{subrule} . '(' . $item->{repspec} . ')';
- } elsif ($type eq 'Operator') {
- $text = $item->{expected};
- } elsif ($type =~ /^(Directive|UncondReject)$/) {
- $text = $item->{name};
- } else {
- # It's something we don't know about, so complain!
- warn "GraphViz::Parse::RecDescent: unknown type $type found!\n";
- $text = "?$type?";
- }
-
- $production_text .= $text . " ";
- }
-
-# print " $production_text\n";
- $rule_label .= $production_text . "\\n";
- }
+ my $parser = shift;
+
+ # Our wonderful graph object
+ my $graph = GraphViz->new();
+
+ # A grammar consists of rules
+ my %rules = %{ $parser->{rules} };
+
+ foreach my $rule ( keys %rules ) {
+
+ # print "$rule:\n";
+ my $rule_label;
+
+ # Rules consist of productions
+ my @productions = @{ $rules{$rule}->{prods} };
+
+ foreach my $production (@productions) {
+
+ my $production_text;
+
+ # Productions consist of items
+ my @items = @{ $production->{items} };
+
+ foreach my $item (@items) {
+ my $text;
+ my $type = ref $item;
+ $type =~ s/^Parse::RecDescent:://;
+
+ # We ignore Action rules
+ next if $type eq 'Action';
+
+ # We could probably use a switch here ;-)
+ if ( $type eq 'Subrule' ) {
+ $text = $item->{subrule};
+ $text .= $item->{argcode} if defined( $item->{argcode} );
+ } elsif ( $type =~ /^(Literal|Token|InterpLit)$/ ) {
+
+ # These are all literals
+ $text = $item->{description};
+ } elsif ( $type eq 'Error' ) {
+
+ # We make sure error messages are shown
+ if ( $item->{msg} ) {
+ $text = '<error:' . $item->{msg} . '>';
+ } else {
+ $text = '<error>';
+ }
+ } elsif ( $type eq 'Repetition' ) {
+
+ # We make sure we show the repetition specifier
+ $text = $item->{subrule} . '(' . $item->{repspec} . ')';
+ } elsif ( $type eq 'Operator' ) {
+ $text = $item->{expected};
+ } elsif ( $type =~ /^(Directive|UncondReject)$/ ) {
+ $text = $item->{name};
+ } else {
+
+ # It's something we don't know about, so complain!
+ warn
+ "GraphViz::Parse::RecDescent: unknown type $type found!\n";
+ $text = "?$type?";
+ }
+
+ $production_text .= $text . " ";
+ }
+
+ # print " $production_text\n";
+ $rule_label .= $production_text . "\\n";
+ }
- # Add the node for the current rule
- $graph->add_node($rule, label => [$rule, $rule_label]);
+ # Add the node for the current rule
+ $graph->add_node( $rule, label => [ $rule, $rule_label ] );
- # Make links to the rules called
- foreach my $called (@{$rules{$rule}->{calls}}) {
- $graph->add_edge($rule => $called);
+ # Make links to the rules called
+ foreach my $called ( @{ $rules{$rule}->{calls} } ) {
+ $graph->add_edge( $rule => $called );
+ }
}
- }
- return $graph;
+ return $graph;
}
=head1 BUGS
diff --git a/lib/GraphViz/Parse/Yacc.pm b/lib/GraphViz/Parse/Yacc.pm
index cf02eaf..3917dd1 100755
--- a/lib/GraphViz/Parse/Yacc.pm
+++ b/lib/GraphViz/Parse/Yacc.pm
@@ -1,6 +1,7 @@
package GraphViz::Parse::Yacc;
use strict;
+use warnings;
use vars qw($VERSION);
use Carp;
use lib '../..';
@@ -59,14 +60,13 @@ as an argument here. A GraphViz object is returned.
=cut
sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $filename = shift;
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $filename = shift;
- return _init($filename);
+ return _init($filename);
}
-
=head2 as_*
The grammar can be visualised in a number of different graphical
@@ -84,53 +84,52 @@ for more information. The two most common methods are:
=cut
sub _init {
- my $filename = shift;
- my(@links, %edges, %labels, %is_rule);
- my $graph = GraphViz->new(concentrate => 1);
+ my $filename = shift;
+ my ( @links, %edges, %labels, %is_rule );
+ my $graph = GraphViz->new( concentrate => 1 );
- open(IN, $filename) || carp("Couldn't read file $filename");
- my $rule;
+ open( IN, $filename ) || carp("Couldn't read file $filename");
+ my $rule;
- foreach my $line (<IN>) {
- chomp $line;
- next unless $line =~ /\w/;
- next unless $line =~ s/^\s+\d+\s+//;
+ foreach my $line (<IN>) {
+ chomp $line;
+ next unless $line =~ /\w/;
+ next unless $line =~ s/^\s+\d+\s+//;
- if ($line =~ s/([^ ]+) : ?//) {
- $rule = $1;
- }
+ if ( $line =~ s/([^ ]+) : ?// ) {
+ $rule = $1;
+ }
- $line =~ s/\|\s+//;
+ $line =~ s/\|\s+//;
- my $text = $line;
- $is_rule{$rule}++;
+ my $text = $line;
+ $is_rule{$rule}++;
- $text = "(empty)" if $text =~ /^\s*$/;
+ $text = "(empty)" if $text =~ /^\s*$/;
- my $rule_label;
- foreach my $item (split ' ', $text) {
- $edges{$rule}{$item}++;
- $rule_label .= $item . " ";
- }
- $rule_label .= '\n';
- $labels{$rule} .= $rule_label;
- }
-
- foreach my $from (keys %edges) {
- next unless $is_rule{$from};
- foreach my $to (keys %{$edges{$from}}) {
- next unless $is_rule{$to};
- $graph->add_edge($from => $to);
+ my $rule_label;
+ foreach my $item ( split ' ', $text ) {
+ $edges{$rule}{$item}++;
+ $rule_label .= $item . " ";
+ }
+ $rule_label .= '\n';
+ $labels{$rule} .= $rule_label;
}
- }
+ foreach my $from ( keys %edges ) {
+ next unless $is_rule{$from};
+ foreach my $to ( keys %{ $edges{$from} } ) {
+ next unless $is_rule{$to};
+ $graph->add_edge( $from => $to );
+ }
+ }
- foreach my $rule (keys %labels) {
- $graph->add_node($rule, label => [$rule, $labels{$rule}]);
- }
+ foreach my $rule ( keys %labels ) {
+ $graph->add_node( $rule, label => [ $rule, $labels{$rule} ] );
+ }
- close(IN);
- return $graph;
+ close(IN);
+ return $graph;
}
=head1 AUTHOR
diff --git a/lib/GraphViz/Parse/Yapp.pm b/lib/GraphViz/Parse/Yapp.pm
index 226914c..ad626cf 100755
--- a/lib/GraphViz/Parse/Yapp.pm
+++ b/lib/GraphViz/Parse/Yapp.pm
@@ -1,6 +1,7 @@
package GraphViz::Parse::Yapp;
use strict;
+use warnings;
use vars qw($VERSION);
use Carp;
use lib '../..';
@@ -59,14 +60,13 @@ as an argument here. A GraphViz object is returned.
=cut
sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $filename = shift;
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $filename = shift;
- return _init($filename);
+ return _init($filename);
}
-
=head2 as_*
The grammar can be visualised in a number of different graphical
@@ -84,46 +84,45 @@ for more information. The two most common methods are:
=cut
sub _init {
- my $filename = shift;
- my(@links, %edges, %labels, %is_rule);
- my $graph = GraphViz->new();
+ my $filename = shift;
+ my ( @links, %edges, %labels, %is_rule );
+ my $graph = GraphViz->new();
- open(IN, $filename) || carp("Couldn't read file $filename");
+ open( IN, $filename ) || carp("Couldn't read file $filename");
- foreach my $line (<IN>) {
- chomp $line;
- next unless $line =~ /\w/;
- next unless $line =~ s/^\d+:\s+//;
+ foreach my $line (<IN>) {
+ chomp $line;
+ next unless $line =~ /\w/;
+ next unless $line =~ s/^\d+:\s+//;
- my($rule, $text) = $line =~ /^(.+) -> (.+)$/;
- $is_rule{$rule}++;
+ my ( $rule, $text ) = $line =~ /^(.+) -> (.+)$/;
+ $is_rule{$rule}++;
- $text = "(empty)" if $text eq '/* empty */';
+ $text = "(empty)" if $text eq '/* empty */';
- my $rule_label;
- foreach my $item (split ' ', $text) {
- $edges{$rule}{$item}++;
- $rule_label .= $item . " ";
- }
- $rule_label .= '\n';
- $labels{$rule} .= $rule_label;
- }
-
- foreach my $from (keys %edges) {
- next unless $is_rule{$from};
- foreach my $to (keys %{$edges{$from}}) {
- next unless $is_rule{$to};
- $graph->add_edge($from => $to);
+ my $rule_label;
+ foreach my $item ( split ' ', $text ) {
+ $edges{$rule}{$item}++;
+ $rule_label .= $item . " ";
+ }
+ $rule_label .= '\n';
+ $labels{$rule} .= $rule_label;
}
- }
+ foreach my $from ( keys %edges ) {
+ next unless $is_rule{$from};
+ foreach my $to ( keys %{ $edges{$from} } ) {
+ next unless $is_rule{$to};
+ $graph->add_edge( $from => $to );
+ }
+ }
- foreach my $rule (keys %labels) {
- $graph->add_node($rule, label => [$rule, $labels{$rule}]);
- }
+ foreach my $rule ( keys %labels ) {
+ $graph->add_node( $rule, label => [ $rule, $labels{$rule} ] );
+ }
- close(IN);
- return $graph;
+ close(IN);
+ return $graph;
}
=head1 AUTHOR
diff --git a/lib/GraphViz/Regex.pm b/lib/GraphViz/Regex.pm
index 8e5c71f..ed0fecf 100644
--- a/lib/GraphViz/Regex.pm
+++ b/lib/GraphViz/Regex.pm
@@ -1,6 +1,7 @@
package GraphViz::Regex;
use strict;
+use warnings;
use vars qw($VERSION);
use Carp;
use Config;
@@ -14,7 +15,7 @@ use IPC::Run qw(run);
# This is incremented every time there is a change to the API
$VERSION = '0.02';
-my $DEBUG = 0; # whether debugging statements are shown
+my $DEBUG = 0; # whether debugging statements are shown
=head1 NAME
@@ -61,16 +62,14 @@ is returned.
=cut
-
sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $regex = shift;
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $regex = shift;
- return _init($regex);
+ return _init($regex);
}
-
=head2 as_*
The regex can be visualised in a number of different graphical
@@ -87,164 +86,167 @@ for more information. The two most common methods are:
=cut
-
sub _init {
- my $regex = shift;
+ my $regex = shift;
+
+ my $compiled;
+ my $foo;
- my $compiled;
- my $foo;
+ my $perl = $Config{perlpath};
+ warn "perlpath: $perl\n" if $DEBUG;
- my $perl = $Config{perlpath};
- warn "perlpath: $perl\n" if $DEBUG;
+ my $option = qq|use re "debug";qr/$regex/;|;
+ run [$perl], \$option, \$foo, \$compiled;
- my $option = qq|use re "debug";qr/$regex/;|;
- run [$perl], \$option, \$foo, \$compiled;
+ warn "[$compiled]\n" if $DEBUG;
- warn "[$compiled]\n" if $DEBUG;
+ # die "Crap" unless $compiled;
-# die "Crap" unless $compiled;
+ my $g = GraphViz->new( rankdir => 1 );
- my $g = GraphViz->new(rankdir => 1);
+ my %states;
+ my %following;
+ my $last_id;
- my %states;
- my %following;
- my $last_id;
+ foreach my $line ( split /\n/, $compiled ) {
+ next unless my ( $id, $state ) = $line =~ /(\d+):\s+(.+)$/;
+ $states{$id} = $state;
+ $following{$last_id} = $id if $last_id;
+ $last_id = $id;
+ }
- foreach my $line (split /\n/, $compiled) {
- next unless my($id, $state) = $line =~ /(\d+):\s+(.+)$/;
- $states{$id} = $state;
- $following{$last_id} = $id if $last_id;
- $last_id = $id;
- }
+ my %done;
+ my @todo = (1);
- my %done;
- my @todo = (1);
+ warn "last id: $last_id\n" if $DEBUG;
- warn "last id: $last_id\n" if $DEBUG;
+ if ( not defined $last_id ) {
+ $g->add_node("Error compiling regex");
+ return $g;
+ }
- if (not defined $last_id) {
- $g->add_node("Error compiling regex");
- return $g;
- }
-
-
- while (@todo) {
- my $id = pop @todo;
- next unless $id;
- next if $done{$id}++;
- my $state = $states{$id};
- my $following = $following{$id};
- my($next) = $state =~ /\((\d+)\)$/;
-
-# warn "todo: " . join(", ", @todo) . "\n" if $DEBUG;
-
- push @todo, $following;
- push @todo, $next if $next;
-
- my $match;
-
- warn "$id:\t$state\n" if $DEBUG;
- if (($match) = $state =~ /^EXACTF?L? <(.+)>/) {
- warn "\t$match $next\n" if $DEBUG;
- $g->add_node($id, label => $match, shape => 'box');
- $g->add_edge($id => $next) if $next != 0;
- $done{$following}++ unless $next;
- } elsif (($match) = $state =~ /^ANYOF\[(.+)\]/) {
- warn "\tany $match $next\n" if $DEBUG;
- $g->add_node($id, label => '[' . $match . ']', shape => 'box');
- $g->add_edge($id => $next) if $next != 0;
- $done{$following}++ unless $next;
- } elsif (($match) = $state =~ /^OPEN(\d+)/) {
- warn "\tOPEN $match $next\n" if $DEBUG;
- $g->add_node($id, label => 'START \$' . $match);
- $g->add_edge($id => $following);
- } elsif (($match) = $state =~ /^CLOSE(\d+)/) {
- warn "\tCLOSE $match $next\n" if $DEBUG;
- $g->add_node($id, label => 'END \$' . $match);
- $g->add_edge($id => $next);
- } elsif ($state =~ /^END/) {
- warn "\tEND\n" if $DEBUG;
- $g->add_node($id, label => 'END');
- } elsif ($state =~ /^BRANCH/) {
- my $branch = $next;
- warn "\tbranch $branch / " . ($following) . "\n" if $DEBUG;
- my @children;
- push @children, $following;
- while ($states{$branch} =~ /^BRANCH|TAIL/) {
- warn "\tdoing branch $branch\n" if $DEBUG;
- $done{$branch}++;
- push @children, $following{$branch};
- ($branch) = $states{$branch} =~ /(\d+)/;
- }
- $g->add_node($id, label => '', shape => 'diamond');
- foreach my $child (@children) {
- push @todo, $child;
- $g->add_edge($id => $child);
- }
- } elsif (my ($repetition) = $state =~ /^(PLUS|STAR)/) {
- warn "\t$repetition $next\n" if $DEBUG;
- my $label = '?';
- if ($repetition eq 'PLUS') {
- $label = '+';
- } elsif ($repetition eq 'STAR') {
- $label = '*';
- }
- $g->add_node($id, label => 'REPEAT');
- $g->add_edge($id => $id, label => $label);
- $g->add_edge($id => $following);
- $g->add_edge($id => $next, style => 'dashed');
- } elsif (my ($type, $min, $max) = $state =~ /^CURLY([NMX]?)\[?\d*\]? \{(\d+),(\d+)\}/) {
- warn "\tCURLY$type $min $max $next\n" if $DEBUG;
- $g->add_node($id, label => 'REPEAT');
- $g->add_edge($id => $id, label => '{' . $min . ", " . $max . '}');
- $g->add_edge($id => $following);
- $g->add_edge($id => $next, style => 'dashed');
- } elsif ($state =~ /^BOL/) {
- warn "\tBOL $next\n" if $DEBUG;
- $g->add_node($id, label => '^');
- $g->add_edge($id => $next);
- } elsif ($state =~ /^EOL/) {
- warn "\tEOL $next\n" if $DEBUG;
- $g->add_node($id, label => "\$");
- $g->add_edge($id => $next);
- } elsif ($state =~ /^NOTHING/) {
- warn "\tNOTHING $next\n" if $DEBUG;
- $g->add_node($id, label => 'Match empty string');
- $g->add_edge($id => $next);
- } elsif ($state =~ /^MINMOD/) {
- warn "\tMINMOD $next\n" if $DEBUG;
- $g->add_node($id, label => 'Next operator\nnon-greedy');
- $g->add_edge($id => $next);
- } elsif ($state =~ /^SUCCEED/) {
- warn "\tSUCCEED $next\n" if $DEBUG;
- $g->add_node($id, label => 'SUCCEED');
- $done{$following}++;
- } elsif ($state =~ /^UNLESSM/) {
- warn "\tUNLESSM $next\n" if $DEBUG;
- $g->add_node($id, label => 'UNLESS');
- $g->add_edge($id => $following);
- $g->add_edge($id => $next, style => 'dashed');
- } elsif ($state =~ /^IFMATCH/) {
- warn "\tIFMATCH $next\n" if $DEBUG;
- $g->add_node($id, label => 'IFMATCH');
- $g->add_edge($id => $following);
- $g->add_edge($id => $next, style => 'dashed');
- } elsif ($state =~ /^IFTHEN/) {
- warn "\tIFTHEN $next\n" if $DEBUG;
- $g->add_node($id, label => 'IFTHEN');
- $g->add_edge($id => $following);
- $g->add_edge($id => $next, style => 'dashed');
- } elsif ($state =~ /^([A-Z_0-9]+)/) {
- my ($state) = ($1, $2);
- warn "\t? $state $next\n" if $DEBUG;
- $g->add_node($id, label => $state);
- $g->add_edge($id => $next) if $next != 0;
- } else {
- $g->add_node($id, label => $state);
+ while (@todo) {
+ my $id = pop @todo;
+ next unless $id;
+ next if $done{$id}++;
+ my $state = $states{$id};
+ my $following = $following{$id};
+ my ($next) = $state =~ /\((\d+)\)$/;
+
+ # warn "todo: " . join(", ", @todo) . "\n" if $DEBUG;
+
+ push @todo, $following;
+ push @todo, $next if $next;
+
+ my $match;
+
+ warn "$id:\t$state\n" if $DEBUG;
+ if ( ($match) = $state =~ /^EXACTF?L? <(.+)>/ ) {
+ warn "\t$match $next\n" if $DEBUG;
+ $g->add_node( $id, label => $match, shape => 'box' );
+ $g->add_edge( $id => $next ) if $next != 0;
+ $done{$following}++ unless $next;
+ } elsif ( ($match) = $state =~ /^ANYOF\[(.+)\]/ ) {
+ warn "\tany $match $next\n" if $DEBUG;
+ $g->add_node( $id, label => '[' . $match . ']', shape => 'box' );
+ $g->add_edge( $id => $next ) if $next != 0;
+ $done{$following}++ unless $next;
+ } elsif ( ($match) = $state =~ /^OPEN(\d+)/ ) {
+ warn "\tOPEN $match $next\n" if $DEBUG;
+ $g->add_node( $id, label => 'START \$' . $match );
+ $g->add_edge( $id => $following );
+ } elsif ( ($match) = $state =~ /^CLOSE(\d+)/ ) {
+ warn "\tCLOSE $match $next\n" if $DEBUG;
+ $g->add_node( $id, label => 'END \$' . $match );
+ $g->add_edge( $id => $next );
+ } elsif ( $state =~ /^END/ ) {
+ warn "\tEND\n" if $DEBUG;
+ $g->add_node( $id, label => 'END' );
+ } elsif ( $state =~ /^BRANCH/ ) {
+ my $branch = $next;
+ warn "\tbranch $branch / " . ($following) . "\n" if $DEBUG;
+ my @children;
+ push @children, $following;
+ while ( $states{$branch} =~ /^BRANCH|TAIL/ ) {
+ warn "\tdoing branch $branch\n" if $DEBUG;
+ $done{$branch}++;
+ push @children, $following{$branch};
+ ($branch) = $states{$branch} =~ /(\d+)/;
+ }
+ $g->add_node( $id, label => '', shape => 'diamond' );
+ foreach my $child (@children) {
+ push @todo, $child;
+ $g->add_edge( $id => $child );
+ }
+ } elsif ( my ($repetition) = $state =~ /^(PLUS|STAR)/ ) {
+ warn "\t$repetition $next\n" if $DEBUG;
+ my $label = '?';
+ if ( $repetition eq 'PLUS' ) {
+ $label = '+';
+ } elsif ( $repetition eq 'STAR' ) {
+ $label = '*';
+ }
+ $g->add_node( $id, label => 'REPEAT' );
+ $g->add_edge( $id => $id, label => $label );
+ $g->add_edge( $id => $following );
+ $g->add_edge( $id => $next, style => 'dashed' );
+ } elsif ( my ( $type, $min, $max )
+ = $state =~ /^CURLY([NMX]?)\[?\d*\]? \{(\d+),(\d+)\}/ )
+ {
+ warn "\tCURLY$type $min $max $next\n" if $DEBUG;
+ $g->add_node( $id, label => 'REPEAT' );
+ $g->add_edge(
+ $id => $id,
+ label => '{' . $min . ", " . $max . '}'
+ );
+ $g->add_edge( $id => $following );
+ $g->add_edge( $id => $next, style => 'dashed' );
+ } elsif ( $state =~ /^BOL/ ) {
+ warn "\tBOL $next\n" if $DEBUG;
+ $g->add_node( $id, label => '^' );
+ $g->add_edge( $id => $next );
+ } elsif ( $state =~ /^EOL/ ) {
+ warn "\tEOL $next\n" if $DEBUG;
+ $g->add_node( $id, label => "\$" );
+ $g->add_edge( $id => $next );
+ } elsif ( $state =~ /^NOTHING/ ) {
+ warn "\tNOTHING $next\n" if $DEBUG;
+ $g->add_node( $id, label => 'Match empty string' );
+ $g->add_edge( $id => $next );
+ } elsif ( $state =~ /^MINMOD/ ) {
+ warn "\tMINMOD $next\n" if $DEBUG;
+ $g->add_node( $id, label => 'Next operator\nnon-greedy' );
+ $g->add_edge( $id => $next );
+ } elsif ( $state =~ /^SUCCEED/ ) {
+ warn "\tSUCCEED $next\n" if $DEBUG;
+ $g->add_node( $id, label => 'SUCCEED' );
+ $done{$following}++;
+ } elsif ( $state =~ /^UNLESSM/ ) {
+ warn "\tUNLESSM $next\n" if $DEBUG;
+ $g->add_node( $id, label => 'UNLESS' );
+ $g->add_edge( $id => $following );
+ $g->add_edge( $id => $next, style => 'dashed' );
+ } elsif ( $state =~ /^IFMATCH/ ) {
+ warn "\tIFMATCH $next\n" if $DEBUG;
+ $g->add_node( $id, label => 'IFMATCH' );
+ $g->add_edge( $id => $following );
+ $g->add_edge( $id => $next, style => 'dashed' );
+ } elsif ( $state =~ /^IFTHEN/ ) {
+ warn "\tIFTHEN $next\n" if $DEBUG;
+ $g->add_node( $id, label => 'IFTHEN' );
+ $g->add_edge( $id => $following );
+ $g->add_edge( $id => $next, style => 'dashed' );
+ } elsif ( $state =~ /^([A-Z_0-9]+)/ ) {
+ my ($state) = ( $1, $2 );
+ warn "\t? $state $next\n" if $DEBUG;
+ $g->add_node( $id, label => $state );
+ $g->add_edge( $id => $next ) if $next != 0;
+ } else {
+ $g->add_node( $id, label => $state );
+ }
}
- }
- return $g;
+ return $g;
}
=head1 BUGS
diff --git a/lib/GraphViz/Small.pm b/lib/GraphViz/Small.pm
index 2303577..f09cd95 100644
--- a/lib/GraphViz/Small.pm
+++ b/lib/GraphViz/Small.pm
@@ -1,6 +1,7 @@
package GraphViz::Small;
use strict;
+use warnings;
use GraphViz;
use vars qw($VERSION @ISA);
@@ -33,14 +34,14 @@ As for GraphViz.
=cut
sub add_node_munge {
- my $self = shift;
- my $node = shift;
-
- $node->{label} = '';
- $node->{height} = 0.2;
- $node->{width} = 0.2;
- $node->{style} = 'filled';
- $node->{color} = 'black' unless $node->{color};
+ my $self = shift;
+ my $node = shift;
+
+ $node->{label} = '';
+ $node->{height} = 0.2;
+ $node->{width} = 0.2;
+ $node->{style} = 'filled';
+ $node->{color} = 'black' unless $node->{color};
}
=head1 AUTHOR
diff --git a/lib/GraphViz/XML.pm b/lib/GraphViz/XML.pm
index 7ae7bbc..ad6feea 100644
--- a/lib/GraphViz/XML.pm
+++ b/lib/GraphViz/XML.pm
@@ -1,6 +1,7 @@
package GraphViz::XML;
use strict;
+use warnings;
use vars qw($VERSION);
use Carp;
use lib '..';
@@ -45,19 +46,18 @@ XML to be visualised. A GraphViz object is returned.
=cut
sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $xml = shift;
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $xml = shift;
- my $t = XML::Twig->new();
- $t->parse($xml);
- my $graph = GraphViz->new();
- _init($graph, $t->root);
+ my $t = XML::Twig->new();
+ $t->parse($xml);
+ my $graph = GraphViz->new();
+ _init( $graph, $t->root );
- return $graph;
+ return $graph;
}
-
=head2 as_*
The XML can be visualised in a number of different graphical
@@ -74,29 +74,29 @@ for more information. The two most common methods are:
=cut
-
sub _init {
- my($g, $root) = @_;
-#warn "$root $root->gi\n";
-
- my $label = $root->gi;
- my $colour = 'blue';
- my $shape = 'ellipse';
-
- if ($root->is_pcdata) {
- $label = $root->text;
- $label =~ s|^\s+||;
- $label =~ s|\s+$||;
- $colour = 'black';
- } else {
- $shape = "diamond";
- }
-
- $g->add_node($root, label => $label, color => $colour, shape => $shape);
- foreach my $child ($root->children) {
- $g->add_edge($root => $child);
- _init($g, $child);
- }
+ my ( $g, $root ) = @_;
+
+ #warn "$root $root->gi\n";
+
+ my $label = $root->gi;
+ my $colour = 'blue';
+ my $shape = 'ellipse';
+
+ if ( $root->is_pcdata ) {
+ $label = $root->text;
+ $label =~ s|^\s+||;
+ $label =~ s|\s+$||;
+ $colour = 'black';
+ } else {
+ $shape = "diamond";
+ }
+
+ $g->add_node( $root, label => $label, color => $colour, shape => $shape );
+ foreach my $child ( $root->children ) {
+ $g->add_edge( $root => $child );
+ _init( $g, $child );
+ }
}
diff --git a/t/dumper.t b/t/dumper.t
index ce57616..3271ad2 100755
--- a/t/dumper.t
+++ b/t/dumper.t
@@ -1,32 +1,32 @@
#!/usr/bin/perl -w
-
+use strict;
+use warnings;
use lib '../lib', 'lib';
use GraphViz::Data::Grapher;
use Test::More tests => 1;
my @lines = <DATA>;
-foreach my $lines (split '-- test --', (join "", @lines)) {
- my($test, $expect) = split '-- expect --', $lines;
- next unless $test;
- $expect =~ s|^\n||mg;
- $expect =~ s|\n$||mg;
+foreach my $lines ( split '-- test --', ( join "", @lines ) ) {
+ my ( $test, $expect ) = split '-- expect --', $lines;
+ next unless $test;
+ $expect =~ s|^\n||mg;
+ $expect =~ s|\n$||mg;
- $test =~ s|^\n||mg;
- $test =~ s|\n$||mg;
+ $test =~ s|^\n||mg;
+ $test =~ s|\n$||mg;
- my $g;
- eval $test;
+ my $g;
+ eval $test;
- my $result = $g->_as_debug;
+ my $result = $g->_as_debug;
- $result =~ s|^\n||mg;
- $result =~ s|\n$||mg;
+ $result =~ s|^\n||mg;
+ $result =~ s|\n$||mg;
- is($result, $expect, "got expected graph");
+ is( $result, $expect, "got expected graph" );
}
-
__DATA__
-- test --
my @d = ("red", { a => [3, 1, 4, 1], b => { q => 'a', w => 'b'}}, "blue", undef, GraphViz::Data::Grapher->new(), 2);
diff --git a/t/foo.t b/t/foo.t
index 464d1da..3288ba2 100644
--- a/t/foo.t
+++ b/t/foo.t
@@ -1,64 +1,70 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
use strict;
-
+use warnings;
use lib '../lib', 'lib';
use GraphViz;
use Test::More tests => 30;
# make a nice simple graph and check how output is handled.
my $g = GraphViz->new();
-$g->add_node(label => 'London');
+$g->add_node( label => 'London' );
{
- # Check filehandle
- my $fh = do { local *FH; *FH; }; # doubled to avoid warnings
- open $fh, ">as_foo.1"
- or die "Cannot write to as_foo.1: $!";
- $g->as_dot($fh);
- close $fh;
-
- my @result = read_file('as_foo.1');
- check_result(@result);
+
+ # Check filehandle
+ my $fh = do { local *FH; *FH; }; # doubled to avoid warnings
+ open $fh, ">as_foo.1"
+ or die "Cannot write to as_foo.1: $!";
+ $g->as_dot($fh);
+ close $fh;
+
+ my @result = read_file('as_foo.1');
+ check_result(@result);
}
{
- # Check filehandle #2
- local *OUT;
- open OUT, ">as_foo.2"
- or die "Cannot write to as_foo.2: $!";
- $g->as_dot(\*OUT);
- close OUT;
-
- my @result = read_file('as_foo.2');
- check_result(@result);
+
+ # Check filehandle #2
+ local *OUT;
+ open OUT, ">as_foo.2"
+ or die "Cannot write to as_foo.2: $!";
+ $g->as_dot( \*OUT );
+ close OUT;
+
+ my @result = read_file('as_foo.2');
+ check_result(@result);
}
{
- # Check filename
- $g->as_dot('as_foo.3');
- my @result = read_file('as_foo.3');
- check_result(@result);
+
+ # Check filename
+ $g->as_dot('as_foo.3');
+ my @result = read_file('as_foo.3');
+ check_result(@result);
}
{
- # Check scalar ref
- my $result;
- $g->as_dot(\$result);
- check_result(split /\n/, $result);
+
+ # Check scalar ref
+ my $result;
+ $g->as_dot( \$result );
+ check_result( split /\n/, $result );
}
{
- # Check returned
- my $result = $g->as_dot();
- check_result(split /\n/, $result);
+
+ # Check returned
+ my $result = $g->as_dot();
+ check_result( split /\n/, $result );
}
{
- # Check coderef
- my $result;
- $g->as_dot(sub { $result .= shift });
- check_result(split /\n/, $result);
+
+ # Check coderef
+ my $result;
+ $g->as_dot( sub { $result .= shift } );
+ check_result( split /\n/, $result );
}
unlink 'as_foo.1';
@@ -66,17 +72,17 @@ unlink 'as_foo.2';
unlink 'as_foo.3';
sub read_file {
- my $filename = shift;
- local *FILE;
- open FILE, "<$filename"
- or die "Cannot read $filename: $!";
- return (<FILE>);
+ my $filename = shift;
+ local *FILE;
+ open FILE, "<$filename"
+ or die "Cannot read $filename: $!";
+ return (<FILE>);
}
sub check_result {
- my @result = @_;
+ my @result = @_;
- my $expect = <<'EOF';
+ my $expect = <<'EOF';
Expected something like:
digraph test {
@@ -86,11 +92,11 @@ digraph test {
}
EOF
- # have to use regexes cause the output includes numbers that may
- # change each time
- like($result[0], qr/^digraph test {/);
- like($result[1], qr/^\s+graph \[ratio=fill\];/);
- like($result[2], qr/^\s*node\s*\[\s*label\s*=\s*"\\N"\s*\];\s*/);
- like($result[3], qr/^\s*graph\s*\[bb=.*/);
- like($result[4], qr/^\s*node1\s*\[label=London.*\];/);
+ # have to use regexes cause the output includes numbers that may
+ # change each time
+ like( $result[0], qr/^digraph test {/ );
+ like( $result[1], qr/^\s+graph \[ratio=fill\];/ );
+ like( $result[2], qr/^\s*node\s*\[\s*label\s*=\s*"\\N"\s*\];\s*/ );
+ like( $result[3], qr/^\s*graph\s*\[bb=.*/ );
+ like( $result[4], qr/^\s*node1\s*\[label=London.*\];/ );
}
diff --git a/t/pod.t b/t/pod.t
index 976d7cd..fb0bd13 100644
--- a/t/pod.t
+++ b/t/pod.t
@@ -1,5 +1,6 @@
#!perl -T
-
+use strict;
+use warnings;
use Test::More;
eval "use Test::Pod 1.14";
plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
diff --git a/t/simple.t b/t/simple.t
index ab2dbdf..302943e 100755
--- a/t/simple.t
+++ b/t/simple.t
@@ -1,34 +1,33 @@
#!perl -T
-use warnings;
use strict;
+use warnings;
use lib '../lib', 'lib';
use GraphViz;
use Test::More tests => 30;
my @lines = <DATA>;
-foreach my $lines (split '-- test --', (join "", @lines)) {
- my($test, $expect) = split '-- expect --', $lines;
- next unless $test;
- $expect =~ s|^\n||mg;
- $expect =~ s|\n$||mg;
+foreach my $lines ( split '-- test --', ( join "", @lines ) ) {
+ my ( $test, $expect ) = split '-- expect --', $lines;
+ next unless $test;
+ $expect =~ s|^\n||mg;
+ $expect =~ s|\n$||mg;
- $test =~ s|^\n||mg;
- $test =~ s|\n$||mg;
+ $test =~ s|^\n||mg;
+ $test =~ s|\n$||mg;
- my $g;
- eval $test;
+ my $g;
+ eval $test;
- my $result = $g->_as_debug;
+ my $result = $g->_as_debug;
- $result =~ s|^\n||mg;
- $result =~ s|\n$||mg;
+ $result =~ s|^\n||mg;
+ $result =~ s|\n$||mg;
- is($result, $expect);
+ is( $result, $expect );
}
-
__DATA__
-- test --
$g = GraphViz->new();
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libgraphviz-perl.git
More information about the Pkg-perl-cvs-commits
mailing list