#############################################################################
# Output an Graph::Easy object as GraphML text
#
#############################################################################
package Graph::Easy::As_graphml;
$VERSION = '0.76';
#############################################################################
#############################################################################
package Graph::Easy;
use strict;
use warnings;
use Graph::Easy::Attributes;
# map the Graph::Easy attribute types to a GraphML name:
my $attr_type_to_name =
{
ATTR_STRING() => 'string',
ATTR_COLOR() => 'string',
ATTR_ANGLE() => 'double',
ATTR_PORT() => 'string',
ATTR_UINT() => 'integer',
ATTR_URL() => 'string',
ATTR_LIST() => 'string',
ATTR_LCTEXT() => 'string',
ATTR_TEXT() => 'string',
};
sub _graphml_attr_keys
{
my ($self, $tpl, $tpl_no_default, $class, $att, $ids, $id) = @_;
my $base_class = $class; $base_class =~ s/\..*//;
$base_class = 'graph' if $base_class =~ /group/;
$ids->{$base_class} = {} unless ref $ids->{$base_class};
my $txt = '';
for my $name (sort keys %$att)
{
my $entry = $self->_attribute_entry($class,$name);
# get a fresh template
my $t = $tpl;
$t = $tpl_no_default unless defined $entry->[ ATTR_DEFAULT_SLOT ];
# only keep it once
next if exists $ids->{$base_class}->{$name};
$t =~ s/##id##/$$id/;
# node.foo => node, group.bar => graph
$t =~ s/##class##/$base_class/;
$t =~ s/##name##/$name/;
$t =~ s/##type##/$attr_type_to_name->{ $entry->[ ATTR_TYPE_SLOT ] || ATTR_COLOR }/eg;
# will only be there and thus replaced if we have a default
if ($t =~ /##default##/)
{
my $def = $entry->[ ATTR_DEFAULT_SLOT ];
# not a simple value?
$def = $self->default_attribute($name) if ref $def;
$t =~ s/##default##/$def/;
}
# remember name => ID
$ids->{$base_class}->{$name} = $$id; $$id++;
# append the definition
$txt .= $t;
}
$txt;
}
# yED example:
# <data key="d0">
# <y:ShapeNode>
# <y:Geometry height="30.0" width="30.0" x="277.0" y="96.0"/>
# <y:Fill color="#FFCC00" transparent="false"/>
# <y:BorderStyle color="#000000" type="line" width="1.0"/>
# <y:NodeLabel alignment="center" autoSizePolicy="content" fontFamily="Dialog" fontSize="12" fontStyle="plain" hasBackgroundColor="false" hasLineColor="false" height="18.701171875" modelName="internal" modelPosition="c" textColor="#000000" visible="true" width="11.0" x="9.5" y="5.6494140625">1</y:NodeLabel>
# <y:Shape type="ellipse"/>
# </y:ShapeNode>
# </data>
use Graph::Easy::Util qw(ord_values);
sub _as_graphml
{
my $self = shift;
my $args = $_[0];
$args = { name => $_[0] } if ref($args) ne 'HASH' && @_ == 1;
$args = { @_ } if ref($args) ne 'HASH' && @_ > 1;
$args->{format} = 'graph-easy' unless defined $args->{format};
if ($args->{format} !~ /^(graph-easy|Graph::Easy|yED)\z/i)
{
return $self->error("Format '$args->{format}' not understood by as_graphml.");
}
my $format = $args->{format};
# Convert the graph to a textual representation - does not need layout().
my $schema = "http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd";
$schema = "http://www.yworks.com/xml/schema/graphml/1.0/ygraphml.xsd" if $format eq 'yED';
my $y_schema = '';
$y_schema = "\n xmlns:y=\"http://www.yworks.com/xml/graphml\"" if $format eq 'yED';
my $txt = <<EOF
<?xml version="1.0" encoding="UTF-8"?>
<graphml xmlns="http://graphml.graphdrawing.org/xmlns"
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"##Y##
xsi:schemaLocation="http://graphml.graphdrawing.org/xmlns
##SCHEMA##">
<!-- Created by Graph::Easy v##VERSION## at ##DATE## -->
EOF
;
$txt =~ s/##DATE##/scalar localtime()/e;
$txt =~ s/##VERSION##/$Graph::Easy::VERSION/;
$txt =~ s/##SCHEMA##/$schema/;
$txt =~ s/##Y##/$y_schema/;
# <key id="d0" for="node" attr.name="color" attr.type="string">
# <default>yellow</default>
# </key>
# <key id="d1" for="edge" attr.name="weight" attr.type="double"/>
# First gather all possible attributes, then add defines for them. This
# avoids lengthy re-definitions of attributes that aren't used:
my %keys;
my $tpl = ' <key id="##id##" for="##class##" attr.name="##name##" attr.type="##type##">'
."\n <default>##default##</default>\n"
." </key>\n";
my $tpl_no_default = ' <key id="##id##" for="##class##" attr.name="##name##" attr.type="##type##"/>'."\n";
# for yED:
# <key for="node" id="d0" yfiles.type="nodegraphics"/>
# <key attr.name="description" attr.type="string" for="node" id="d1"/>
# <key for="edge" id="d2" yfiles.type="edgegraphics"/>
# <key attr.name="description" attr.type="string" for="edge" id="d3"/>
# <key for="graphml" id="d4" yfiles.type="resources"/>
# we need to remember the mapping between attribute name and ID:
my $ids = {};
my $id = 'd0';
###########################################################################
# first the class attributes
for my $class (sort keys %{$self->{att}})
{
my $att = $self->{att}->{$class};
$txt .=
$self->_graphml_attr_keys( $tpl, $tpl_no_default, $class, $att, $ids, \$id);
}
my @nodes = $self->sorted_nodes('name','id');
###########################################################################
# now the attributes on the objects:
for my $o (@nodes, ord_values ( $self->{edges} ))
{
$txt .=
$self->_graphml_attr_keys( $tpl, $tpl_no_default, $o->class(),
$o->raw_attributes(), $ids, \$id);
}
$txt .= "\n" unless $id eq 'd0';
my $indent = ' ';
$txt .= $indent . '<graph id="G" edgedefault="' . $self->type() . "\">\n";
# output graph attributes:
$txt .= $self->_attributes_as_graphml($self,' ',$ids->{graph});
# output groups recursively
my @groups = $self->groups_within(0);
foreach my $g (@groups)
{
$txt .= $g->as_graphml($indent.' ',$ids); # marks nodes as processed if nec.
}
$indent = ' ';
foreach my $n (@nodes)
{
next if $n->{group}; # already done in a group
$txt .= $n->as_graphml($indent,$ids); # <node id="..." ...>
}
$txt .= "\n";
foreach my $n (@nodes)
{
next if $n->{group}; # already done in a group
my @out = $n->sorted_successors();
# for all outgoing connections
foreach my $other (@out)
{
# in case there exists more than one edge from $n --> $other
my @edges = $n->edges_to($other);
for my $edge (sort { $a->{id} <=> $b->{id} } @edges)
{
$txt .= $edge->as_graphml($indent,$ids); # <edge id="..." ...>
}
}
}
$txt .= " </graph>\n</graphml>\n";
$txt;
}
sub _safe_xml
{
# make a text XML safe
my ($self,$txt) = @_;
$txt =~ s/&/&/g; # quote &
$txt =~ s/>/>/g; # quote >
$txt =~ s/</</g; # quote <
$txt =~ s/"/"/g; # quote "
$txt =~ s/'/'/g; # quote '
$txt =~ s/\\\\/\\/g; # "\\" to "\"
$txt;
}
sub _attributes_as_graphml
{
# output the attributes of an object
my ($graph, $self, $indent, $ids) = @_;
my $tpl = "$indent <data key=\"##id##\">##value##</data>\n";
my $att = $self->get_attributes();
my $txt = '';
for my $n (sort keys %$att)
{
next unless exists $ids->{$n};
my $def = $self->default_attribute($n);
next if defined $def && $def eq $att->{$n};
my $t = $tpl;
$t =~ s/##id##/$ids->{$n}/;
$t =~ s/##value##/$graph->_safe_xml($att->{$n})/e;
$txt .= $t;
}
$txt;
}
#############################################################################
package Graph::Easy::Group;
use strict;
use Graph::Easy::Util qw(ord_values);
sub as_graphml
{
my ($self, $indent, $ids) = @_;
my $txt = $indent . '<graph id="' . $self->_safe_xml($self->{name}) . '" edgedefault="' .
$self->{graph}->type() . "\">\n";
$txt .= $self->{graph}->_attributes_as_graphml($self, $indent, $ids->{graph});
foreach my $n (ord_values ( $self->{nodes} ))
{
my @out = $n->sorted_successors();
$txt .= $n->as_graphml($indent.' ', $ids); # <node id="..." ...>
# for all outgoing connections
foreach my $other (@out)
{
# in case there exists more than one edge from $n --> $other
my @edges = $n->edges_to($other);
for my $edge (sort { $a->{id} <=> $b->{id} } @edges)
{
$txt .= $edge->as_graphml($indent.' ',$ids);
}
$txt .= "\n" if @edges > 0;
}
}
# output groups recursively
my @groups = $self->groups_within(0);
foreach my $g (@groups)
{
$txt .= $g->_as_graphml($indent.' ',$ids); # marks nodes as processed if nec.
}
# XXX TODO: edges from/to this group
# close this group
$txt .= $indent . "</graph>";
$txt;
}
#############################################################################
package Graph::Easy::Node;
use strict;
sub as_graphml
{
my ($self, $indent, $ids) = @_;
my $g = $self->{graph};
my $txt = $indent . '<node id="' . $g->_safe_xml($self->{name}) . "\">\n";
$txt .= $g->_attributes_as_graphml($self, $indent, $ids->{node});
$txt .= "$indent</node>\n";
return $txt;
}
#############################################################################
package Graph::Easy::Edge;
use strict;
sub as_graphml
{
my ($self, $indent, $ids) = @_;
my $g = $self->{graph};
my $txt = $indent . '<edge source="' . $g->_safe_xml($self->{from}->{name}) .
'" target="' . $g->_safe_xml($self->{to}->{name}) . "\">\n";
$txt .= $g->_attributes_as_graphml($self, $indent, $ids->{edge});
$txt .= "$indent</edge>\n";
$txt;
}
1;
__END__
=head1 NAME
Graph::Easy::As_graphml - Generate a GraphML text from a Graph::Easy object
=head1 SYNOPSIS
use Graph::Easy;
my $graph = Graph::Easy->new();
$graph->add_edge ('Bonn', 'Berlin');
print $graph->as_graphml();
=head1 DESCRIPTION
C<Graph::Easy::As_graphml> contains just the code for converting a
L<Graph::Easy|Graph::Easy> object to a GraphML text.
=head2 Attributes
Attributes are output in the format that C<Graph::Easy> specifies. More
details about the valid attributes and their default values can be found
in the Graph::Easy online manual:
L<http://bloodgate.com/perl/graph/manual/>.
=head1 EXPORT
Exports nothing.
=head1 SEE ALSO
L<Graph::Easy>, L<http://graphml.graphdrawing.org/>.
=head1 AUTHOR
Copyright (C) 2004 - 2008 by Tels L<http://bloodgate.com>
See the LICENSE file for information.
=cut