package GraphViz; use strict; use vars qw($AUTOLOAD $VERSION); use Carp; use Config; use IPC::Run qw(run binary); # This is incremented every time there is a change to the API $VERSION = '2.03'; =head1 NAME GraphViz - Interface to the GraphViz graphing tool =head1 SYNOPSIS use GraphViz; my $g = GraphViz->new(); $g->add_node('London'); $g->add_node('Paris', label => 'City of\nlurve'); $g->add_node('New York'); $g->add_edge('London' => 'Paris'); $g->add_edge('London' => 'New York', label => 'Far'); $g->add_edge('Paris' => 'London'); print $g->as_png; =head1 DESCRIPTION This module provides an interface to layout and image generation of directed and undirected graphs in a variety of formats (PostScript, PNG, etc.) using the "dot", "neato", "twopi", "circo" and "fdp" programs from the GraphViz project (http://www.graphviz.org/ or http://www.research.att.com/sw/tools/graphviz/). =head2 What is a graph? A (undirected) graph is a collection of nodes linked together with edges. A directed graph is the same as a graph, but the edges have a direction. =head2 What is GraphViz? This module is an interface to the GraphViz toolset (http://www.graphviz.org/). The GraphViz tools provide automatic graph layout and drawing. This module simplifies the creation of graphs and hides some of the complexity of the GraphViz module. Laying out graphs in an aesthetically-pleasing way is a hard problem - there may be multiple ways to lay out the same graph, each with their own quirks. GraphViz luckily takes part of this hard problem and does a pretty good job in a couple of seconds for most graphs. =head2 Why should I use this module? Observation aids comprehension. That is a fancy way of expressing that popular faux-Chinese proverb: "a picture is worth a thousand words". Text is not always the best way to represent anything and everything to do with a computer programs. Pictures and images are easier to assimilate than text. The ability to show a particular thing graphically can aid a great deal in comprehending what that thing really represents. Diagrams are computationally efficient, because information can be indexed by location; they group related information in the same area. They also allow relations to be expressed between elements without labeling the elements. A friend of mine used this to his advantage when trying to remember important dates in computer history. Instead of sitting down and trying to remember everything, he printed over a hundred posters (each with a date and event) and plastered these throughout his house. His spatial memory is still so good that asked last week (more than a year since the experiment) when Lisp was invented, he replied that it was upstairs, around the corner from the toilet, so must have been around 1958. Spreadsheets are also a wonderfully simple graphical representation of computational models. =head2 Applications Bundled with this module are several modules to help graph data structures (GraphViz::Data::Dumper), XML (GraphViz::XML), and Parse::RecDescent, Parse::Yapp, and yacc grammars (GraphViz::Parse::RecDescent, GraphViz::Parse::Yapp, and GraphViz::Parse::Yacc). Note that Marcel Grunauer has released some modules on CPAN to graph various other structures. See GraphViz::DBI and GraphViz::ISA for example. brian d foy has written an article about Devel::GraphVizProf for Dr. Dobb's Journal: http://www.ddj.com/columns/perl/2001/0104pl002/0104pl002.htm =head2 Award winning! I presented a paper and talk on "Graphing Perl" using GraphViz at the 3rd German Perl Workshop and received the "Best Knowledge Transfer" prize. Talk: http://www.astray.com/graphing_perl/graphing_perl.pdf Slides: http://www.astray.com/graphing_perl/ =head1 METHODS =head2 new This is the constructor. It accepts several attributes. my $g = GraphViz->new(); my $g = GraphViz->new(directed => 0); my $g = GraphViz->new(layout => 'neato', ratio => 'compress'); my $g = GraphViz->new(rankdir => 1); my $g = GraphViz->new(width => 8.5, height => 11); my $g = GraphViz->new(width => 30, height => 20, pagewidth => 8.5, pageheight => 11); The most two important attributes are 'layout' and 'directed'. =over =item layout The 'layout' attribute determines which layout algorithm GraphViz.pm will use. Possible values are: =over =item dot The default GraphViz layout for directed graph layouts =item neato For undirected graph layouts - spring model =item twopi For undirected graph layouts - radial =item circo For undirected graph layouts - circular =item fdp For undirected graph layouts - force directed spring model =back =item directed The 'directed' attribute, which defaults to 1 (true) specifies directed (edges have arrows) graphs. Setting this to zero produces undirected graphs (edges do not have arrows). =item rankdir Another attribute 'rankdir' controls the direction the nodes are linked together. If true it will do left->right linking rather than the default up-down linking. =item width, height The 'width' and 'height' attributes control the size of the bounding box of the drawing in inches. This is more useful for PostScript output as for raster graphic (such as PNG) the pixel dimensions can not be set, although there are generally 96 pixels per inch. =item pagewidth, pageheight The 'pagewidth' and 'pageheight' attributes set the PostScript pagination size in inches. That is, if the image is larger than the page then the resulting PostScript image is a sequence of pages that can be tiled or assembled into a mosaic of the full image. (This only works for PostScript output). =item concentrate The 'concentrate' attribute controls enables an edge merging technique to reduce clutter in dense layouts of directed graphs. The default is not to merge edges. =item random_start For undirected graphs, the 'random_start' attribute requests an initial random placement for the graph, which may give a better result. The default is not random. =item epsilon For undirected graphs, the 'epsilon' attribute decides how long the graph solver tries before finding a graph layout. Lower numbers allow the solver to fun longer and potentially give a better layout. Larger values can decrease the running time but with a reduction in layout quality. The default is 0.1. =item overlap The 'overlap' option allows you to set layout behavior for graph nodes that overlap. (From GraphViz documentation:) Determines if and how node overlaps should be removed. =over =item true (the default) overlaps are retained. =item scale overlaps are removed by uniformly scaling in x and y. =item false If the value converts to "false", node overlaps are removed by a Voronoi-based technique. =item scalexy x and y are separately scaled to remove overlaps. =item orthoxy, orthxy If the value is "orthoxy" or "orthoyx", overlaps are moved by optimizing two constraint problems, one for the x axis and one for the y. The suffix indicates which axis is processed first. B: The methods related to "orthoxy" and "orthoyx" are still evolving. The semantics of these may change, or these methods may disappear altogether. =item compress If the value is "compress", the layout will be scaled down as much as possible without introducing any overlaps. =back Except for the Voronoi method, all of these transforms preserve the orthogonal ordering of the original layout. That is, if the x coordinates of two nodes are originally the same, they will remain the same, and if the x coordinate of one node is originally less than the x coordinate of another, this relation will still hold in the transformed layout. The similar properties hold for the y coordinates. =item no_overlap The 'no_overlap' overlap option, if set, tells the graph solver to not overlap the nodes. Deprecated, Use 'overlap' => 'false'. =item ratio The 'ratio' option sets the aspect ratio (drawing height/drawing width) for the drawing. Note that this is adjusted before the size attribute constraints are enforced. Default value is C. =over =item numeric If ratio is numeric, it is taken as the desired aspect ratio. Then, if the actual aspect ratio is less than the desired ratio, the drawing height is scaled up to achieve the desired ratio; if the actual ratio is greater than that desired ratio, the drawing width is scaled up. =item fill If ratio = C and the size attribute is set, node positions are scaled, separately in both x and y, so that the final drawing exactly fills the specified size. =item compress If ratio = C and the size attribute is set, dot attempts to compress the initial layout to fit in the given size. This achieves a tighter packing of nodes but reduces the balance and symmetry. This feature only works in dot. =item expand If ratio = C the size attribute is set, and both the width and the height of the graph are less than the value in size, node positions are scaled uniformly until at least one dimension fits size exactly. Note that this is distinct from using size as the desired size, as here the drawing is expanded before edges are generated and all node and text sizes remain unchanged. =item auto If ratio = C the page attribute is set and the graph cannot be drawn on a single page, then size is set to an ``ideal'' value. In particular, the size in a given dimension will be the smallest integral multiple of the page size in that dimension which is at least half the current size. The two dimensions are then scaled independently to the new size. This feature only works in dot. =back =item bgcolor The 'bgcolor' option sets the background colour. A colour value may be "h,s,v" (hue, saturation, brightness) floating point numbers between 0 and 1, or an X11 color name such as 'white', 'black', 'red', 'green', 'blue', 'yellow', 'magenta', 'cyan', or 'burlywood'. =item name The 'name' option sets name of the graph. This option is useful in few situations, like client side image map generation, see cmapx. By default 'test' is used. =item node,edge,graph The 'node', 'edge' and 'graph' attributes allow you to specify global node, edge and graph attributes (in addition to those controlled by the special attributes described above). The value should be a hash reference containing the corresponding key-value pairs. For example, to make all nodes box-shaped (unless explicity given another shape): my $g = GraphViz->new(node => {shape => 'box'}); =back =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; } $self->{NODES} = {}; $self->{NODELIST} = []; $self->{EDGES} = []; 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->{name}) { $self->{NAME} = $config->{name}; } else { $self->{NAME} = 'test'; } if (exists $config->{bgcolor}) { $self->{BGCOLOR} = $config->{bgcolor}; } $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->{PAGEWIDTH} = $config->{pagewidth} if (exists $config->{pagewidth}); $self->{PAGEHEIGHT} = $config->{pageheight} if (exists $config->{pageheight}); $self->{CONCENTRATE} = $config->{concentrate} if (exists $config->{concentrate}); $self->{RANDOM_START} = $config->{random_start} if (exists $config->{random_start}); $self->{EPSILON} = $config->{epsilon} if (exists $config->{epsilon}); $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->{RATIO} = $config->{ratio} || 'fill'; # 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 A graph consists of at least one node. All nodes have a name attached which uniquely represents that node. The add_node method creates a new node and optionally assigns it attributes. The simplest form is used when no attributes are required, in which the string represents the name of the node: $g->add_node('Paris'); Various attributes are possible: "label" provides a label for the node (the label defaults to the name if none is specified). The label can contain embedded newlines with '\n', as well as '\c', '\l', '\r' for center, left, and right justified lines: $g->add_node('Paris', label => 'City of\nlurve'); Attributes need not all be specified in the one line: successive declarations of the same node have a cumulative effect, in that any later attributes are just added to the existing ones. For example, the following two lines are equivalent to the one above: $g->add_node('Paris'); $g->add_node('Paris', label => 'City of\nlurve'); Note that multiple attributes can be specified. Other attributes include: =over 4 =item height, width sets the minimum height or width =item shape sets the node shape. This can be one of: 'record', 'plaintext', 'ellipse', 'circle', 'egg', 'triangle', 'box', 'diamond', 'trapezium', 'parallelogram', 'house', 'hexagon', 'octagon' =item fontsize sets the label size in points =item fontname sets the label font family name =item color sets the outline colour, and the default fill colour if the 'style' is 'filled' and 'fillcolor' is not specified A colour value may be "h,s,v" (hue, saturation, brightness) floating point numbers between 0 and 1, or an X11 color name such as 'white', 'black', 'red', 'green', 'blue', 'yellow', 'magenta', 'cyan', or 'burlywood' =item fillcolor sets the fill colour when the style is 'filled'. If not specified, the 'fillcolor' when the 'style' is 'filled' defaults to be the same as the outline color =item style sets the style of the node. Can be one of: 'filled', 'solid', 'dashed', 'dotted', 'bold', 'invis' =item URL sets the url for the node in image map and PostScript files. The string '\N' value will be replaced by the node name. In PostScript files, URL information is embedded in such a way that Acrobat Distiller creates PDF files with active hyperlinks =back If you wish to add an anonymous node, that is a node for which you do not wish to generate a name, you may use the following form, where the GraphViz module generates a name and returns it for you. You may then use this name later on to refer to this node: my $nodename = $g->add_node('label' => 'Roman city'); Nodes can be clustered together with the "cluster" attribute, which is drawn by having a labelled rectangle around all the nodes in a cluster. An empty string means not clustered. $g->add_node('London', cluster => 'Europe'); $g->add_node('Amsterdam', cluster => 'Europe'); Clusters can also take a hashref so that you can set attributes: my $eurocluster = { name =>'Europe', style =>'filled', fillcolor =>'lightgray', fontname =>'arial', fontsize =>'12', }; $g->add_node('London', cluster => $eurocluster, @default_attrs); Nodes can be located in the same rank (that is, at the same level in the graph) with the "rank" attribute. Nodes with the same rank value are ranked together. $g->add_node('Paris', rank => 'top'); $g->add_node('Boston', rank => 'top'); Also, nodes can consist of multiple parts (known as ports). This is implemented by passing an array reference as the label, and the parts are displayed as a label. GraphViz has a much more complete port system, this is just a simple interface to it. See the 'from_port' and 'to_port' attributes of add_edge: $g->add_node('London', label => ['Heathrow', 'Gatwick']); =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); } $node = \%node; } $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}); 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}; } else { $node->{label} = $node->{name}; } } else { $node->{label} =~ s#([|<>\[\]{}"])#\\$1#g unless $node->{shape} && ($node->{shape} eq 'record' || ($node->{label} =~ /^<{shape} eq 'plaintext')); } delete $node->{cluster} if exists $node->{cluster} && !length $node->{cluster} ; $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; '' . $_ } (@{$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->{$_}; } } $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}}; return $node->{name}; } =head2 add_edge Edges are directed (or undirected) links between nodes. This method creates a new edge between two nodes and optionally assigns it attributes. The simplest form is when now attributes are required, in which case the nodes from and to which the edge should be are specified. This works well visually in the program code: $g->add_edge('London' => 'Paris'); Attributes such as 'label' can also be used. This specifies a label for the edge. The label can contain embedded newlines with '\n', as well as '\c', '\l', '\r' for center, left, and right justified lines. $g->add_edge('London' => 'New York', label => 'Far'); Note that multiple attributes can be specified. Other attributes include: =over 4 =item minlen sets an integer factor that applies to the edge length (ranks for normal edges, or minimum node separation for flat edges) =item weight sets the integer cost of the edge. Values greater than 1 tend to shorten the edge. Weight 0 flat edges are ignored for ordering nodes =item fontsize sets the label type size in points =item fontname sets the label font family name =item fontcolor sets the label text colour =item color sets the line colour for the edge A colour value may be "h,s,v" (hue, saturation, brightness) floating point numbers between 0 and 1, or an X11 color name such as 'white', 'black', 'red', 'green', 'blue', 'yellow', 'magenta', 'cyan', or 'burlywood' =item style sets the style of the node. Can be one of: 'filled', 'solid', 'dashed', 'dotted', 'bold', 'invis' =item dir sets the arrow direction. Can be one of: 'forward', 'back', 'both', 'none' =item tailclip, headclip when set to false disables endpoint shape clipping =item arrowhead, arrowtail sets the type for the arrow head or tail. Can be one of: 'none', 'normal', 'inv', 'dot', 'odot', 'invdot', 'invodot.' =item arrowsize sets the arrow size: (norm_length=10,norm_width=5, inv_length=6,inv_width=7,dot_radius=2) =item headlabel, taillabel sets the text for port labels. Note that labelfontcolor, labelfontname, labelfontsize are also allowed =item labeldistance, port_label_distance sets the distance from the edge / port to the label. Also labelangle =item decorateP if set, draws a line from the edge to the label =item samehead, sametail if set aim edges having the same value to the same port, using the average landing point =item constraint if set to false causes an edge to be ignored for rank assignment =back Additionally, adding edges between ports of a node is done via the 'from_port' and 'to_port' parameters, which currently takes in the offset of the port (ie 0, 1, 2...). $g->add_edge('London' => 'Paris', from_port => 0); =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; } $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; } 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! } =head2 as_canon, as_text, as_gif etc. methods There are a number of methods which generate input for dot / neato / twopi / circo / fdp or output the graph in a variety of formats. Note that if you pass a filename, the data is written to that filename. If you pass a filehandle, the data will be streamed to the filehandle. If you pass a scalar reference, then the data will be stored in that scalar. If you pass it a code reference, then it is called with the data (note that the coderef may be called multiple times if the image is large). Otherwise, the data is returned: B you will probably want to binmode any filehandles you write the output to if you want your application to be portable to Win32. my $png_image = $g->as_png; # or $g->as_png("pretty.png"); # save image # or $g->as_png(\*STDOUT); # stream image to a filehandle # or #g->as_png(\$text); # save data in a scalar # or $g->as_png(sub { $png_image .= shift }); =over 4 =item as_debug The as_debug method returns the dot file which we pass to GraphViz. It does not lay out the graph. This is mostly useful for debugging. print $g->as_debug; =item as_canon The as_canon method returns the canonical dot / neato / twopi / circo / fdp file which corresponds to the graph. It does not layout the graph - every other as_* method does. print $g->as_canon; # prints out something like: digraph test { node [ label = "\N" ]; London [label=London]; Paris [label="City of\nlurve"]; New_York [label="New York"]; London -> Paris; London -> New_York [label=Far]; Paris -> London; } =item as_text The as_text method returns text which is a layed-out dot / neato / twopi / circo / fdp format file. print $g->as_text; # prints out something like: digraph test { node [ label = "\N" ]; graph [bb= "0,0,162,134"]; London [label=London, pos="33,116", width="0.89", height="0.50"]; Paris [label="City of\nlurve", pos="33,23", width="0.92", height="0.62"]; New_York [label="New York", pos="123,23", width="1.08", height="0.50"]; London -> Paris [pos="e,27,45 28,98 26,86 26,70 27,55"]; London -> New_York [label=Far, pos="e,107,40 49,100 63,85 84,63 101,46", lp="99,72"]; Paris -> London [pos="s,38,98 39,92 40,78 40,60 39,45"]; } =item as_ps Returns a string which contains a layed-out PostScript-format file. print $g->as_ps; =item as_hpgl Returns a string which contains a layed-out HP pen plotter-format file. print $g->as_hpgl; =item as_pcl Returns a string which contains a layed-out Laserjet printer-format file. print $g->as_pcl; =item as_mif Returns a string which contains a layed-out FrameMaker graphics-format file. print $g->as_mif; =item as_pic Returns a string which contains a layed-out PIC-format file. print $g->as_pic; =item as_gd Returns a string which contains a layed-out GD-format file. print $g->as_gd; =item as_gd2 Returns a string which contains a layed-out GD2-format file. print $g->as_gd2; =item as_gif Returns a string which contains a layed-out GIF-format file. print $g->as_gif; =item as_jpeg Returns a string which contains a layed-out JPEG-format file. print $g->as_jpeg; =item as_png Returns a string which contains a layed-out PNG-format file. print $g->as_png; $g->as_png("pretty.png"); # save image =item as_wbmp Returns a string which contains a layed-out Windows BMP-format file. print $g->as_wbmp; =item as_cmap (deprecated) Returns a string which contains a layed-out HTML client-side image map format file. Use as_cmapx instead. print $g->as_cmap; =item as_cmapx Returns a string which contains a layed-out HTML HTML/X client-side image map format file. Name and id attributes of map element are set to name of the graph. print $g->as_cmapx; =item as_ismap (deprecated) Returns a string which contains a layed-out old-style server-side image map format file. Use as_imap instead. print $g->as_ismap; =item as_imap Returns a string which contains a layed-out HTML new-style server-side image map format file. print $g->as_imap; =item as_vrml Returns a string which contains a layed-out VRML-format file. print $g->as_vrml; =item as_vtx Returns a string which contains a layed-out VTX (Visual Thought) format file. print $g->as_vtx; =item as_mp Returns a string which contains a layed-out MetaPost-format file. print $g->as_mp; =item as_fig Returns a string which contains a layed-out FIG-format file. print $g->as_fig; =item as_svg Returns a string which contains a layed-out SVG-format file. print $g->as_svg; =item as_svgz Returns a string which contains a layed-out SVG-format file that is compressed. print $g->as_svgz; =item as_plain Returns a string which contains a layed-out simple-format file. print $g->as_plain; =back =cut # 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 $name = $AUTOLOAD; $name =~ s/.*://; # strip fully-qualified portion return if $name =~ /DESTROY/; 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; } croak "Method $name not defined!"; } # Return the main dot text sub as_debug { my $self = shift; return $self->_as_debug(@_); } sub _as_debug { my $self = shift; my $dot; my $graph_type = $self->{DIRECTED} ? 'digraph' : 'graph'; $dot .= $graph_type ." ". $self->{NAME} ." {\n"; # 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"; # edge merging $dot .= "\tconcentrate=true;\n" if $self->{CONCENTRATE}; # epsilon $dot .= "\tepsilon=" . $self->{EPSILON} . ";\n" if $self->{EPSILON}; # random start $dot .= "\tstart=rand;\n" if $self->{RANDOM_START}; # overlap $dot .= "\toverlap=\"" . $self->{OVERLAP} . "\";\n" if $self->{OVERLAP}; # color, bgcolor $dot .= "\tbgcolor=\"" . $self->{BGCOLOR} . "\";\n" if $self->{BGCOLOR}; # 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 %clusters = (); my %cluster_nodes = (); my %clusters_edge = (); my $arrow = $self->{DIRECTED} ? ' -> ' : ' -- '; # Add all the nodes my @nodelist = @{$self->{NODELIST}}; @nodelist = sort @nodelist if $self->{SORT}; foreach my $name (@nodelist) { my $node = $self->{NODES}->{$name}; # 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"; } # 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}); } # 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; } 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"; 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 $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}; } $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 @attributes; 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 =~ /^<FE =head1 COPYRIGHT Copyright (C) 2000-4, Leon Brocard This module is free software; you can redistribute it or modify it under the same terms as Perl itself. =cut 1;